#Include once "window9.bi"

Dim shared IWebBrowser As IWebBrowser2Vtbl Ptr

Function WebGadget(ByVal Gadget As Integer,ByVal x As integer,ByVal y As integer,byval Width_ As integer,byval Height_ As integer,byval URL As String=" ",ByVal par1 As Integer=0,ByVal par2 As Integer=0) As Integer Ptr Export
  Dim i As Integer
  Dim pIWebBrowser As Integer Ptr
  Dim AtlAxWinInit As Function As Boolean
  Dim AtlAxGetControl As Function (ByVal hWin As HWND,ByRef pp As Integer ptr) As Integer
  Dim pIUnknown As Integer Ptr
  Dim IUnknown As IUnknownVtbl Ptr  
  Var hDll=LoadLibrary("atl.dll")
  If hDll Then
    AtlAxWinInit=Cast(Any ptr,GetProcAddress(hDll,"AtlAxWinInit"))
    AtlAxGetControl=Cast(Any ptr,GetProcAddress(hDll,"AtlAxGetControl"))
    If AtlAxWinInit() Then
      var hWeb=CreateWindowEx(par2,"AtlAxWin",URL,WS_CHILD Or WS_VISIBLE Or par1,x,y,width_,height_,GETGURRENTAL,Cast(HMENU,gadget),0,0)
      AtlAxGetControl(hWeb,pIUnknown)
      IUnknown=Cast(IUnknownVtbl ptr,*pIUnknown)
      i=IUnknown->AddRef(Cast(IUnknown Ptr,pIUnknown))
      i=IUnknown->QueryInterface(Cast(IUnknown Ptr,pIUnknown),@IID_IWebBrowser2,@pIWebBrowser)            
      IWebBrowser=Cast(IWebBrowser2Vtbl ptr,*pIWebBrowser)
      i=IWebBrowser->AddRef(Cast(IWebBrowser2 Ptr,pIWebBrowser))
      i=IUnknown->Release(Cast(IUnknown Ptr,pIUnknown))
      ADDIN9999(gadget,hWeb)
      Return pIWebBrowser
    EndIf
  EndIf
End Function
Function WebGadgetNavigate(ByVal pIWebBrowser As Integer Ptr,ByVal URL As WString Ptr) As Integer Export
  If *URL<>"" Then
    Return IWebBrowser->Navigate(Cast(IWebBrowser2 Ptr,pIWebBrowser),Cast(BSTR,URL),NULL,NULL,NULL,NULL)
  EndIf
End Function
Function WebGadgetGoForward(ByVal pIWebBrowser As Integer Ptr) As Integer Export
  Return IWebBrowser->GoForward(Cast(IWebBrowser2 Ptr,pIWebBrowser))
End Function
Function WebGadgetGoBack(ByVal pIWebBrowser As Integer Ptr) As Integer Export
  Return IWebBrowser->GoBack(Cast(IWebBrowser2 Ptr,pIWebBrowser))
End Function
Function WebGadgetRefresh(ByVal pIWebBrowser As Integer Ptr) As Integer Export
  Return IWebBrowser->Refresh(Cast(IWebBrowser2 Ptr,pIWebBrowser))
End Function
Function WebGadgetGetURL(ByVal pIWebBrowser As Integer Ptr) As String Export
  Dim As WString ptr buf
  IWebBrowser->get_LocationURL(Cast(IWebBrowser2 Ptr,pIWebBrowser),@buf)
  Return *buf
End Function
Function WebGadgetState(ByVal pIWebBrowser As Integer Ptr) As Integer Export
  Dim state As Integer
  IWebBrowser->get_Busy(Cast(IWebBrowser2 Ptr,pIWebBrowser),Cast(VARIANT_BOOL Ptr,@state))
  Return state
End Function
Function WebGadgetStop(ByVal pIWebBrowser As Integer Ptr) As Integer Export
  Return IWebBrowser->Stop(Cast(IWebBrowser2 Ptr,pIWebBrowser))
End Function
Function WebGadgetGetBody(ByVal pIWebBrowser As Integer Ptr,ByVal flag As bool=0) As String Export
  dim text as wstring ptr
  Dim as IHTMLDocument2 ptr htmldoc2
  Dim As IDispatch ptr doc
  Dim as IHTMLElement ptr BODY
  IWebBrowser->get_Document(Cast(IWebBrowser2 Ptr,pIWebBrowser),@doc)
  if( doc->lpVtbl->QueryInterface( doc, @IID_IHTMLDocument2, cast( PVOID ptr, @htmldoc2 ) ) = S_OK ) Then
    htmlDoc2->lpVtbl->get_body(htmlDoc2, @BODY)
    If flag=0 Then
      BODY->lpVtbl->get_innerHTML(BODY, @TEXT)
    Else
      BODY->lpVtbl->get_outerHTML(BODY, @TEXT)
    EndIf    
    Function=UTFTOASCII(text)
    BODY->lpVtbl->Release( BODY )
    doc->lpVtbl->Release( doc )
    htmlDoc2->lpVtbl->Release( htmlDoc2)
  EndIf
End Function
Sub WebGadgetSetBody(ByVal pIWebBrowser As Integer Ptr,ByVal text As String) Export
  Dim as IHTMLDocument2 ptr htmldoc2
  Dim As IDispatch ptr doc
  Dim as IHTMLElement ptr BODY
  Dim UnicodeText As WString Ptr
  IWebBrowser->get_Document(Cast(IWebBrowser2 Ptr,pIWebBrowser),@doc)
  if( doc->lpVtbl->QueryInterface( doc, @IID_IHTMLDocument2, cast( PVOID ptr, @htmldoc2 ) ) = S_OK ) Then
    htmlDoc2->lpVtbl->get_body(htmlDoc2, @BODY)
    UnicodeText = ASCIITOUTF(text)
    BODY->lpVtbl->put_innerHTML(BODY, UnicodeText)
    BODY->lpVtbl->Release( BODY )
    doc->lpVtbl->Release( doc )
    htmlDoc2->lpVtbl->Release( htmlDoc2)
    DeAllocate(UnicodeText)
  EndIf
End Sub
