Access JavaScript functions inside the WebGadget.

porfirio · Post by **porfirio** » Sat Nov 05, 2005 4:21 pm

Num3 wrote:
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 ?

I have it and it work
What doesnt is this procedures for acess to the js vars

Post by **idle** » Sat Nov 22, 2008 3:33 am

Took me a while notice what was going on but if you have a java function

Code: Select all

fun(x,y,z)   where the inputs are  x=1.0, y=2.0, z=3.0 
{
    dostuff 
    return x + " " + y + " " + z  
}


debug executejavascript("fun","1.0,2.0,3.0",",")

its returning 3.0 2.0 1.0

SeregaZ · Post by **SeregaZ** » Sat Mar 06, 2010 3:25 am

who know how to replace some text in html inside browser IE by my text? for example:
<script src="www.example.com/js/main.js"></script>
on my:
<script src="C:\main.js"></script>

this is keep alive connection - like chat. and the method first download page, then edit, then open in browser is not working. connection is fail.
very nice working edit hosts file for replace this www.example.com to localhost, but i want to make some BHO like plugin, that whole operations will makes inside explorer, without edition windows hosts file.

StarWarsFan · Post by **StarWarsFan** » Thu May 05, 2016 10:41 am

josku_x wrote: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?

Good idea!
I am trying this out, too, but apparently my JS-knowledge is too limited.

Can a working example be posted please?

Seymour Clufley · Post by **Seymour Clufley** » Sun May 06, 2018 5:29 am

I'm trying to run Freak's original code on a modern 64-bit computer (having changed a few longs to integers), but nothing is happening. Here is the full code I am using:

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

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

DataSection

  IID_IHTMLDocument: ; {626FC520-A41E-11CF-A731-00A0C9082637}
    Data.i $626FC520
    Data.w $A41E, $11CF
    Data.b $A7, $31, $00, $A0, $C9, $08, $26, $37
    
  IID_NULL: ; {00000000-0000-0000-0000-000000000000}
    Data.i $00000000
    Data.w $0000, $0000
    Data.b $00, $00, $00, $00, $00, $00, $00, $00       

EndDataSection

Procedure MakeBSTR(String.s)
  Unicode.s = 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.i)
        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




