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$
EndProcedureHTML File:
Code: Select all
<html>
<script language="JavaScript">
function test(a, b)
{
return "a="+a+" b="+b;
}
</script>
<body>
Test
</body></html>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
Endcut out the double structure definitions and the helper functions and it should work.
Have fun with this...
