CreateWindowEx ->AtlAxWin -> catch links ?

bingo · Post by **bingo** » Sat Feb 03, 2007 5:39 pm

Import "atl.lib"
  AtlAxWinInit()
EndImport

AtlAxWinInit()

win = OpenWindow(0,0,0,500,400," -| test |- ",#PB_Window_ScreenCentered|#PB_Window_SystemMenu) 

whandle = CreateWindowEx_(0,"AtlAxWin","mshtml:<a href='click1' title='-- test --'>test</a>",#WS_VISIBLE|#WS_CHILD,10,10,400,300,WindowID(0),0,GetModuleHandle_(0),0) 

Repeat

;simplest way to catch a link ?

Until WaitWindowEvent() = #PB_Event_CloseWindow

:roll:

ricardo · Post by **ricardo** » Sat Feb 03, 2007 6:14 pm

http://www.purebasic.fr/english/viewtop ... adget+link

bingo · Post by **bingo** » Sat Feb 03, 2007 7:51 pm

ok ...

Code: Select all

Import "atl.lib"
  AtlAxWinInit()
EndImport

AtlAxWinInit()

win = OpenWindow(0,0,0,500,400," -| test |- ",#PB_Window_ScreenCentered|#PB_Window_SystemMenu) 

whandle = CreateWindowEx_(0,"AtlAxWin","mshtml:<a href='' onclick='test = 1;alert(test);return false' title='-- test --'>test</a>",#WS_VISIBLE|#WS_CHILD,10,10,400,300,WindowID(0),0,GetModuleHandle_(0),0) 

Repeat

;simplest way to read value of variable "test" ?

event = WaitWindowEvent() 

Until event = #PB_Event_CloseWindow

but how can read the value "test" from AtlAxWin / webgadget ?

ricardo · Post by **ricardo** » Sat Feb 03, 2007 9:10 pm

Using Freak's knowledge i made a little example for you.

I use webgadget but may use atl i guess

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

Look and play with the function to run javascripts functions, it rocks!!