Using Freak's knowledge i made a little example for you.
Code: Select all
Import "atl.lib"
AtlAxWinInit()
EndImport
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
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
AtlAxWinInit()
win = OpenWindow(0,0,0,500,400," -| test |- ",#PB_Window_ScreenCentered|#PB_Window_SystemMenu)
CreateGadgetList(WindowID(0))
StringGadget(1,50,10,350,20,"")
ButtonGadget(2,200,50,50,25,"Test")
;whandle = CreateWindowEx_(0,"AtlAxWin","mshtml:<a href='' onclick='test = 1;alert(test);return false' title='-- test --'>test</a>",#WS_VISIBLE|#WS_CHILD,10,90,400,300,WindowID(0),0,GetModuleHandle_(0),0)
WebGadget(0,10,90,400,300,"about:<a href='' onclick='test = 777;alert(test);return false' title='-- test --'>test</a>")
Repeat
;simplest way to read value of variable "test" ?
EventID=WaitWindowEvent()
Select EventID
Case #PB_Event_Gadget
Select EventGadget()
Case 2
Test$ = GetJSVariable(0,"test")
SetGadgetText(1,"Variable Test Value= " + Test$)
EndSelect
EndSelect
Until EventID=#PB_Event_CloseWindow