ww=600 : wh=400
win = OpenWindow(0, 0, 0, ww, wh, "WebGadget", #PB_Window_ScreenCentered)
wg = WebGadget(#PB_Any, 0, 0, ww, wh, "")

html.s = "<html>"
html + "<head>"
html + "<title>Test</title>"
html + "<script type='text/javascript'>" 
html + "function TestFunction(t) { alert('Message from PB:\n\n'+t); }"
html + "</script>" 
html + "</head>"
html + "<body>THIS IS A TEST</body>"
html + "</html>"
SetGadgetItemText(wg, #PB_Web_HtmlCode, html)
WaitWindowEvent(1000)
ExecuteJavaScript(wg,"TestFunction","argument_array","argdlm")

Repeat 
  we = WindowEvent()
  Select we
    Case #PB_Event_CloseWindow
      Break
  EndSelect
  Delay(10)
Until GetAsyncKeyState_(#VK_ESCAPE)

Does anyone have any ideas?

Shardik · Post by **Shardik** » Sat May 12, 2018 7:21 pm

I have found some errors but unfortunately they don't solve the problem of running your example code with a PB x64 compiler...

At first your windows event loop is faulty. On PB 5.46 x86 the detection of <Esc> works correctly but not on PB 5.46 x64: it simply terminates the window at once! The following modified code is working with both x86 and x64 PB compilers:

Code: Select all

Repeat
  we = WindowEvent()
  Select we
    Case #PB_Event_CloseWindow
      Break
    Case #WM_CHAR
      If EventwParam() = 27
        Break
      EndIf
  EndSelect
  Delay(10)
ForEver

Your code example is working correctly with PB 5.46 x86 in ASCII mode but not in Unicode mode. You should replace the procedure MakeBSTR() by the following one from freak's COM tutorial:

Code: Select all

Procedure MakeBSTR(String.s)
  Protected Result = 0
  CompilerIf #PB_Compiler_Unicode
    Result = SysAllocString_(@String)
  CompilerElse
    Protected *Buffer = AllocateMemory(Len(String)*2 + 2)
    If *Buffer
      PokeS(*Buffer, String, -1, #PB_Unicode)
      Result = SysAllocString_(*Buffer)
      FreeMemory(*Buffer)
    EndIf
  CompilerEndIf

  ProcedureReturn Result
EndProcedure

Now your example code will work fine with PB 5.46 x86 in ASCII and Unicode mode and with PB 5.62 x86.

Unfortunately when compiling with PB 5.46 x64 in ASCII or Unicode mode or with PB 5.62 x64, the QueryInterface method

Code: Select all

    If DocumentDispatch\QueryInterface(?IID_IHTMLDocument, @Document.IHTMLDocument) = #S_OK

always fails with #E_NOINTERFACE (no interface found). And shortly afterwards the IDE becomes unresponsive and you have to terminate the IDE.

However, I was able to modify freak's code from his first posting to run like a charm in PB 5.46 x86 and x64 in ASCII and Unicode mode and in PB 5.62 x86 and x64. I did all my tests on Windows 7 SP1 x64.

Code: Select all

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.s)
  Protected Result = 0
  CompilerIf #PB_Compiler_Unicode
    Result = SysAllocString_(@String)
  CompilerElse
    Protected *Buffer = AllocateMemory(Len(String)*2 + 2)
    If *Buffer
      PokeS(*Buffer, String, -1, #PB_Unicode)
      Result = SysAllocString_(*Buffer)
      FreeMemory(*Buffer)
    EndIf
  CompilerEndIf

  ProcedureReturn Result
EndProcedure

Procedure.s ReadBSTR(bstr)
  ProcedureReturn PeekS(bstr, -1, #PB_Unicode)
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

HTML.S = "<html>" + #LF$ +
  "<script language=" + #DQUOTE$ + "JavaScript" + #DQUOTE$ + ">" + #LF$ +
  #LF$ +
  "function test(a, b)" + #LF$ +
  "{" + #LF$ +
  "  return " + #DQUOTE$ + "a=" + #DQUOTE$ + "+a+" + #DQUOTE$ + " b=" + #DQUOTE$ + "+b;" + #LF$ +
  "}" + #LF$ +
  #LF$ +
  "</script>" + #LF$ +
  "<body>" + #LF$ +
  "Test" + #LF$ +
  "</body></html>" + #LF$

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

Procedure Resize()
  Width = WindowWidth(0)
  Height = WindowHeight(0)
  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, "Javascript test", #PB_Window_ScreenCentered|#PB_Window_SizeGadget|#PB_Window_MaximizeGadget|#PB_Window_MinimizeGadget)
  WebGadget(#Gadget_Web, 0, 0, 0, 0, "")
  SetGadgetItemText(0, #PB_Web_HtmlCode, HTML)
  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 EventGadget() = #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

End

Seymour Clufley · Post by **Seymour Clufley** » Sat May 12, 2018 8:59 pm

That's fantastic, Shardik. Thank you very much. I must have broken something while I was trying to "update" the code!

JHPJHP · Post by **JHPJHP** » Sat May 12, 2018 9:20 pm

Hi Seymour Clufley,

Tested PB 5.62 x86 / x64 :: Windows 10

Shardik wrote:Unfortunately when compiling with PB 5.46 x64 in ASCII or Unicode mode or with PB 5.62 x64, the QueryInterface method
always fails with #E_NOINTERFACE (no interface found). And shortly afterwards the IDE becomes unresponsive and you have to terminate the IDE.

Try the following:
- used the MakeBSTR Procedure provided by Shardik / freak
- replaced the COM Object IID_IHTMLDocument with IID_IHTMLDocument2 (should fix the QueryInterface problem)

Code: Select all

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

Procedure MakeBSTR(String.s)
  CompilerIf #PB_Compiler_Unicode
    Result = SysAllocString_(@String)
  CompilerElse
    *Buffer = AllocateMemory(StringByteLength(String))
    PokeS(*Buffer, String, -1, #PB_Unicode)
    Result = SysAllocString_(*Buffer)
    FreeMemory(*Buffer)
  CompilerEndIf
  ProcedureReturn Result
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 = GetWindowLongPtr_(GadgetID(Gadget), #GWL_USERDATA)

  If Browser\get_Document(@DocumentDispatch.IDispatch) = #S_OK
    If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @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)

        If result = #S_OK
          If Trim(Arguments$)
            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
          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
            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

html.s = "<html>"
html + "<head>"
html + "<title>Test</title>"
html + "<script type='text/javascript'>" 
html + "function TestFunction(t){alert('Message from PB:\n\n'+t);}"
html + "</script>"
html + "</head>"
html + "<body>THIS IS A TEST</body>"
html + "</html>"

If OpenWindow(0, 0, 0, 500, 500, "WebGadget :: JavaScript", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  WebGadget = WebGadget(#PB_Any, 0, 0, 500, 500, #Null$)
  SetGadgetItemText(WebGadget, #PB_Web_HtmlCode, html)
  ExecuteJavaScript(WebGadget, "TestFunction", "argument_array", "argdlm")
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf

DataSection
  IID_IHTMLDocument2:
    Data.l $332C4425
    Data.w $26CB, $11D0
    Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19
  IID_NULL:
    Data.i $00000000
    Data.w $0000, $0000
    Data.b $00, $00, $00, $00, $00, $00, $00, $00
EndDataSection

Seymour Clufley · Post by **Seymour Clufley** » Sun May 13, 2018 7:39 am

Yes, that works too. Thank you very much, JHPJHP.

Shardik · Post by **Shardik** » Sun May 13, 2018 8:00 am

A nice idea of using IID_IHTMLDocument2 instead of IID_IHTMLDocument, JHPJHP. But unfortunately your modified code example of Seymour Clufley also has problems. While its working nice in Windows 7 x64 with PB 5.46 x86 and x64 in Unicode mode, it crashes in PB 5.46 x86 and x64 in ASCII mode even when changing the procedure ReadBSTR() to

Code: Select all

Procedure.s ReadBSTR(bstr)
  ProcedureReturn PeekS(bstr, -1, #PB_Unicode)
EndProcedure

as freak proposes in his COM tutorial:

freak wrote:Reading a BSTR string: Since the unicode representation of the BSTR type and PB are the same, they can directly be read with the PeekS() function. Just remember to use the #PB_Unicode flag when you do not compile in unicode mode to correctly read the string.

Unfortunately JHPJHP has changed the procedure MakeBSTR(). After replacing it with freak's original procedure, replacing the procedure ReadBSTR() with my modified ReadBSTR() and after inserting an event flush behind SetGadgetItemText(), Seymore Clufley's example code is now working like a charm in both ASCII and Unicode mode and with PB 5.46 x86 and x64:

Code: Select all

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

Procedure MakeBSTR(String.s)
  Protected Result = 0
  CompilerIf #PB_Compiler_Unicode
    Result = SysAllocString_(@String)
  CompilerElse
    Protected *Buffer = AllocateMemory(Len(String)*2 + 2)
    If *Buffer
      PokeS(*Buffer, String, -1, #PB_Unicode)
      Result = SysAllocString_(*Buffer)
      FreeMemory(*Buffer)
    EndIf
  CompilerEndIf

  ProcedureReturn Result
EndProcedure

Procedure.s ReadBSTR(bstr)
  ProcedureReturn PeekS(bstr, -1, #PB_Unicode)
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 = GetWindowLongPtr_(GadgetID(Gadget), #GWL_USERDATA)

  If Browser\get_Document(@DocumentDispatch.IDispatch) = #S_OK
    If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @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)

        If result = #S_OK
          If Trim(Arguments$)
            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
          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
            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

html.s = "<html>"
html + "<head>"
html + "<title>Test</title>"
html + "<script type='text/javascript'>"
html + "function TestFunction(t){alert('Message from PB:\n\n'+t);}"
html + "</script>"
html + "</head>"
html + "<body>THIS IS A TEST</body>"
html + "</html>"

If OpenWindow(0, 0, 0, 500, 500, "WebGadget :: JavaScript", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
  WebGadget = WebGadget(#PB_Any, 0, 0, 500, 500, #Null$)
  SetGadgetItemText(WebGadget, #PB_Web_HtmlCode, html)
  While WindowEvent() : Wend
  ExecuteJavaScript(WebGadget, "TestFunction", "argument_array", "argdlm")
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf

DataSection
  IID_IHTMLDocument2:
    Data.l $332C4425
    Data.w $26CB, $11D0
    Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19

  IID_NULL:
    Data.i $00000000
    Data.w $0000, $0000
    Data.b $00, $00, $00, $00, $00, $00, $00, $00
EndDataSection

ricardo · Post by **ricardo** » Thu Apr 30, 2020 9:36 pm

SetJSVariable and GetJSVariable are not working anymore

ricardo · Post by **ricardo** » Fri May 01, 2020 11:16 am

Hi,

Can anyone take a look to see why this functions are not working anymore please?

Procedure.s GetJSVariable(Gadget, Name$)

and

Procedure SetJSVariable(Gadget, Name$, Value$)

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

infratec · Post by **infratec** » Fri May 01, 2020 12:58 pm

I converted the original code from Freak to unicode PB:

Save it as JavaScript.pbi

Code: Select all

CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
CompilerEndIf


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

Procedure.s ExecuteJavaScript(Gadget.i, Function$, Arguments$, Separator$)
  
  Protected.i result, Count, i
  Protected Result$, Message$
  Protected *dispID, *bstr_command, *Arguments
  Protected Browser.IWebBrowser2
  Protected DocumentDispatch.IDispatch, ScriptDispatch.IDispatch
  Protected Document.IHTMLDocument
  Protected *Arg.VARIANT, varResult.VARIANT
  Protected params.DISPPARAMS
  
  
  Result$ = "ERROR"
  
  Browser = GetWindowLong_(GadgetID(Gadget), #GWL_USERDATA)
  If Browser\get_Document(@DocumentDispatch) = #S_OK
    If DocumentDispatch\QueryInterface(?IID_IHTMLDocument, @Document) = #S_OK
      If Document\get_Script(@ScriptDispatch) = #S_OK
        
        *bstr_command = SysAllocString_(Function$)
        result = ScriptDispatch\GetIDsOfNames(?IID_NULL, @*bstr_command, 1, 0, @*dispID)
        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 = *Arguments
            
            For i = 1 To Count           
              *Arg\vt = #VT_BSTR
              *Arg\bstrVal = SysAllocString_(Trim(StringField(Arguments$, i, Separator$)))
              *Arg + SizeOf(VARIANT)
            Next i
          EndIf
          
          params\cArgs = Count
          params\cNamedArgs = 0
          params\rgvarg = *Arguments
          
          result = ScriptDispatch\Invoke(*dispID, ?IID_NULL, 0, #DISPATCH_METHOD, @params, @varResult, 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)
        
        ScriptDispatch\Release()
      EndIf
      Document\Release()
    EndIf
    DocumentDispatch\Release()
  EndIf
  
  ProcedureReturn Result$
EndProcedure


Procedure.s GetJSVariable(Gadget.i, Name$)
  
  Protected dispID.i, result.i
  Protected Result$, Message$
  Protected *bstr_name
  Protected Browser.IWebBrowser2
  Protected DocumentDispatch.IDispatch, ScriptDispatch.IDispatch
  Protected Document.IHTMLDocument
  Protected params.DISPPARAMS
  Protected varResult.VARIANT
  
  
  Result$ = "ERROR"
  
  Browser = GetWindowLong_(GadgetID(Gadget), #GWL_USERDATA)
  If Browser\get_Document(@DocumentDispatch) = #S_OK
    If DocumentDispatch\QueryInterface(?IID_IHTMLDocument, @Document) = #S_OK
      If Document\get_Script(@ScriptDispatch) = #S_OK
        
        *bstr_name = SysAllocString_(Name$)
        result = ScriptDispatch\GetIDsOfNames(?IID_NULL, @*bstr_name, 1, 0, @dispID)
        If result = #S_OK
          
          params\cArgs = 0
          params\cNamedArgs = 0       
          
          result = ScriptDispatch\Invoke(dispID, ?IID_NULL, 0, #DISPATCH_PROPERTYGET, @params, @varResult, 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)
        
        ScriptDispatch\Release()
      EndIf
      Document\Release()
    EndIf
    DocumentDispatch\Release()
  EndIf
  
  ProcedureReturn Result$
EndProcedure

Procedure SetJSVariable(Gadget, Name$, Value$)
  
  Protected.i success, dispID, result, dispidNamed
  Protected *bstr_name
  Protected Browser.IWebBrowser2
  Protected DocumentDispatch.IDispatch, ScriptDispatch.IDispatch
  Protected Document.IHTMLDocument
  Protected varValue.VARIANT
  Protected params.DISPPARAMS
  
  
  
  Browser = GetWindowLong_(GadgetID(Gadget), #GWL_USERDATA)
  If Browser\get_Document(@DocumentDispatch) = #S_OK
    If DocumentDispatch\QueryInterface(?IID_IHTMLDocument, @Document) = #S_OK
      If Document\get_Script(@ScriptDispatch) = #S_OK
        
        *bstr_name = SysAllocString_(Name$)
        result = ScriptDispatch\GetIDsOfNames(?IID_NULL, @*bstr_name, 1, 0, @dispID)
        If result = #S_OK
          
          varValue\vt = #VT_BSTR
          varValue\bstrVal = SysAllocString_(Value$)
          
          dispidNamed = -3 ; #DISPID_PROPERTYPUT
          params\cArgs = 1
          params\cNamedArgs = 1
          params\rgvarg = @varValue
          params\rgdispidNamedArgs = @dispidNamed
          
          result = ScriptDispatch\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)
        
        ScriptDispatch\Release()
      EndIf
      Document\Release()
    EndIf
    DocumentDispatch\Release()
  EndIf
  
  ProcedureReturn success
EndProcedure


;-Demo
CompilerIf #PB_Compiler_IsMainFile
  EnableExplicit
  
  
  Enumeration
    #Gadget_Web
    #Gadget_Command
    #Gadget_Args
    #Gadget_Text
    #Gadget_Button
  EndEnumeration
  
  
  ;IncludeFile "Javascript.pbi"
  
  
  Procedure Resize()
    
    Protected.i Width, Height
    
    Width = WindowWidth(0)
    Height = WindowHeight(0)
    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
  
  
  Define Event.i , Command$, Arguments$, Result$, HTML$
  
  
  HTML$ = ~"<html>" + #CRLF$
  HTML$ + ~" <script language=\"JavaScript\">" + #CRLF$
  HTML$ + ~"  var xtra = \"Global\";" + #CRLF$
  HTML$ + ~" " + #CRLF$
  HTML$ + ~"  function test(a, b)" + #CRLF$
  HTML$ + ~"  {" + #CRLF$
  HTML$ + ~"   return \"a=\"+a+\" b=\"+b;" + #CRLF$
  HTML$ + ~"  }" + #CRLF$
  HTML$ + ~" </script>" + #CRLF$
  HTML$ + ~" <body>" + #CRLF$
  HTML$ + ~"  Test" + #CRLF$
  HTML$ + ~" </body>" + #CRLF$
  HTML$ + ~"</html>"
  
  Debug HTML$
  
  If OpenWindow(0, 0, 0, 800, 600, "Javascript test", #PB_Window_ScreenCentered|#PB_Window_SizeGadget|#PB_Window_MaximizeGadget|#PB_Window_MinimizeGadget)
    
    WebGadget(#Gadget_Web, 0, 0, 0, 0, #Null$)
    SetGadgetItemText(#Gadget_Web, #PB_Web_HtmlCode, HTML$)
    
    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 EventGadget() = #Gadget_Button
        Command$ = GetGadgetText(#GADGET_Command)
        Arguments$ = GetGadgetText(#GADGET_Args)
        
        Result$ = ExecuteJavaScript(#Gadget_Web, Command$, Arguments$, ",")
        SetGadgetText(#Gadget_Text, "Result: "+Result$)
        
        Debug GetJSVariable(#Gadget_Web, "xtra")
        SetJSVariable(#Gadget_Web, "xtra", "Set")
        Debug GetJSVariable(#Gadget_Web, "xtra")
        
      EndIf
    Until Event = #PB_Event_CloseWindow
    
  EndIf
CompilerEndIf

Joubarbe · Post by **Joubarbe** » Fri May 01, 2020 2:58 pm

viewtopic.php?f=27&t=70009

Isn't that even better?
Both libraries have a strong limitation though: the WebGadget is outdated and ES6 code cannot be used.

infratec · Post by **infratec** » Fri May 01, 2020 5:34 pm

@Joubarbe

Have you looked inside?
He also uses a WebGadget() in a hidden window.

Line 57 inside _Init.pb

Code: Select all

    _JSc_Scripts(Name$)\WebGadget = WebGadget(#PB_Any,0,0,10,10, "")

PureBasic Forums - English

Access JavaScript functions inside the WebGadget.

Re: Access JavaScript functions inside the WebGadget.

Re:

Re: Access JavaScript functions inside the WebGadget.

Re: Access JavaScript functions inside the WebGadget.

Re: Access JavaScript functions inside the WebGadget.

Re: Access JavaScript functions inside the WebGadget.

Re: Access JavaScript functions inside the WebGadget.

Re: Access JavaScript functions inside the WebGadget.

Re: Access JavaScript functions inside the WebGadget.

Re: Access JavaScript functions inside the WebGadget.

Re: Access JavaScript functions inside the WebGadget.

Re: Access JavaScript functions inside the WebGadget.

Re: Access JavaScript functions inside the WebGadget.