See this post: viewtopic.php?f=13&t=29393&start=15
Code: Select all
Procedure.i WebGadget_Document(iGadget.i, *IID)
;#---------------------------------------------
Protected iDocument.i = 0
Protected Browser.IWebBrowser2
Protected DocumentDispatch.IDispatch
Browser = GetWindowLongPtr_(GadgetID(iGadget), #GWL_USERDATA)
If Browser
If Browser\get_Document(@DocumentDispatch) = #S_OK And DocumentDispatch
DocumentDispatch\QueryInterface(*IID, @iDocument)
DocumentDispatch\Release()
EndIf
EndIf
ProcedureReturn iDocument
EndProcedure
Procedure.i IDocHostUIHandlerImpl_QueryInterface(*that.IDocHostUIHandlerImpl, riid.i, ppObj.i)
;#--------------------------------------------------------------------------------------------
Protected hresult.i = #E_NOINTERFACE
Protected TmpUnkown.IUnknown = *that
If ppObj <> #Null And riid <> #Null
PokeI(ppobj, 0)
If CompareMemory(riid, ?IID_IUnkown, SizeOf(IID))
PokeI(ppobj, *that)
TmpUnkown\AddRef()
hresult = #S_OK
ElseIf CompareMemory(riid, ?IID_IDocHostUIHandler, SizeOf(IID))
PokeI(ppobj, *that)
TmpUnkown\AddRef()
hresult = #S_OK
EndIf
EndIf
ProcedureReturn hresult
EndProcedure
Procedure.i IDocHostUIHandlerImpl_AddRef(*that.IDocHostUIHandlerImpl)
;#-------------------------------------------------------------------
*that\RefCount = *that\RefCount + 1
ProcedureReturn *that\RefCount
EndProcedure
Procedure.i IDocHostUIHandlerImpl_Release(*that.IDocHostUIHandlerImpl)
;#--------------------------------------------------------------------
Protected iRefCount.i
*that\RefCount = *that\RefCount - 1
iRefCount = *that\RefCount
If iRefCount = 0
If *that\External <> #Null
*that\External\Release()
EndIf
FreeMemory(*that)
EndIf
ProcedureReturn iRefCount
EndProcedure
Procedure.i IDocHostUIHandlerImpl_ShowContextMenu(*that.IDocHostUIHandlerImpl, dwID, ppt, pcmdTarget, pdispReserved)
;#------------------------------------------------------------------------------------------------------------------
ProcedureReturn #S_FALSE
EndProcedure
Procedure.i IDocHostUIHandlerImpl_GetHostInfo(*that.IDocHostUIHandlerImpl, *pInfo.DOCHOSTUIINFO)
;#----------------------------------------------------------------------------------------------
*pInfo\cbSize = 20
*pInfo\dwDoubleClick = #DOCHOSTUIDBLCLK_DEFAULT
*pInfo\dwFlags = #DOCHOSTUIFLAG_DIV_BLOCKDEFAULT + #DOCHOSTUIFLAG_OPENNEWWIN
*pInfo\pchHostCss = #Null
*pInfo\pchHostNS = #Null
ProcedureReturn #S_OK
EndProcedure
Procedure.i IDocHostUIHandlerImpl_ShowUI(*that.IDocHostUIHandlerImpl, dwID, pActiveObject, pCommandTarget, pFrame, pDoc)
;#----------------------------------------------------------------------------------------------------------------------
ProcedureReturn #S_FALSE
EndProcedure
Procedure.i IDocHostUIHandlerImpl_HideUI(*that.IDocHostUIHandlerImpl)
;#-------------------------------------------------------------------
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure.i IDocHostUIHandlerImpl_UpdateUI(*that.IDocHostUIHandlerImpl)
;#---------------------------------------------------------------------
ProcedureReturn #S_OK
EndProcedure
Procedure.i IDocHostUIHandlerImpl_EnableModeless(*that.IDocHostUIHandlerImpl, fEnable)
;#------------------------------------------------------------------------------------
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure.i IDocHostUIHandlerImpl_OnDocWindowActivate(*that.IDocHostUIHandlerImpl, fActivate)
;#-------------------------------------------------------------------------------------------
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure.i IDocHostUIHandlerImpl_OnFrameWindowActivate(*that.IDocHostUIHandlerImpl, fActivate)
;#---------------------------------------------------------------------------------------------
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure.i IDocHostUIHandlerImpl_ResizeBorder(*that.IDocHostUIHandlerImpl, prcBorder, pUIWindow, fFrameWindow)
;#-------------------------------------------------------------------------------------------------------------
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure.i IDocHostUIHandlerImpl_TranslateAccelerator(*that.IDocHostUIHandlerImpl, lpMsg, pguidCmdGroup, nCmdID)
;#---------------------------------------------------------------------------------------------------------------
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure.i IDocHostUIHandlerImpl_GetOptionKeyPath(*that.IDocHostUIHandlerImpl, pchKey, dw)
;#-----------------------------------------------------------------------------------------
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure.i IDocHostUIHandlerImpl_GetDropTarget(*that.IDocHostUIHandlerImpl, pDropTarget, ppDropTarget)
;#-----------------------------------------------------------------------------------------------------
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure.i IDocHostUIHandlerImpl_GetExternal(*that.IDocHostUIHandlerImpl, ppDispatch.i)
;#--------------------------------------------------------------------------------------
If ppDispatch <> #Null
PokeI(ppDispatch, *that\External)
If *that\External <> #Null
*that\External\AddRef()
ProcedureReturn #S_OK
EndIf
EndIf
ProcedureReturn #S_FALSE
EndProcedure
Procedure.i IDocHostUIHandlerImpl_TranslateUrl(*that.IDocHostUIHandlerImpl, dwTranslate, pchURLIn, ppchURLOut)
;#------------------------------------------------------------------------------------------------------------
ProcedureReturn #S_FALSE
EndProcedure
Procedure.i IDocHostUIHandlerImpl_FilterDataObject(*that.IDocHostUIHandlerImpl, pDO, ppDORet)
;#-------------------------------------------------------------------------------------------
ProcedureReturn #S_FALSE
EndProcedure
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
Procedure.i ExternalIDispatchImpl_QueryInterface(*that.ExternalIDispatchImpl, riid.i, ppObj.i)
;#--------------------------------------------------------------------------------------------
Protected hresult.i = #E_NOINTERFACE
Protected TmpUnkown.IUnknown = *that
If ppObj <> #Null And riid <> #Null
PokeI(ppobj, 0)
If CompareMemory(riid, ?IID_IUnkown, SizeOf(IID))
PokeI(ppobj, *that)
TmpUnkown\AddRef()
hresult = #S_OK
ElseIf CompareMemory(riid, ?IID_IDispatch, SizeOf(IID))
PokeI(ppobj, *that)
TmpUnkown\AddRef()
hresult = #S_OK
EndIf
EndIf
ProcedureReturn hresult
EndProcedure
Procedure.i ExternalIDispatchImpl_AddRef(*that.ExternalIDispatchImpl)
;#-------------------------------------------------------------------
*that\RefCount = *that\RefCount + 1
ProcedureReturn *that\RefCount
EndProcedure
Procedure.i ExternalIDispatchImpl_Release(*that.ExternalIDispatchImpl)
;#--------------------------------------------------------------------
Protected iRefCount.i
*that\RefCount = *that\RefCount - 1
iRefCount = *that\RefCount
If iRefCount = 0
FreeMemory(*that)
EndIf
ProcedureReturn iRefCount
EndProcedure
Procedure.i ExternalIDispatchImpl_GetTypeInfoCount(*that.ExternalIDispatchImpl, *pcntInfo.INTEGER)
;#------------------------------------------------------------------------------------------------
*pcntInfo\i = 0
ProcedureReturn #S_OK
EndProcedure
Procedure.i ExternalIDispatchImpl_GetTypeInfo(*that.ExternalIDispatchImpl, itinfo, lcid, pptinfo)
;#-----------------------------------------------------------------------------------------------
ProcedureReturn #E_NOTIMPL
EndProcedure
Procedure.i ExternalIDispatchImpl_GetIDsOfNames(*that.ExternalIDispatchImpl, riid, iPpNames.i, iCntNames.i, lcid, rgdispid.i)
;#---------------------------------------------------------------------------------------------------------------------------
Protected hResult.i = #S_OK
Protected iIndex.i
Protected sName.s
For iIndex = 0 To iCntNames - 1
sName = UCase(PeekS(PeekI(iPpNames + (iIndex * SizeOf(INTEGER))), -1, #PB_Unicode))
If sName = "RAISEEVENT"
PokeI(rgdispid + (iIndex * SizeOf(INTEGER)), #DISPID_RAISEEVENT)
Else
PokeI(rgdispid + (iIndex * SizeOf(INTEGER)), #DISPID_UNKNOWN)
hResult = #DISP_E_UNKNOWNNAME
EndIf
Next iIndex
ProcedureReturn hResult
EndProcedure
Procedure.i ExternalIDispatchImpl_Invoke(*that.ExternalIDispatchImpl, iDispid.i, riid, lcid, flags.w, *dispparams.DISPPARAMS, *result.VARIANT, *pexecpinfo, *puArgErr.Long)
;#-------------------------------------------------------------------------------------------------------------------------------------------------------------------------
Protected hresult.i = #S_OK
Protected Dim sArgument.s(1)
Protected.VARIANT TmpArg
Protected iIndex.i
If iDispid <> #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
For iIndex = 0 To 1
VariantInit_(@TmpArg)
If VariantChangeType_(@TmpArg, *dispparams\rgvarg + ((1 - iIndex) * SizeOf(VARIANT)), 0, #VT_BSTR) <> #S_OK
hresult = #DISP_E_TYPEMISMATCH
Break
EndIf
sArgument(iIndex) = PeekS(TmpArg\bstrVal, -1, #PB_Unicode)
VariantClear_(@TmpArg)
Next iIndex
If hresult <> #S_OK
ProcedureReturn hresult
EndIf
If *that\CallbackFunction <> #Null
CallFunctionFast(*that\CallbackFunction, @sArgument(0), @sArgument(1))
EndIf
If *result <> #Null
VariantInit_(*result)
*result\vt = #VT_EMPTY
EndIf
ProcedureReturn #S_OK
EndProcedure
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(iGadget.i)
;#----------------------------------
Protected Browser.IWebBrowser2 = GetWindowLongPtr_(GadgetID(iGadget), #GWL_USERDATA)
If Browser <> #Null
Browser\AddRef()
EndIf
ProcedureReturn Browser
EndProcedure
Procedure GetIHTMLDocument2(iGadget.i)
;#------------------------------------
Protected Result.IHTMLDocument2 = #Null
Protected Browser.IWebBrowser2 = GetIWebBrowser2(iGadget)
Protected DocumentDispatch.IDispatch
Protected TmpDocument.IHTMLDocument2
If Browser <> #Null
If Browser\get_Document(@DocumentDispatch) = #S_OK
If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @TmpDocument) = #S_OK
Result = TmpDocument
EndIf
DocumentDispatch\Release()
EndIf
Browser\Release()
EndIf
ProcedureReturn Result
EndProcedure
Procedure SetIDocHostUIHandler(iGadget.i, UIHandler.IDocHostUIHandler)
;#--------------------------------------------------------------------
Protected iResult.i = #False
Protected Document.IHTMLDocument2 = GetIHTMLDocument2(iGadget)
Protected CustomDoc.ICustomDoc
If Document <> #Null
If Document\QueryInterface(?IID_ICustomDoc, @CustomDoc) = #S_OK
CustomDoc\SetUIHandler(UIHandler)
CustomDoc\Release()
iResult = #True
EndIf
Document\Release()
EndIf
ProcedureReturn iResult
EndProcedure
Procedure ScriptRaiseEventCallback(sEventType.s, sEventParam.s)
;#-------------------------------------------------------------
Select sEventParam
EndSelect
EndProcedure
Procedure.s ExecuteJavaScript(iGadget.i, sFunction.s, sArgs.s, sSeparator.s)
;#--------------------------------------------------------------------------
Protected iResult.i, iTotal.i, iCnt.i
Protected sResult.s, sMsg.s
Protected *dispID, *bstr_command, *Arguments
Protected Browser.IWebBrowser2
Protected DocumentDispatch.IDispatch, ScriptDispatch.IDispatch
Protected Document.IHTMLDocument
Protected *Arg.VARIANT, varResult.VARIANT
Protected params.DISPPARAMS
sResult = "ERROR"
Browser = GetWindowLongPtr_(GadgetID(iGadget), #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_(sFunction)
iResult = ScriptDispatch\GetIDsOfNames(?IID_NULL, @*bstr_command, 1, 0, @*dispID)
If iResult = #S_OK
; parse the arguments
;
If Trim(sArgs) = ""
iTotal = 0
*Arguments = 0
Else
iTotal = CountString(sArgs, sSeparator)+1
*Arguments = AllocateMemory(SizeOf(VARIANT)*iTotal)
*Arg = *Arguments
For iCnt = 1 To iTotal
*Arg\vt = #VT_BSTR
*Arg\bstrVal = SysAllocString_(Trim(StringField(sArgs, iCnt, sSeparator)))
*Arg + SizeOf(VARIANT)
Next iCnt
EndIf
params\cArgs = iTotal
params\cNamedArgs = 0
params\rgvarg = *Arguments
iResult = ScriptDispatch\Invoke(*dispID, ?IID_NULL, 0, #DISPATCH_METHOD, @params, @varResult, 0, 0)
If iResult = #S_OK
sResult = StringFromVARIANT(@varResult)
Else
sMsg = Space(3000)
FormatMessage_(#FORMAT_MESSAGE_IGNORE_INSERTS|#FORMAT_MESSAGE_FROM_SYSTEM, 0, iResult, 0, @sMsg, 3000, 0)
sResult = "ERROR: Invoke() " + sMsg
EndIf
If *Arguments
*Arg.VARIANT = *Arguments
For iCnt = 1 To iTotal
SysFreeString_(*Arg\bstrVal)
*Arg + SizeOf(VARIANT)
Next iCnt
FreeMemory(*Arguments)
EndIf
Else
sMsg = Space(3000)
FormatMessage_(#FORMAT_MESSAGE_IGNORE_INSERTS|#FORMAT_MESSAGE_FROM_SYSTEM, 0, iResult, 0, @sMsg, 3000, 0)
sResult = "ERROR: GetIDsOfNames() "+sMsg
EndIf
SysFreeString_(*bstr_command)
ScriptDispatch\Release()
EndIf
Document\Release()
EndIf
DocumentDispatch\Release()
EndIf
ProcedureReturn sResult
EndProcedure
Procedure.s GetJSVariable(iGadget.i, sName.s)
;#-------------------------------------------
Protected iDispid.i, iResult.i
Protected sResult.s, sMsg.s
Protected *bstr_name
Protected Browser.IWebBrowser2
Protected DocumentDispatch.IDispatch, ScriptDispatch.IDispatch
Protected Document.IHTMLDocument
Protected params.DISPPARAMS
Protected varResult.VARIANT
sResult = "ERROR"
Browser = GetWindowLongPtr_(GadgetID(iGadget), #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_(sName)
iResult = ScriptDispatch\GetIDsOfNames(?IID_NULL, @*bstr_name, 1, 0, @iDispid)
If iResult = #S_OK
params\cArgs = 0
params\cNamedArgs = 0
iResult = ScriptDispatch\Invoke(iDispid, ?IID_NULL, 0, #DISPATCH_PROPERTYGET, @params, @varResult, 0, 0)
If iResult = #S_OK
sResult = StringFromVARIANT(@varResult)
Else
sMsg = Space(3000)
FormatMessage_(#FORMAT_MESSAGE_IGNORE_INSERTS|#FORMAT_MESSAGE_FROM_SYSTEM, 0, iResult, 0, @sMsg, 3000, 0)
sResult = "ERROR: Invoke() "+sMsg
EndIf
Else
sMsg = Space(3000)
FormatMessage_(#FORMAT_MESSAGE_IGNORE_INSERTS|#FORMAT_MESSAGE_FROM_SYSTEM, 0, iResult, 0, @sMsg, 3000, 0)
sResult = "ERROR: GetIDsOfNames() "+sMsg
EndIf
SysFreeString_(*bstr_name)
ScriptDispatch\Release()
EndIf
Document\Release()
EndIf
DocumentDispatch\Release()
EndIf
ProcedureReturn sResult
EndProcedure
Procedure SetJSVariable(iGadget, sName.s, sVal.s)
;#-----------------------------------------------
Protected.i iSuccess, iDispid, iResult, iDispidNamed
Protected *bstr_name
Protected Browser.IWebBrowser2
Protected DocumentDispatch.IDispatch, ScriptDispatch.IDispatch
Protected Document.IHTMLDocument
Protected varValue.VARIANT
Protected params.DISPPARAMS
Browser = GetWindowLongPtr_(GadgetID(iGadget), #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_(sName)
iResult = ScriptDispatch\GetIDsOfNames(?IID_NULL, @*bstr_name, 1, 0, @iDispid)
If iResult = #S_OK
varValue\vt = #VT_BSTR
varValue\bstrVal = SysAllocString_(sVal)
iDispidNamed = -3 ; #DISPID_PROPERTYPUT
params\cArgs = 1
params\cNamedArgs = 1
params\rgvarg = @varValue
params\rgdispidNamedArgs = @iDispidNamed
iResult = ScriptDispatch\Invoke(iDispid, ?IID_NULL, 0, #DISPATCH_PROPERTYPUT, @params, 0, 0, 0)
If iResult = #S_OK
iSuccess = 1
EndIf
SysFreeString_(varValue\bstrVal)
EndIf
SysFreeString_(*bstr_name)
ScriptDispatch\Release()
EndIf
Document\Release()
EndIf
DocumentDispatch\Release()
EndIf
ProcedureReturn iSuccess
EndProcedure
Procedure.i WebGadget_GetHTMLDocument2(iGadget.i)
;#-----------------------------------------------
Protected oBrowser.IWebBrowser2 = GetWindowLongPtr_(GadgetID(iGadget), #GWL_USERDATA)
Protected oDocumentDispatch.IDispatch
Protected oHTMLDocument.IHTMLDocument2
Protected iBusy
Repeat
While WindowEvent(): Delay(0): Wend
oBrowser\get_Busy(@iBusy): Delay(10)
Until iBusy = #VARIANT_FALSE
If oBrowser
If oBrowser\get_document(@oDocumentDispatch) = #S_OK
If oDocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @oHTMLDocument) = #S_OK
oDocumentDispatch\Release()
EndIf
EndIf
EndIf
ProcedureReturn oHTMLDocument
EndProcedure
Procedure.i WebGadget_GetHTMLDocumentParent(iGadget.i)
;#----------------------------------------------------
Protected oHTMLDocument.IHTMLDocument2 = WebGadget_GetHTMLDocument2 (iGadget)
Protected oWindow.IHTMLWindow2
If oHTMLDocument
oHTMLDocument\get_parentWindow(@oWindow)
EndIf
oHTMLDocument\Release()
ProcedureReturn oWindow
EndProcedure
Procedure.s StringFromVARIANT(*var.VARIANT)
;#-----------------------------------------
Protected sResult.s
If VariantChangeType_(*var, *var, $2, #VT_BSTR) = #S_OK
sResult = PeekS(*var\bstrVal, PeekL(*var\bstrVal - 4))
SysFreeString_(*var\bstrVal)
Else
sResult = "ERROR : Cannot convert VARIANT to String!"
EndIf
ProcedureReturn sResult
EndProcedure
Procedure WebGadget_SetFocus(iGadget.i)
;#-------------------------------------
Protected oWindow.IHTMLWindow2 = WebGadget_GetHTMLDocumentParent (iGadget)
If oWindow
oWindow\focus()
oWindow\Release()
EndIf
EndProcedure
Procedure WebGadget_ExecScript (iGadget.i, sScriptCode.s, sScriptLanguage.s = "JavaScript")
;#-----------------------------------------------------------------------------------------
Protected oWindow.IHTMLWindow2 = WebGadget_GetHTMLDocumentParent(iGadget)
Protected tVariant.VARIANT
If oWindow
oWindow\execScript (sScriptCode, sScriptLanguage, @tVariant)
oWindow\Release()
EndIf
EndProcedure
Procedure WebGadget_SetFocusByName(iGadget.i, sFieldName.s)
;#----------------------------------------------------------
Protected sScript.s
Delay(500)
sScript = "var elements = document.getElementsByName('" + sFieldName + "');"
sScript + "for (var i = 0; i < elements.length; ++i)"
sScript + "{"
sScript + "if (elements[i].tagName.toLowerCase() == 'input')"
sScript + "{"
sScript + "elements[i].focus();"
sScript + "break;"
sScript + "}"
sScript + "}"
WebGadget_ExecScript(iGadget, sScript)
EndProcedure
Procedure WebGadget_SetFocusByClassName(iGadget.i, sFieldName.s)
;#--------------------------------------------------------------
Protected sScript.s
Delay(500)
sScript = "var elements = document.getElementsByClassName('" + sFieldName + "');"
sScript + "for (var i = 0; i < elements.length; ++i)"
sScript + "{"
sScript + "if (elements[i].tagName.toLowerCase() == 'input')"
sScript + "{"
sScript + "elements[i].focus();"
sScript + "break;"
sScript + "}"
sScript + "}"
WebGadget_ExecScript(iGadget, sScript)
EndProcedure
Procedure WebGadget_SetFocusByID (iGadget.i, sFieldName.s)
;#--------------------------------------------------------
Protected sScript.s
Delay(500)
sScript = "var elements = document.getElementById('"+ sFieldName + "');"
sScript + "if (elements.tagName.toLowerCase() == 'input')"
sScript + "{"
sScript + "elements.focus();"
sScript + "}"
WebGadget_ExecScript(iGadget, sScript)
EndProcedure
Procedure WebGadget_SetTextByID(iGadget.i, sFieldName.s, sText.s)
;#---------------------------------------------------------------
Protected sScript.s
Delay(500)
sScript = "var elements = document.getElementById('" + sFieldName + "');"
sScript + "if (elements.tagName.toLowerCase() == 'input')"
sScript + "{"
sScript + "elements.focus();"
sScript + "}"
WebGadget_ExecScript(iGadget, sScript)
EndProcedure
Procedure WebGadget_SetTextByName(iGadget.i, sFieldName.s, sText.s)
;#-----------------------------------------------------------------
Protected sScript.s
Delay(500)
sScript = "var elements = document.getElementsByName('" + sFieldName + "');"
sScript + "for (var i = 0; i < elements.length; ++i)"
sScript + "{"
sScript + "if (elements[i].tagName.toLowerCase() == 'input')"
sScript + "{"
sScript + "elements[i].focus();"
sScript + "break;"
sScript + "}"
sScript + "}"
WebGadget_ExecScript(iGadget, sScript)
EndProcedure
Procedure WebGadget_SetTextByClassName(iGadget.i, sFieldName.s, sText.s)
;#----------------------------------------------------------------------
Protected sScript.s
Delay(500)
sScript = "var elements = document.getElementsByClassName('" + sFieldName + "');"
sScript + "for (var i = 0; i < elements.length; ++i)"
sScript + "{"
sScript + "if (elements[i].tagName.toLowerCase() == 'input')"
sScript + "{"
sScript + "elements[i].focus();"
sScript + "break;"
sScript + "}"
sScript + "}"
WebGadget_ExecScript(iGadget, sScript)
EndProcedure
Procedure Check_SetFocusByName(iGadget.i, sFieldName.s, sVal.s)
;#-------------------------------------------------------------
Protected sScript.s
Delay(500)
sScript = "var elements = document.getElementsByName('"+ sFieldName + "');"
sScript + "for (var i = 0; i < elements.length; ++i)"
sScript + "{"
sScript + "if (elements[i].tagName.toLowerCase() == 'input')"
sScript + "{"
sScript + "if {elements[i].value() == '" + sVal + "');"
sScript + "document.title = 'YES';"
sScript + "break;"
sScript + "}"
sScript + "}"
sScript + "}"
WebGadget_ExecScript(iGadget, sScript)
EndProcedure
Procedure WebGadget_SelectLink(iGadget.i, iIndex.i)
;#-------------------------------------------------
Protected sScript.s
sScript = "var elements = document.all.tags('a')(" + Str(iIndex) + ");"
sScript + "elements.focus();"
WebGadget_ExecScript(iGadget, sScript)
EndProcedure
ProcedureDLL SetProxy1(sProxy.s, lPort.i, lFlags.i = #INTERNET_OPEN_TYPE_PROXY)
;#-----------------------------------------------------------------------------
;Set proxy for the current session
;Return 1 if success or 0 if fail
Protected ProxyServer.s = sProxy + ":" + Str(lPort)
Protected PIInfo.INTERNET_PROXY_INFO1
PIInfo\dwAccessType = lFlags
PIInfo\lpszProxy = @ProxyServer
PIInfo\lpszProxyBypass = @""
If UrlMkSetSessionOption_(#INTERNET_OPTION_PROXY, @PIInfo, SizeOf(INTERNET_PROXY_INFO1), 0) = #S_OK
ProcedureReturn #True
Else
ProcedureReturn #False
EndIf
EndProcedure
Procedure.s WebGadget_Selection(iGadget.i)
;#----------------------------------------
Protected sUnicodeText.s
Protected sResult.s
Protected Document.IHTMLDocument2 = WebGadget_Document(iGadget,?IID_IHTMLDocument2)
Protected Selection.IHTMLSelectionObject
Protected TextRange.IDispatch
Protected bstr_type.i, pUnicodeText.i, dispid_text.i
Protected params.DISPPARAMS
Protected varResult.VARIANT
If Document
If Document\get_selection(@Selection) = #S_OK
If Selection\get_type(@bstr_type) = #S_OK And bstr_type
If LCase(PeekS(bstr_type,-1,#PB_Unicode))="text"
If Selection\createRange(@TextRange) = #S_OK And TextRange
sUnicodeText = Space(10) : PokeS(@sUnicodeText,"text",-1,#PB_Unicode) : pUnicodeText = @sUnicodeText
If TextRange\GetIDsOfNames(?IID_NULL,@pUnicodeText,1,#LOCALE_SYSTEM_DEFAULT,@dispid_text) = #S_OK
params\cArgs = 0 : params\cNamedArgs = 0
If TextRange\Invoke(dispid_text,?IID_NULL,#LOCALE_SYSTEM_DEFAULT,#DISPATCH_PROPERTYGET,@params,@varResult.VARIANT,0,0)=#S_OK
If varResult\vt = #VT_BSTR
sResult = PeekS(varResult\bstrVal, -1, #PB_Unicode)
Else
VariantChangeType_(@varResult,@varResult,0,#VT_BSTR)
EndIf
VariantClear_(@varResult)
EndIf
EndIf
TextRange\Release()
EndIf
EndIf
SysFreeString_(bstr_type)
EndIf
Selection\Release()
EndIf
Document\Release()
EndIf
ProcedureReturn sResult
EndProcedure
Procedure.s WebGadget_CopyText(iGadget.i)
;#---------------------------------------
Protected sReturn.s
Protected ibstr_text.i
Protected Body.IHTMLElement
Protected Document.IHTMLDocument2 = WebGadget_Document(iGadget, ?IID_IHTMLDocument2)
If Document
If Document\get_body(@Body) = #S_OK
If Body\get_innerText(@ibstr_text) = #S_OK And ibstr_text
sReturn = PeekS(ibstr_text,-1, #PB_Unicode) : SysFreeString_(ibstr_text)
EndIf
Body\Release()
EndIf
Document\Release()
EndIf
ProcedureReturn sReturn
EndProcedure
Procedure WaitForWebGadget(iGadget.i, sTo.s)
;#------------------------------------------
Protected Browser.IWebBrowser2 = GetWindowLongPtr_(GadgetID(iGadget),#GWL_USERDATA)
Protected iBusy.i = 0, iTime.i = 0
Protected iTimeOut.i = #False
Protected sLang.s = PfGetLangName(sTo)
Repeat
While WindowEvent() : Wend : Browser\get_Busy(@iBusy)
If(iBusy <> 0) : Delay(250) : EndIf
iTime = iTime + 250
If (iTime > 5000) : iTimeOut = #True : PfGoogleTransFail(sLang) : EndIf
Until ( (iBusy = #VARIANT_FALSE) Or (iTimeOut = #True) )
EndProcedure
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
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
DataSection
IDocHostUIHandlerImplFunctionTable:
Data.i @IDocHostUIHandlerImpl_QueryInterface()
Data.i @IDocHostUIHandlerImpl_AddRef()
Data.i @IDocHostUIHandlerImpl_Release()
Data.i @IDocHostUIHandlerImpl_ShowContextMenu()
Data.i @IDocHostUIHandlerImpl_GetHostInfo()
Data.i @IDocHostUIHandlerImpl_ShowUI()
Data.i @IDocHostUIHandlerImpl_HideUI()
Data.i @IDocHostUIHandlerImpl_UpdateUI()
Data.i @IDocHostUIHandlerImpl_EnableModeless()
Data.i @IDocHostUIHandlerImpl_OnDocWindowActivate()
Data.i @IDocHostUIHandlerImpl_OnFrameWindowActivate()
Data.i @IDocHostUIHandlerImpl_ResizeBorder()
Data.i @IDocHostUIHandlerImpl_TranslateAccelerator()
Data.i @IDocHostUIHandlerImpl_GetOptionKeyPath()
Data.i @IDocHostUIHandlerImpl_GetDropTarget()
Data.i @IDocHostUIHandlerImpl_GetExternal()
Data.i @IDocHostUIHandlerImpl_TranslateUrl()
Data.i @IDocHostUIHandlerImpl_FilterDataObject()
EndDataSection
DataSection
ExternalIDispatchImplFunctionTable:
Data.i @ExternalIDispatchImpl_QueryInterface()
Data.i @ExternalIDispatchImpl_AddRef()
Data.i @ExternalIDispatchImpl_Release()
Data.i @ExternalIDispatchImpl_GetTypeInfoCount()
Data.i @ExternalIDispatchImpl_GetTypeInfo()
Data.i @ExternalIDispatchImpl_GetIDsOfNames()
Data.i @ExternalIDispatchImpl_Invoke()
EndDataSection