Code WebGadgetExtra de ZAPMAN et FREAK marche pas chez moi

[Kwai chang caine]

Bonjour à tous

J'ai trouvé dans ma petite ballade quotidienne, un super génial code de gestion du webbrowser.
Je pense que tout le monde à part moi, le connait, c'est WEBGADGETEXTRA
C'est un code de OUF, il fait tout sauf le ménage dans IE
http://www.purebasic.fr/english/viewtop ... 263#158263

Le bleme c'est que je me suis aperçu qu'il ne marche pas avec tous les sites
Par exemple si on remplace le site de "www.purebasic.fr" par celui de "www.google.fr", rien ne se passe

J'suis triste

Quelqu'un sait il pourquoi

Code : Tout sélectionner

; WG library. By Fr34k and Zapman.
;
; Some of the followings procedure are from Fr34k (Freak) of the english PureBasic Forum
; Thanks a lot to him for sharing!!
; The other ones are from Zapman (french and english forum)
;
;- IID Datasection

DataSection

  IID_IPersistFile: ; {0000010b-0000-0000-C000-000000000046}
    Data.l $0000010B
    Data.w $0000, $0000
    Data.b $00, $00, $00, $00, $00, $00, $00, $46

  IID_IHTMLElement: ; {3050F1FF-98B5-11CF-BB82-00AA00BDCE0B}
    Data.l $3050F1FF
    Data.w $98B5, $11CF
    Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
    
  IID_IHTMLElement2: ; "3050f434-98b5-11cf-bb82-00aa00bdce0b";
    Data.l $3050F434
    Data.w $98B5, $11CF
    Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B

  IID_IHTMLElement3: ; "3050f673-98b5-11cf-bb82-00aa00bdce0b";
    Data.l $3050F673
    Data.w $98B5, $11CF
    Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
    
  IID_IOleCommandTarget: ; {B722BCCB-4E68-101B-A2BC-00AA00404770}
    Data.l $B722BCCB
    Data.w $4E68, $101B
    Data.b $A2, $BC, $00, $AA, $00, $40, $47, $70
    
  IID_IHTMLCurrentStyle: ;3050f3db-98b5-11cf-bb82-00aa00bdce0b
    Data.l $3050F3DB
    Data.w $98B5, $11CF
    Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
    
  IID_IHTMLCurrentStyle2: ;3050f658-98b5-11cf-bb82-00aa00bdce0b
    Data.l $3050F658
    Data.w $98B5, $11CF
    Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B    
    
  IID_IHTMLTxtRange: ;{0x20F25030, 0xB598, 0xCF11, [0xBB, 0x82, 0x00, 0xAA, 0x00, 0xBD, 0xCE, ...
    Data.l $3050F220
    Data.w $98B5, $11CF
    Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
  
  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_IHTMLWindow2: ; {332c4427-26cb-11d0-b483-00c04fd90119}
    Data.l $332C4427
    Data.w $26CB, $11D0
    Data.b $B4, $83, $00, $C0, $4F, $D9, $01, $19
   
  IID_IDisplayServices: ;  { 3050F69D - 98B5 - 11CF - BB82 - 00AA00BDCE0B }. 
    Data.l $3050F69D
    Data.w $98B5, $11CF
    Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
    
  IID_IHTMLEditServices: ; { 3050F663 - 98B5 - 11CF - BB82 - 00AA00BDCE0B }.  
    Data.l $3050F663
    Data.w $98B5, $11CF
    Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
    
  SID_SHTMLEditServices: ;TGUID = (D1: $3050f7f9; D2: $98b5; D3: $11cf; D4: ($bb, $82, $00, $AA, $00, $bd, $ce, $0b));
    Data.l $3050F7F9
    Data.w $98B5, $11CF
    Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
    
  IID_IMarkupServices: ; {3050F4A0-98B5-11CF-BB82-00AA00BDCE0B}.
    Data.l $3050F4A0
    Data.w $98B5, $11CF
    Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
    
  IID_IMarkupTextFrags: ; {3050F5FA-98B5-11CF-BB82-00AA00BDCE0B}.  
    Data.l $3050F5FA
    Data.w $98B5, $11CF
    Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
    
  IID_IServiceProvider: ;  {6D5140C1- 7436-11CE-8034-00AA006009FA}. 
    Data.l $6D5140C1
    Data.w $7436, $11CE
    Data.b $80, $34, $00, $AA, $00, $60, $09, $FA
    
  IID_IHTMLCaret: ;{3050F604-98B5-11CF-BB82-00AA00BDCE0B}. 
    Data.l $3050F604
    Data.w $98B5, $11CF
    Data.b $BB, $82, $00, $AA, $00, $BD, $CE, $0B
    
    
  IID_NULL: ; {00000000-0000-0000-0000-000000000000}
    Data.l $00000000
    Data.w $0000, $0000
    Data.b $00, $00, $00, $00, $00, $00, $00, $00 
    
  IID_IUnknown: ; {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
    
  CGID_MSHTML: ; { DE4BA900 - 59CA - 11CF - 9592 - 444553540000 }
    Data.l $DE4BA900
    Data.w $59CA, $11CF
    Data.b $95, $92, $44, $45, $53, $54, $00, $00

EndDataSection

#IDM_SHOWALLTAGS = 2320;
#IDM_SHOWALIGNEDSITETAGS = 2321;
#IDM_SHOWSCRIPTTAGS = 2322;
#IDM_SHOWSTYLETAGS = 2323;
#IDM_SHOWCOMMENTTAGS = 2324;
#IDM_SHOWAREATAGS = 2325;
#IDM_SHOWUNKNOWNTAGS = 2326;
#IDM_SHOWMISCTAGS = 2327;
#IDM_SHOWZEROBORDERATDESIGNTIME = 2328;
;
#IDM_EDITMODE = 2127
#IDM_2D_POSITION = 2394
#IDM_2D_ELEMENT = 2395
#IDM_1D_ELEMENT = 2396

#IDM_EMPTYGLYPHTABLE = 2336
#IDM_ADDTOGLYPHTABLE = 2337
#IDM_REMOVEFROMGLYPHTABLE = 2338
#IDM_REPLACEGLYPHCONTENTS = 2339


#IDM_SHOWALIGNEDSITETAGS = 2321;
#IDM_SHOWSCRIPTTAGS = 2322;
#IDM_SHOWSTYLETAGS = 2323;
#IDM_SHOWCOMMENTTAGS = 2324;
#IDM_SHOWAREATAGS = 2325;
#IDM_SHOWUNKNOWNTAGS = 2326;
#IDM_SHOWMISCTAGS = 2327;
#IDM_SHOWZEROBORDERATDESIGNTIME = 2328;

Enumeration 0 
  #OLECMDEXECOPT_DODEFAULT 
  #OLECMDEXECOPT_PROMPTUSER 
  #OLECMDEXECOPT_DONTPROMPTUSER 
  #OLECMDEXECOPT_SHOWHELP 
EndEnumeration


#OLECMDERR_E_NOTSUPPORTED = -2147221248
#OLECMDERR_E_DISABLED = -2147221247
#OLECMDERR_E_NOHELP = -2147221246
#OLECMDERR_E_CANCELED = -2147221245
#OLECMDERR_E_UNKNOWNGROUP = -2147221244

Enumeration 0
  #MOVEUNIT_PREVCHAR
  #MOVEUNIT_NEXTCHAR
  #MOVEUNIT_PREVCLUSTERBEG
  #MOVEUNIT_NEXTCLUSTERBEG
  #MOVEUNIT_PREVCLUSTEREND
  #MOVEUNIT_NEXTCLUSTEREND
  #MOVEUNIT_PREVWORDBEG
  #MOVEUNIT_NEXTWORDBEG
  #MOVEUNIT_PREVWORDEND
  #MOVEUNIT_NEXTWORDEND
  #MOVEUNIT_PREVPROOFWORD
  #MOVEUNIT_NEXTPROOFWORD
  #MOVEUNIT_NEXTURLBEG
  #MOVEUNIT_PREVURLBEG
  #MOVEUNIT_NEXTURLEND
  #MOVEUNIT_PREVURLEND
  #MOVEUNIT_PREVSENTENCE
  #MOVEUNIT_NEXTSENTENCE
  #MOVEUNIT_PREVBLOCK
  #MOVEUNIT_NEXTBLOCK
  #MOVEUNIT_ACTION_Max = 2147483647
EndEnumeration
;
Enumeration 0
  #ELEM_ADJ_BeforeBegin
  #ELEM_ADJ_AfterBegin
  #ELEM_ADJ_BeforeEnd
  #ELEM_ADJ_AfterEnd
EndEnumeration
;
;
;_______________________________________________________________________________________________
;
;*************************************************** To use those procedures  ***************************************************
;_______________________________________________________________________________________________
;
; Those procedures are designed to work with a PureBasic's "WebGaget".
; This type of gadget is no more than a window which initiate a cession of Internet Explorer (or Mozilla if you use
; a special flag when creating the WebGadget)
;
; Following procedure won't work with a Mozilla WebGadget.
;
; Many of these procedures have a "WebGadget" argument. You can get such a value by using the Purebasic function "WebGadget" as follow:
; WebGadget = WebGadget(#Pb_Any,0,0,200,200,URL$)
;
; They use the Internet Explorer Interface to make operation on the WebGadget as:
; - make it "editable" (allow the user to modify the content of the showed web page)
; - Retrieve the HTML content (code) of the Web Page
; - Transform and reset the content of the Web Page using your own procedures
;
; They are a "start kit" to make a WYSIWYG HTML Editor.
;
; To use them, you must know what Microsoft calls...
;
; - An "Element": it's a fragment of the HTML content. Usually, an Element is a part of code as
;   "<TAG>content</TAG>" , but in can include other Elements (many tags) if it is a container as <body>.
;  The <body> Element can be for example "<body>Go to my site!<a href="www.mysite.com>Clic HERE!</a></body>"
; - A "TextRange": it's a selection of the page content (usually resulting from a user's selection)
; - A "MarkUp": it's a position into the document. You can convert a TextRange to 2 MarkUps (Start en End of the selection)
; - A "Caret": it's the position of the cursor into the page when the page is editable. It's a type of positionned empty selection.
; - A "HasLayout" quality: Elements which have a defined size or position (containers) have a layout. The others have no layout.
;
;
;
;_______________________________________________________________________________________________
;
;*************************************************** Miscellaneous functions  ****************************************************
;
;_______________________________________________________________________________________________
;
;
Procedure ErrorMessage(Value)  ; By Fr34k
  Message$ = Space(3000) 
  FormatMessage_(#FORMAT_MESSAGE_IGNORE_INSERTS|#FORMAT_MESSAGE_FROM_SYSTEM, 0, Value, 0, @Message$, 3000, 0) 
  MessageRequester("Error","Error #"+Str(Value)+":"+Chr(13)+Message$, #MB_ICONERROR) 
EndProcedure 
;
Procedure.s ReadBSTR(bstr)
  If bstr
    ProcedureReturn PeekS(bstr,-1,#PB_Unicode)
  EndIf
EndProcedure
;
Procedure StringToBStr (string$) ; By Zapman Inspired by Fr34k
  Unicode$ = Space(Len(String$)*2+2)
  PokeS(@Unicode$, String$, -1, #PB_Unicode)
  bstr_string = SysAllocString_(@Unicode$)
  ProcedureReturn bstr_string
EndProcedure
;
Procedure.l Hex2Dec(MotHex.s) ; by Nico and Brossden (french forum)
  For n=1 To Len(MotHex) 
    ValDec.l * 16 + FindString("123456789ABCDEF",UCase(Mid(MotHex,n,1)),1) 
  Next 
  ProcedureReturn ValDec 
EndProcedure 
;
Procedure.s DecodeHTMLFileName (FileName$) ; By Zapman
  p = FindString(FileName$,"%",0)
  While p>0
   p2=p+3
   t$ = Chr(Hex2Dec(Mid(FileName$,p+1,p2-p-1)))
   FileName$ = ReplaceString(FileName$,Mid(FileName$,p,p2-p),t$)
   p = FindString(FileName$,"%",0)
  Wend
  FileName$ = ReplaceString(FileName$,"file:///","")
  FileName$ = ReplaceString(FileName$,"/","\")
  ProcedureReturn FileName$
EndProcedure
;
Procedure.s GetSystemFolder (folder); Unknown author
    If SHGetSpecialFolderLocation_ (0, folder, @itemid) = #NOERROR
        location$ = Space (#MAX_PATH)
        If SHGetPathFromIDList_ (itemid, @location$)
            ProcedureReturn location$
        EndIf
    EndIf
EndProcedure
;
Procedure.s DecodeHtmTexte(tx$); by Zapman
  tx$ = ReplaceString(tx$,"&eacute;","é")
  tx$ = ReplaceString(tx$,"&Eacute;","É")
  tx$ = ReplaceString(tx$,"&ecirc;","ê")
  tx$ = ReplaceString(tx$,"&Ecirc;","Ê")
  tx$ = ReplaceString(tx$,"&egrave;","è")
  tx$ = ReplaceString(tx$,"&auml;","ë")
  tx$ = ReplaceString(tx$,"&acirc;","â")
  tx$ = ReplaceString(tx$,"&agrave;","à")
  tx$ = ReplaceString(tx$,"&auml;","ä")
  tx$ = ReplaceString(tx$,"&aacute;","á")
  tx$ = ReplaceString(tx$,"&ocirc;","ô")
  tx$ = ReplaceString(tx$,"&Ocirc;","Ô")
  tx$ = ReplaceString(tx$,"&ograve;","ò")
  tx$ = ReplaceString(tx$,"&auml;","ö")
  tx$ = ReplaceString(tx$,"&oacute;","ó")
  tx$ = ReplaceString(tx$,"&ugrave;","ù")
  tx$ = ReplaceString(tx$,"&ucirc;","û")
  tx$ = ReplaceString(tx$,"&uuml;","ü")
  tx$ = ReplaceString(tx$,"&uacute;","ú")
  tx$ = ReplaceString(tx$,"&igrave;","ì")
  tx$ = ReplaceString(tx$,"&icirc;","î")
  tx$ = ReplaceString(tx$,"&iuml;","ï")
  tx$ = ReplaceString(tx$,"&iacute;","í")
  tx$ = ReplaceString(tx$,"&yuml;","ÿ")
  tx$ = ReplaceString(tx$,""",Chr(34))
  tx$ = ReplaceString(tx$,"&laquo;","«")
  tx$ = ReplaceString(tx$,"&raquo;","»")
  tx$ = ReplaceString(tx$,"&nbsp;"," ")
  tx$ = ReplaceString(tx$,"&ccedil;","ç")
  tx$ = ReplaceString(tx$,"&ntilde;","ñ")
  tx$ = ReplaceString(tx$,"&","&")
  tx$ = ReplaceString(tx$,"<","<")
  tx$ = ReplaceString(tx$,">",">")
  tx$ = ReplaceString(tx$,"&euro;","€")
  tx$ = ReplaceString(tx$,"&pound;","£")
  tx$ = ReplaceString(tx$,"&yen;","¥")
  tx$ = ReplaceString(tx$,"&cent;","¢")
  tx$ = ReplaceString(tx$,"&curren;","¤")
  tx$ = ReplaceString(tx$,"&copy;","©")
  tx$ = ReplaceString(tx$,"&reg;","®")
  tx$ = ReplaceString(tx$,"&iexcl;","¡")
  tx$ = ReplaceString(tx$,"&quest;","¿")
  tx$ = ReplaceString(tx$,"&szlig;","ß")
  tx$ = ReplaceString(tx$,"&ordm;","º")
  tx$ = ReplaceString(tx$,"&rsquo;","'")
  tx$ = ReplaceString(tx$,Chr(10),"")
  tx$ = ReplaceString(tx$,Chr(13),"")
  tx$ = ReplaceString(tx$,Chr(9),"")
  ProcedureReturn (tx$)
EndProcedure
;
Procedure.s EncodeHtmTexte(tx$); by Zapman
  tx$ = DecodeHtmTexte(tx$)
  tx$ = ReplaceString(tx$,"&","&")
  tx$ = ReplaceString(tx$,"'","&rsquo;")
  tx$ = ReplaceString(tx$,"é","&eacute;")
  tx$ = ReplaceString(tx$,"ê","&ecirc;")
  tx$ = ReplaceString(tx$,"É","&Eacute;")
  tx$ = ReplaceString(tx$,"Ê","&Ecirc;")
  tx$ = ReplaceString(tx$,"è","&egrave;")
  tx$ = ReplaceString(tx$,"ë","&auml;")
  tx$ = ReplaceString(tx$,"â","&acirc;")
  tx$ = ReplaceString(tx$,"à","&agrave;")
  tx$ = ReplaceString(tx$,"ä","&auml;")
  tx$ = ReplaceString(tx$,"á","&aacute;")
  tx$ = ReplaceString(tx$,"ô","&ocirc;")
  tx$ = ReplaceString(tx$,"ò","&ograve;")
  tx$ = ReplaceString(tx$,"ö","&auml;")
  tx$ = ReplaceString(tx$,"ó","&oacute;")
  tx$ = ReplaceString(tx$,"ù","&ugrave;")
  tx$ = ReplaceString(tx$,"û","&ucirc;")
  tx$ = ReplaceString(tx$,"ü","&uuml;")
  tx$ = ReplaceString(tx$,"ú","&uacute;")
  tx$ = ReplaceString(tx$,"ì","&igrave;")
  tx$ = ReplaceString(tx$,"î","&icirc;")
  tx$ = ReplaceString(tx$,"ï","&iuml;")
  tx$ = ReplaceString(tx$,"í","&iacute;")
  tx$ = ReplaceString(tx$,"ÿ","&yuml;")
  tx$ = ReplaceString(tx$,Chr(34),""")
  tx$ = ReplaceString(tx$,"«","&laquo;")
  tx$ = ReplaceString(tx$,"»","&raquo;")
  ;tx$ = ReplaceString(tx$,Chr(10),"&nbsp;")
  tx$ = ReplaceString(tx$,"ç","&ccedil;")
  tx$ = ReplaceString(tx$,"ñ","&ntilde;")
  tx$ = ReplaceString(tx$,"<","<")
  tx$ = ReplaceString(tx$,">",">")
  
  ;tx$ = ReplaceString(tx$,"€","&euro;") provoque un bug avec PB4 quand l'option Unicode est "Off"
  Repeat
    p = FindString(tx$,"€",p+1)
    If p
      tx$ = Left(tx$,p-1)+"&euro;"+Right(tx$,Len(tx$)-p)
    EndIf
  Until p = 0
  
  
  tx$ = ReplaceString(tx$,"£","&pound;")
  tx$ = ReplaceString(tx$,"¥","&yen;")
  tx$ = ReplaceString(tx$,"¢","&cent;")
  tx$ = ReplaceString(tx$,"¤","&curren;")
  tx$ = ReplaceString(tx$,"©","&copy;")
  tx$ = ReplaceString(tx$,"®","&reg;")
  tx$ = ReplaceString(tx$,"¡","&iexcl;")
  tx$ = ReplaceString(tx$,"¿","&quest;")
  tx$ = ReplaceString(tx$,"ß","&szlig;")
  tx$ = ReplaceString(tx$,"º","&ordm;")
  ProcedureReturn (tx$)
EndProcedure
;
Procedure.s ResetAccentAndSpecChar(Content$) ; by Zapman
  ; When Explorer open a document, it analyses all the "special" encoded char (as accentuated chars) included in the text
  ; and convert them to Unicode
  ;
  ; Then, when you ask Explorer to give you back the content of the document, you've loosed all encodages.
  ; This procedure can be called just before to "Save" the content of the document. It resets all encodages.
  ; é will be converted in "&eacute;"
  ; " will be converted in """
  ; etc.
  ;
  ; All the " contentEditable=true" mentions will also be erased from the content.
  ;
  NewContent$ = ""
  p = 1
  Repeat
    If p = 1
      pinf = FindString(LCase(Content$),"<body",0)
    Else
      pinf = FindString(Content$,"<",p)
    EndIf
    If pinf
      If p = 1
        NewContent$ + Mid(Content$,p,pinf-p)
      Else
        NewContent$ + EncodeHtmTexte(Mid(Content$,p,pinf-p))
      EndIf
      psup = FindString(Content$,">",p)
      If psup
        NewContent$ + Mid(Content$,pinf,psup-pinf+1)
        p = psup+1
      Else
        NewContent$ + EncodeHtmTexte(Mid(Content$,pinf,Len(Content$)-pinf))
        p = Len(Content$)
      EndIf
    Else
      NewContent$ + EncodeHtmTexte(Mid(Content$,p,Len(Content$)-p))
      p = Len(Content$)
    EndIf
  Until pinf = 0 Or p=Len(Content$)
  NewContent$ = ReplaceString(NewContent$," contentEditable=true","")
  ProcedureReturn NewContent$
EndProcedure
  
  
;_______________________________________________________________________________________________
;
;************************************************* Get Services and Interfaces **************************************************
;
;_______________________________________________________________________________________________
;
;
Procedure GetBrowser(WebGadget) ; By Zapman Inspired by Fr34k
  If IsGadget(WebGadget)
    If GetGadgetText(WebGadget) = ""
      SetGadgetText(WebGadget, "about:blank") ; to avoid error when using Browser
      While WindowEvent():Wend
    EndIf
    ;
    Browser.IWebBrowser2 = GetWindowLong_(GadgetID(WebGadget), #GWL_USERDATA)
    If Browser
      Ready = 0
      ct = 0
      While Ready < 4 And ct<200
        WindowEvent()
        State = 0
        If Browser\get_ReadyState(@state.l) = #S_OK
          If state = 4
            Ready + 1
          EndIf
        EndIf
        If Ready = 0 : Delay(5) : EndIf
        ct + 1
      Wend
    EndIf
    ProcedureReturn Browser
  EndIf
EndProcedure
;
Procedure GetDocumentDispatch(WebGadget) ;  By Zapman Inspired by Fr34k
  ; Example: DocumentDispatch.IDispatch = GetDocumentDispatch(WebGadget)
  ; Do not forget to release DocumentDispatch when finished to use it
  Browser.IWebBrowser2 = GetBrowser(WebGadget)
  If Browser
    If Browser\get_Document(@DocumentDispatch.IDispatch) = #S_OK
      ProcedureReturn DocumentDispatch
    EndIf
  EndIf
EndProcedure
;
Procedure GetHTMLWindow(WebGadget) ;  By Zapman Inspired by Fr34k
  ; Example: Document.IHTMLDocument2 = GetHTMLWindow(WebGadget)
  ; Do not forget to release Document when finished to use it
  DocumentDispatch.IDispatch = GetDocumentDispatch(WebGadget)
  If DocumentDispatch
    If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @Document.IHTMLDocument2) = #S_OK And Document
      Document\get_parentWindow(@IHTMLWindow.IHTMLWindow2)
      Document\Release()
    EndIf
    DocumentDispatch\Release()
  EndIf
  ProcedureReturn IHTMLWindow
EndProcedure
;
Procedure GetIDisplayServices(WebGadget) ; by Zapman
  ; Example: Service.IDisplayServices = GetIDisplayServices(WebGadget)
  ; Do not forget to release Service when finished to use it
  DocumentDispatch.IDispatch = GetDocumentDispatch(WebGadget)
  If DocumentDispatch
    DocumentDispatch\QueryInterface(?IID_IDisplayServices, @Service.IDisplayServices)
    DocumentDispatch\Release()
  EndIf
  ProcedureReturn Service
EndProcedure
;
Procedure GetTxtRange(WebGadget) ;  By Zapman Inspired by Fr34k
  ; Example: TextRange.IHTMLTxtRange = GetTxtRange(WebGadget)
  ; Do not forget to release TextRange when finished to use it
  DocumentDispatch.IDispatch = GetDocumentDispatch(WebGadget)
  If DocumentDispatch
    If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @Document.IHTMLDocument2) = #S_OK And Document
      If Document\get_selection(@Selection.IHTMLSelectionObject) = #S_OK  And Selection
        If Selection\createRange(@TextRangeDispatch.IDispatch) = #S_OK
          TextRangeDispatch\QueryInterface(?IID_IHTMLTxtRange, @TextRange.IHTMLTxtRange)
          TextRangeDispatch\Release()
        EndIf
        Selection\Release()
      EndIf
      Document\Release()
    EndIf
    DocumentDispatch\Release()
  EndIf
  ProcedureReturn TextRange
EndProcedure
;
Procedure GetIServiceProvider(WebGadget) ; by Zapman
  ; Example: Service.IServiceProvider = GetIServiceProvider(WebGadget)
  ; Do not forget to release Service when finished to use it
  DocumentDispatch.IDispatch = GetDocumentDispatch(WebGadget)
  If DocumentDispatch
    DocumentDispatch\QueryInterface(?IID_IServiceProvider, @Service.IServiceProvider)
    DocumentDispatch\Release()
  EndIf
  ProcedureReturn Service
EndProcedure
;
Procedure GetEditServices(WebGadget) ; by Zapman
  ; Example: EditServices.IHTMLEditServices = GetEditServices(WebGadget)
  ; Do not forget to release EditServices when finished to use it
  Service.IServiceProvider = GetIServiceProvider(WebGadget)
  If Service
    Service\QueryService (?SID_SHTMLEditServices, ?IID_IHTMLEditServices, @EditServices.IHTMLEditServices)
    Service\Release()
  EndIf
  ProcedureReturn EditServices
EndProcedure
;
Procedure GetIMarkupServices(WebGadget) ; by Zapman
  ; Example: MarkupServices.IMarkupServices = GetIMarkupServices(WebGadget)
  ; Do not forget to release the MarkupServices when finished to use it
  DocumentDispatch.IDispatch = GetDocumentDispatch(WebGadget)
  If DocumentDispatch
    DocumentDispatch\QueryInterface(?IID_IMarkupServices, @MarkupServices.IMarkupServices)
    DocumentDispatch\Release()
  EndIf
  ProcedureReturn MarkupServices
EndProcedure
;
;_______________________________________________________________________________________________
;
;********************************************************* Get an Element ********************************************************
;
;_______________________________________________________________________________________________
;
Procedure GetFocusedIHTMLElement(WebGadget) ; by Zapman
  ; Retrieve the element which has the focus (this Element has usually a layout and can be a "Parent" of the element which has the cursor in)
  ; Example: Element.IHTMLElement = GetFocusedElement(WebGadget)
  ; Do not forget to release the Element when finished to use it
  Element.IHTMLElement = 0
  DocumentDispatch.IDispatch = GetDocumentDispatch(WebGadget)
  If DocumentDispatch
    If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @Document.IHTMLDocument2) = #S_OK And Document
      Document\get_activeElement(@Element)
      Document\Release()
    EndIf
    DocumentDispatch\Release()
  EndIf
  ProcedureReturn Element
EndProcedure
;
Procedure GetSelectedIHTMLElement(WebGadget) ; by Zapman
  ; Retrieve the precise element which has the cursor/selected text in
  ; Example: Element.IHTMLElement = GetSelectedElement(WebGadget)
  ; Do not forget to release the Element when finished to use it
  TextRange.IHTMLTxtRange = GetTxtRange(WebGadget)
  If TextRange
    If TextRange\parentElement(@Element.IHTMLElement) = #S_OK And Element          
      ProcedureReturn Element
    EndIf
    TextRange\Release() 
  EndIf
EndProcedure
;
Procedure GetIHTMLElementFromPoint(WebGadget,x,y) ; by Zapman
  ; Retrieve the Element under the position of x,y
  ; Do not forget to release the Element when finished to use it
  result = 0
  DocumentDispatch.IDispatch = GetDocumentDispatch(WebGadget)
  If DocumentDispatch
    If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @Document.IHTMLDocument2) = #S_OK And Document
      If Document\elementFromPoint(x,y,@Element.IHTMLElement) = #S_OK And Element
        Result = Element
      EndIf
      Document\Release()
    EndIf
    DocumentDispatch\Release()
  EndIf
  ProcedureReturn result
EndProcedure
;
Procedure GetIHTMLElementFromIndex(WebGadget.l,Index.l) ; by Zapman
  ; Retrieve an element from its Index
  ; (you can get the index of an element by using the "GetIndexFromElement", "GetFocusedElementIndex", "GetSelectedElementIndex" and  "GetSelectedElementIndex" functions)
  ; Example: Element.IHTMLElement = GetElementFromIndex(WebGadget,Index)
  ; Do not forget to release the Element when finished to use it
  Element.IHTMLElement = 0
  DocumentDispatch.IDispatch = GetDocumentDispatch(WebGadget)
  If DocumentDispatch
    If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @Document.IHTMLDocument2) = #S_OK And Document
      If Document\get_all(@ECollection.IHTMLElementCollection) = #S_OK And ECollection
        varParam.VARIANT\vt = #VT_I4
        varParam\bstrVal = Index
        ECollection\Item(varParam,varParam,@CollectionDispatch.IDispatch)
        If CollectionDispatch
          CollectionDispatch\QueryInterface(?IID_IHTMLElement, @Element.IHTMLElement)
          CollectionDispatch\Release()
        EndIf
        ECollection\Release()
      EndIf
      Document\Release()
    EndIf
    DocumentDispatch\Release()
  EndIf
  ProcedureReturn Element
EndProcedure
;
;_______________________________________________________________________________________________
;
;********************************************************** Element Index *********************************************************
;
;_______________________________________________________________________________________________
;
; If you want to be perfectly "clean" in your way of programming, your main program must not deal directly with "HTML Elements" (IHTMLElement)
;
; Allways use ElementIndex (a simple "long" variable that indicate a unic element) instead of IHTMLElement
;
;
Procedure GetIndexFromElement (Element.IHTMLElement) ; by Zapman
  ; Return the index of the IHTMLElement
  Index = 0
  If Element
    Element\get_sourceIndex(@Index.l)
    Element\Release()
  EndIf
  ProcedureReturn Index
EndProcedure
;
Procedure GetFocusedElementIndex(WebGadget) ; by Zapman
  ; Return the index of the element which has the focus (this Element has usually a layout and can be a "Parent" of the element which has the cursor in)
  Element.IHTMLElement = GetFocusedIHTMLElement(WebGadget)
  ProcedureReturn GetIndexFromElement (Element.IHTMLElement)
EndProcedure
;
Procedure GetSelectedElementIndex(WebGadget) ; by Zapman
  ; Get the index of the precise element which has the cursor in
  Element.IHTMLElement = GetSelectedIHTMLElement(WebGadget)
  ProcedureReturn GetIndexFromElement (Element.IHTMLElement)
EndProcedure
;
Procedure GetElementIndexFromPoint(WebGadget,x,y) ; by Zapman
  ; Get the index of the element under the position of x,y
  Element.IHTMLElement = GetIHTMLElementFromPoint(WebGadget,x,y)
  ProcedureReturn GetIndexFromElement (Element.IHTMLElement)
EndProcedure
;_______________________________________________________________________________________________
;
;************************************************************** Full Tag ************************************************************
;               The "full tag" is a tag including the element id/class. Example: <body #myid> or <div .divclass>
;_______________________________________________________________________________________________
;
;
Procedure.s GetFullTagFromIHTMLElement(*Element.IHTMLElement) ; by Zapman
  bstr.l = 0
  If *Element\get_tagName(@bstr) = #S_OK And bstr
    FullTag$ = PeekS(bstr, -1, #PB_Unicode)
    SysFreeString_(bstr)
  EndIf
  bstr.l = 0
  If *Element\get_className(@bstr) = #S_OK And bstr
    FullTag$+" ."+ PeekS(bstr, -1, #PB_Unicode)
    SysFreeString_(bstr)
  EndIf
  bstr.l = 0
  If *Element\get_id(@bstr) = #S_OK And bstr
    FullTag$+" #"+ PeekS(bstr, -1, #PB_Unicode)
    SysFreeString_(bstr)        
  EndIf
  ProcedureReturn FullTag$
EndProcedure
;
Procedure.s GetFullTagFromElementIndex(WebGadget.l,Index.l) ; by Zapman
  Element.IHTMLElement = GetIHTMLElementFromIndex(WebGadget.l,Index.l)
  If Element
    FullTag$ = GetFullTagFromIHTMLElement(Element.IHTMLElement)
    Element\Release()
  EndIf
  ProcedureReturn FullTag$
EndProcedure
;
;_______________________________________________________________________________________________
;
;******************************************************** Get Element Infos *******************************************************
;
;_______________________________________________________________________________________________
;
;
Structure ElementInfo ; Custom structure designed for this library
  tagname.s
  classname.s
  id.s
  innerHTML.s
  outerHTML.s
  innertext.s
  stringrep.s
  link.s
  alt.s
  offsetHeight.l
  offsetWidth.l
  offsetTop.l
  offsetLeft.l
  index.l
  taglist.s
  parentIndexList.s
EndStructure
;
;
;
Procedure.s GetFullTagFromElementInfo(*Element.ElementInfo) ; by Zapman
  
  FullTag$ = *Element\tagname
  If *Element\classname
    FullTag$+" ."+*Element\classname
  EndIf
  If *Element\id
    FullTag$+" #"+*Element\id
  EndIf
  ProcedureReturn FullTag$
EndProcedure
;
Procedure GetIHTMLElementInfos(Element.IHTMLElement,*Element.ElementInfo) ; by Zapman
  ; Get the element Infos of "Element" and return the infos into the "ElementInfo" variable given in argument
  If Element And *Element
    bstr.l = 0
    If Element\get_tagName(@bstr) = #S_OK And bstr
      *Element\tagname = PeekS(bstr, -1, #PB_Unicode)
      SysFreeString_(bstr)
    Else
      *Element\tagname = ""
    EndIf
    bstr.l = 0
    If Element\get_className(@bstr) = #S_OK And bstr
      *Element\classname = PeekS(bstr, -1, #PB_Unicode)
      SysFreeString_(bstr)
    Else
      *Element\classname = ""
    EndIf
    bstr.l = 0
    If Element\get_id(@bstr) = #S_OK And bstr
      *Element\id = PeekS(bstr, -1, #PB_Unicode)
      SysFreeString_(bstr)
    Else
      *Element\id = ""  
    EndIf
    bstr.l = 0
    If Element\get_innerHTML(@bstr) = #S_OK And bstr
      *Element\innerHTML = PeekS(bstr, -1, #PB_Unicode)
      SysFreeString_(bstr)
    Else
      *Element\innerHTML = ""
    EndIf
    bstr.l = 0
    If Element\get_outerHTML(@bstr) = #S_OK And bstr
      *Element\outerHTML = PeekS(bstr, -1, #PB_Unicode)
      SysFreeString_(bstr)
    Else
      *Element\outerHTML = ""
    EndIf
    bstr.l = 0
    If Element\get_innerText(@bstr) = #S_OK And bstr
      *Element\innertext = PeekS(bstr, -1, #PB_Unicode)
      SysFreeString_(bstr)
    Else
      *Element\innertext = ""
    EndIf
    bstr.l = 0
    If Element\toString(@bstr) = #S_OK And bstr
      *Element\stringrep = PeekS(bstr, -1, #PB_Unicode)
      SysFreeString_(bstr)
    Else
      *Element\stringrep = ""
    EndIf      
    If Element\getAttribute("href", 0, @varResult.VARIANT) = #S_OK
      If varResult\vt = #VT_BSTR And varResult\bstrVal
        *Element\link = PeekS(varResult\bstrVal, -1, #PB_Unicode)
        SysFreeString_(varResult\bstrVal)
      Else
        *Element\link = ""
      EndIf
    EndIf
    If Element\getAttribute("alt", 0, @varResult.VARIANT) = #S_OK
      If varResult\vt = #VT_BSTR And varResult\bstrVal
        *Element\alt = PeekS(varResult\bstrVal, -1, #PB_Unicode)
        SysFreeString_(varResult\bstrVal)
      Else
        *Element\alt = ""
      EndIf
    EndIf
    If Element\get_offsetHeight(@Hvalue.l) = #S_OK
      *Element\offsetHeight = HValue
    Else
      *Element\offsetHeight = 0
    EndIf
    If Element\get_offsetWidth(@Hvalue.l) = #S_OK
      *Element\offsetWidth = HValue
    Else
      *Element\offsetWidth = 0
    EndIf
    If Element\get_offsetTop(@Hvalue.l) = #S_OK
      *Element\offsetTop = HValue
    Else
      *Element\offsetTop = 0
    EndIf
    If Element\get_offsetLeft(@Hvalue.l) = #S_OK
      *Element\offsetLeft = HValue
    Else
      *Element\offsetLeft = 0
    EndIf
    If Element\get_sourceIndex(@Index.l) = #S_OK
      *Element\index = Index
    Else
      *Element\index = 0
    EndIf
    ;
    *Element\taglist = "<"+GetFullTagFromIHTMLElement(Element)+">"
    *Element\ParentIndexList = "<"+Str(*Element\index)+">"
    While Element And Element\get_parentElement(@Parent.IHTMLElement) = #S_OK
      Element\Release()
      Element = Parent
      If Element
        *Element\taglist = "<"+GetFullTagFromIHTMLElement(Element)+">"+*Element\taglist
        If Element\get_sourceIndex(@Index.l) = #S_OK
          *Element\ParentIndexList = "<"+Str(Index)+">"+*Element\ParentIndexList
        Else
          *Element\ParentIndexList = "<??>"+*Element\ParentIndexList
        EndIf
      EndIf
    Wend
    If Element : Element\Release() : EndIf
    ProcedureReturn 1
  Else
    ProcedureReturn 0
  EndIf
EndProcedure
;
Procedure GetElementInfosFromIndex(WebGadget,Index,*Element.ElementInfo) ; by Zapman
  ; Get the elementInfos of the element indicated by "Index" and return the infos into the "ElementInfo" variable given in argument
  ; (you can get the index of an element by using the "GetFocusedElement" or the "GetSelectedElement" functions)
  result = 0
  Element.IHTMLElement = GetIHTMLElementFromIndex(WebGadget,Index)
  If Element
    Result = GetIHTMLElementInfos(Element,*Element.ElementInfo)
    Element\Release()
  EndIf
  ProcedureReturn result
EndProcedure
;
Procedure GetFocusedElementInfos(WebGadget,*Element.ElementInfo) ; by Zapman
  ; Get the elementInfos of the element which has the focus and return the infos into the "ElementInfo" variable given in argument
  ; (this Element has usually a layout and can be a "Parent" of the element which has the cursor in)
  ; Example: GetFocusedElementInfos(WebGadget,Element.ElementInfo)
  result = 0
  Element.IHTMLElement = GetFocusedIHTMLElement(WebGadget)
  If Element
    Result = GetIHTMLElementInfos(Element.IHTMLElement,*Element.ElementInfo)
  EndIf
  ProcedureReturn Result
EndProcedure
;
Procedure GetSelectedElementInfos(WebGadget,*Element.ElementInfo) ; by Zapman
  ; Get the elementInfos of the element which has the cursor in and return the infos into the "ElementInfo" variable given in argument
  ; Example: GetSelectedElementInfos(WebGadget,Element.ElementInfo)
  result = 0
  Element.IHTMLElement = GetSelectedIHTMLElement(WebGadget)
  If Element
    Result = GetIHTMLElementInfos(Element.IHTMLElement,*Element.ElementInfo)
  EndIf
  ProcedureReturn Result
EndProcedure
;
Procedure GetElementInfosFromPoint(WebGadget,x,y,*Element.ElementInfo) ; by Zapman
  ;1- Retrieve the Element under the position of x,y
  ;2- Get the elementInfos of this element and return the infos into the "ElementInfo" variable given in argument
  Element.IHTMLElement = GetIHTMLElementFromPoint(WebGadget,x,y)
  ProcedureReturn GetIHTMLElementInfos(Element,*Element.ElementInfo)
EndProcedure
;
Procedure SelectAllElementContent(WebGadget,ElementIndex) ; by Zapman
  ; Select (HighLight) all the content of an Element designed by its index
  ; (you can get the index of an element by using the "GetFocusedElement" or the "GetSelectedElement" functions)
  Element.IHTMLElement = GetIHTMLElementFromIndex(WebGadget,ElementIndex)
  If Element
    MarkupServices.IMarkupServices = GetIMarkupServices(WebGadget)
    If MarkupServices
      MarkupServices\CreateMarkupPointer (@MarkupPointer1.IMarkupPointer)
      MarkupServices\CreateMarkupPointer (@MarkupPointer2.IMarkupPointer)
      TextRange.IHTMLTxtRange = GetTxtRange(WebGadget)
      If TextRange And MarkupPointer1 And MarkupPointer2
        MarkupPointer1\MoveAdjacentToElement(Element,#ELEM_ADJ_BeforeBegin)
        MarkupPointer2\MoveAdjacentToElement(Element,#ELEM_ADJ_AfterEnd)
        
        MarkupServices\MoveRangeToPointers(MarkupPointer1,MarkupPointer2,TextRange)
        TextRange\select()

        MarkupPointer1\Release() 
        MarkupPointer2\Release() 
        TextRange\Release() 
      EndIf
      MarkupServices\Release() 
    EndIf
    Element\Release() 
  EndIf
EndProcedure
;
;_______________________________________________________________________________________________
;
;*********************************************************** WebGadget ***********************************************************
;
;_______________________________________________________________________________________________
;
;
Procedure WebGadget_Open(WebGadget, AddHistory) ; by Fr34k - modified by Zapman
  result = 0
  Document.IHTMLDocument2 = 0
  DocumentDispatch.IDispatch = GetDocumentDispatch(WebGadget)
  If DocumentDispatch
    If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @Document.IHTMLDocument2) = #S_OK  And Document
      varName.VARIANT\vt = #VT_BSTR
      If AddHistory                    
        varName\bstrVal = SysAllocString_(@NULLString.l)
      Else
        varName\bstrVal = StringToBStr ("replace")
      EndIf
      
      varEmpty.VARIANT\vt = #VT_EMPTY
      
      If Document\open("text/html", varName, varEmpty, varEmpty, @Dummy.IDispatch) = #S_OK
        If Dummy
          Dummy\Release()
        EndIf
        result = 1
      EndIf        
      SysFreeString_(varName\bstrVal)
      Document\Release()
    EndIf          
    DocumentDispatch\Release()
  EndIf  
  
  ProcedureReturn result
EndProcedure
;
Procedure WebGadget_Close(WebGadget) ; by Fr34k - modified by Zapman
  Document.IHTMLDocument2 = 0
  DocumentDispatch.IDispatch = GetDocumentDispatch(WebGadget)
  If DocumentDispatch
    If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @Document.IHTMLDocument2) = #S_OK  And Document
      Document\close()
      Document\Release()
    EndIf
    DocumentDispatch\Release()
  EndIf
EndProcedure
;
Procedure WebGadget_Write(WebGadget,String$,CloseAfter) ; by Fr34k - modified by Zapman
  Result = 0
  Document.IHTMLDocument2 = 0
  DocumentDispatch.IDispatch = GetDocumentDispatch(WebGadget)
  If DocumentDispatch
    If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @Document.IHTMLDocument2) = #S_OK And Document
      bstr_string = StringToBStr (String$)
      *sfArray = SafeArrayCreateVector_(#VT_VARIANT, 0, 1)
      If *sfArray      
        If SafeArrayAccessData_(*sfArray, @*varParam.VARIANT) = #S_OK
        
          *varParam\vt = #VT_BSTR
          *varParam\bstrVal = bstr_string
          
          If SafeArrayUnaccessData_(*sfArray) = #S_OK
            Document\writeln(*sfArray)
            Result = 1
            If CloseAfter
              Document\close()
            EndIf
          EndIf
        
        EndIf      
        SafeArrayDestroy_(*sfArray)
      EndIf
      
      SysFreeString_(bstr_string)
      Document\Release()
    EndIf
    DocumentDispatch\Release()
  EndIf
  ProcedureReturn Result
EndProcedure
;
Procedure SaveBrowserContent(WebBrowser,Filename$) ; by Zapman
  ; Save the whole HTML document contained by the WebBrowser gadget into a file named as "Filename$"
  DocumentDispatch.IDispatch = GetDocumentDispatch(WebGadget)
  If DocumentDispatch
    If DocumentDispatch\QueryInterface(?IID_IPersistFile, @File.IPersistFile) = #S_OK And File
      If Filename$ = ""
        File\Save(0,0)
      Else
        File\Save(@Filename$,0)
      EndIf
      File\SaveCompleted(@Filename$)
      File\Release()
    EndIf
    DocumentDispatch\Release()
  EndIf
EndProcedure
;
Procedure WebGadget_ReplaceContent(WebGadget,String$) ; by Zapman
  WebGadget_Open(WebGadget, 0)
  Result = WebGadget_Write(WebGadget,String$,1)
EndProcedure
;
Procedure WebGadget_IsLoaded(WebGadget) ; by Fr34k - modified by Zapman
  ProcedureReturn GetBrowser(WebGadget)
EndProcedure
;
Procedure SetWebGadgetEditable(WebGadget,value$) ; by Zapman
  ; value$ can be "On" (editable), "Off" (non-editable) or "Inherit" (as its parent)
  ; Set all the HTML document as editable
  ; CAUTION : Javascripts will be deactivated!!!!!
  ;
  ; See also the "SetElementEditableFromPoint" and "SetParentElementEditableFromPoint" procedures in the "Editable Elements" section.
  ;
  result = 0
  DocumentDispatch.IDispatch = GetDocumentDispatch(WebGadget)
  If DocumentDispatch
    If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @Document.IHTMLDocument2) = #S_OK And Document
      bStr = StringToBStr (value$)
      If Document\put_designMode(PeekS(bstr, -1, #PB_Unicode)) = #S_OK
        result = 1
      EndIf
      SysFreeString_(bStr)
      Document\Release()
    EndIf
    
    DocumentDispatch\Release()
  EndIf
  ProcedureReturn result
EndProcedure
;
Procedure.s GetSelectedHTMLText(WebGadget,TextOrHTML$) ; by Fr34k - modified by Zapman
  ; TextOrHTML$ can be "text" or "htmlText" to get the selected text or the selected HTML code
  ; --> understand "selected" as "highlighted by the user"
  Result$ = ""
  DocumentDispatch.IDispatch = GetDocumentDispatch(WebGadget)
  If DocumentDispatch
    If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @Document.IHTMLDocument2) = #S_OK And Document
       If Document\get_selection(@Selection.IHTMLSelectionObject) = #S_OK  And Selection
          ; first we should check the type of the selection, because if a control 
          ; is selected, you will get a different object from createRange()! 
          If Selection\get_type(@bstr_string) = #S_OK 
            Type$ = ReadBSTR(bstr_string) 
            SysFreeString_(bstr_string) 
          Else 
            Type$ = "" 
          EndIf 
          If LCase(Type$) = "none" 
              ; nothing is selected
          ElseIf LCase(Type$) = "text" Or TextOrHTML$ = "htmlText"
            ; ok, get the IDispatch for the TextRange object 
            If Selection\createRange(@TextRangeDispatch.IDispatch) = #S_OK    
              ; bstr_name = MakeBSTR("htmlText") to get html code  or  bstr_name = MakeBSTR("text") to get the text
              bstr_name = StringToBSTR(TextOrHTML$)
              
              ; get the dispid of the property we want to get       
              If TextRangeDispatch\GetIDsOfNames(?IID_NULL, @bstr_name, 1, 0, @dispid.l) = #S_OK 
                arguments.DISPPARAMS\cArgs = 0
                ;
                ; now read the actual property. 
                result= TextRangeDispatch\Invoke(dispid, ?IID_NULL, 0, #DISPATCH_PROPERTYGET, @arguments, @varResult.VARIANT, 0, 0) 
                If result = #S_OK And varResult\vt = #VT_BSTR 
                  SelectedText$ = ReadBSTR(varResult\bstrVal) 
                  SysFreeString_(varResult\bstrVal) 
                  Result$ = SelectedText$
                Else 
                  ErrorMessage(result) 
                EndIf 
              EndIf 
              SysFreeString_(bStr_name)
              TextRangeDispatch\Release() 
            EndIf        
          ElseIf LCase(Type$) =  "control" 
            ; A control is selected.

          Else
              ; Error! 
          EndIf
          Selection\Release() 
        EndIf
        
      Document\Release()
    EndIf
    
    DocumentDispatch\Release()
  EndIf
  ProcedureReturn Result$
EndProcedure
;
Procedure WebGadget_Exec(WebGadget.l,command.l,option.l,*pvalIn.l,*pvaOut.l)  ; by Zapman
  Browser.IWebBrowser2 = GetBrowser(WebGadget)
  If Browser 
    Result = Browser\ExecWB(command, option, *pvalIn,*pvaOut)
    If Result = #S_OK
      ProcedureReturn 1
    ElseIf Result = #OLECMDERR_E_UNKNOWNGROUP 
      TxError$ = "Error with the IWebBrowser2::ExecWB() method:"+Chr(13)+"The pguidCmdGroup parameter is not NULL but does not specify a recognized command group."
    ElseIf Result = #OLECMDERR_E_NOTSUPPORTED
      TxError$ = "Error with the IWebBrowser2::ExecWB() method:"+Chr(13)+"The nCmdID parameter is not a valid command in the group identified by pguidCmdGroup."
    ElseIf Result = #OLECMDERR_E_DISABLED 
      TxError$ = "Error with the IWebBrowser2::ExecWB() method:"+Chr(13)+"The command identified by nCmdID is currently disabled And cannot be executed." 
    ElseIf Result = #OLECMDERR_E_NOHELP 
      TxError$ = "Error with the IWebBrowser2::ExecWB() method:"+Chr(13)+"The caller has asked hor help on the command identified by nCmdID, but no help is available."
    ElseIf Result = #OLECMDERR_E_CANCELED 
      TxError$ = "Error with the IWebBrowser2::ExecWB() method:"+Chr(13)+"The user canceled the execution of the command."
    EndIf
    If TxError$ : MessageRequester("Error",TxError$,0) : EndIf
  EndIf 
  ProcedureReturn 0 
EndProcedure
;
Procedure ActiveGlyph(Webgadget) ; by Zapman
  ; Sample code!!!!!!!!!
  ; Actually it just activate the glyph for the "H1" tag.
  ;
  ; You must record the images for the H1 glyph as "glyphs/h1bgn.gif" and "glyphs/h1bgn.gif" before being able to use that procedure
  
  ; must be completed
  result = 0
  *Buffer = AllocateMemory(1000)
  GetCurrentDirectory_(1000,*buffer)
  InitialDir$ = ReplaceString(PeekS(*Buffer),"\","/")
  FreeMemory(*Buffer)
  glyph$ = "%%h1^^%%file:///"+InitialDir$+"/glyphs/h1bgn.gif^^%%0^^%%3^^%%0^^%%4^^%%20^^%%15^^%%5^^%%15^^**"
  glyph$ + "%%h1^^%%file:///"+InitialDir$+"/glyphs/h1end.gif^^%%1^^%%3^^%%0^^%%4^^%%20^^%%15^^%%19^^%%15^^**"
  glyph = StringToBStr (glyph$)
  ;
  DocumentDispatch.IDispatch = GetDocumentDispatch(WebGadget)
  If DocumentDispatch
    If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @Document.IHTMLDocument2) = #S_OK And Document
      If Document\QueryInterface(?IID_IOleCommandTarget, @pCmdTarg.IOleCommandTarget) = #S_OK And pCmdTarg
        pCmdTarg\Exec(?CGID_MSHTML,#IDM_EMPTYGLYPHTABLE,#OLECMDEXECOPT_DODEFAULT,0,0)
        
        *sfArray = SafeArrayCreateVector_(#VT_VARIANT, 0, 1)
        If *sfArray      
          If SafeArrayAccessData_(*sfArray, @*varParam.VARIANT) = #S_OK
          
            *varParam\vt = #VT_BSTR
            *varParam\bstrVal = glyph
            
            If SafeArrayUnaccessData_(*sfArray) = #S_OK
              pCmdTarg\Exec(?CGID_MSHTML,#IDM_ADDTOGLYPHTABLE,#OLECMDEXECOPT_DODEFAULT,*varParam,0)
            EndIf
          
          EndIf      
          SafeArrayDestroy_(*sfArray)
        EndIf

        pCmdTarg\Release()
      EndIf
      Document\Release()
    EndIf
  EndIf
  SysFreeString_(glyph)
EndProcedure
;
Procedure InsertStringAtElementPos(WebGadget,ElementIndex,InsertedString$,BeforeAfter$) ; by Zapman
  ; Insert the "InsertedString$" string into the HTML document contained by "WebGadget"
  ; Position of the inserted string is relative to an "Element" indicated by its index (you can get the index of an element by using the "GetFocusedElement", "GetSelectedElement",...  functions - see the "index" section above)
  ;
  ; Precise position is relative to what follows:
  ; BeforeAfter$ can be:
  ; - "BeforeBegin" to insert the string before the begining of the Element
  ; - "AfterBegin" to insert the string after the start tag of the Element
  ; - "BeforeEnd" to insert the string before the end tag of the Element
  ; - "AfterEnd" to insert the string immediately after the Element
  Result = 0
  Element.IHTMLElement = GetIHTMLElementFromIndex(WebGadget,ElementIndex)
  If Element
    MarkupServices.IMarkupServices = GetIMarkupServices(WebGadget)
    If MarkupServices
      MarkupServices\CreateMarkupPointer (@MarkupPointer1.IMarkupPointer)
      If MarkupPointer1
        If LCase(BeforeAfter$) = "beforebegin"
          MarkupPointer1\MoveAdjacentToElement(Element,#ELEM_ADJ_BeforeBegin)
        ElseIf LCase(BeforeAfter$) = "afterbegin"
          MarkupPointer1\MoveAdjacentToElement(Element,#ELEM_ADJ_AfterBegin)
        ElseIf LCase(BeforeAfter$) = "beforeend"
          MarkupPointer1\MoveAdjacentToElement(Element,#ELEM_ADJ_BeforeEnd)
        ElseIf LCase(BeforeAfter$) = "afterend"
          MarkupPointer1\MoveAdjacentToElement(Element,#ELEM_ADJ_AfterEnd)
        EndIf
        MarkupPointer1\GetContainer(@MarkupContainer.IMarkupContainer)
        If MarkupContainer
          bstr = StringToBStr(InsertedString$)
          MarkupServices\InsertText(bStr,Len(InsertedString$),MarkupPointer1)
          SysFreeString_(bstr)
          Result = 1
          MarkupContainer\Release() 
        EndIf
        MarkupPointer1\Release() 
      EndIf
      MarkupServices\Release() 
    EndIf
    Element\Release() 
  EndIf
  ProcedureReturn Result
EndProcedure
;
Procedure.s GetDocumentURLFromBrowser(WebGadget); by Zapman
  ; Get the URL of the document currently loaded into the WebGadget
  Browser.IWebBrowser2 = GetBrowser(WebGadget)
  If Browser
    bstr.l = 0
    If Browser\get_LocationURL(@bstr) = #S_OK And bstr
      URL$ = PeekS(bstr, -1, #PB_Unicode)
    EndIf
    SysFreeString_(bstr)
  EndIf
  ProcedureReturn URL$
EndProcedure
;
Procedure.s GetDocumentHTMLContent(WebGadget); by Zapman
  ; Retrieve the all HTML content of the document which is in the Webgadget
  Result$ = ""
  DocumentDispatch.IDispatch = GetDocumentDispatch(WebGadget)
  If DocumentDispatch
    If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @Document.IHTMLDocument2) = #S_OK And Document
      Document\get_body(@Element.IHTMLElement); Get the <BODY> Element
      If Element
        If Element\get_parentElement(@Parent.IHTMLElement) = #S_OK And Parent; Get the <HTML> Element
          Parent\get_outerHTML(@bstr)
          Parent\Release()
        EndIf
        Element\Release()
      EndIf
      Document\Release()
    EndIf
    DocumentDispatch\Release()
  EndIf

  If bstr
    WholeText$ = PeekS(bstr, -1, #PB_Unicode) ; get the whole text of the document
    SysFreeString_(bstr)
  EndIf
  ProcedureReturn WholeText$
EndProcedure
;
Procedure SetDocumentHTMLContent(WebGadget,WholeText$); by Zapman
  ; Set the new content to the browser without changing the URL
  ;
  ; I don't use WebGadget_Write() because it gives the focus to WebGadget and it can be a problem
  ; I don't know how Fred has make its SetGadgetText function, but it does'nt give the focus to the WebGadget
  FileName$ = GetDocumentURLFromBrowser(WebGadget)
  If Left(FileName$,5) = "about"
    #CSIDL_INTERNET_CACHE = $20
    FileName$ = GetSystemFolder (folder)+"temp_file.html"
  EndIf
  FileName$ = DecodeHTMLFileName (FileName$)
  DeleteFile(FileName$)
  TempFile = OpenFile(#PB_Any,FileName$)
  If TempFile = 0 : ProcedureReturn -1 : EndIf
  WriteString(TempFile,WholeText$,#PB_Ascii)
  CloseFile(TempFile)
  SetGadgetText(WebGadget, FileName$)
EndProcedure
;
Procedure SetElementOuterTextFromIndex(WebGadget,Index,NewOuterText$) ; by Zapman
  ;
  ; Explorer has a function that allows to set/replace the full content of an Element
  ;
  ; Unfortunatelly, it does'nt work with some Element as <Body>, <TD>,...
  ;
  ; This is a (bad) try to solve that limitation
  ; Please just look at it as an attempt
  ;
  StartFlag$ = "hereisthestartoftheoldelement"
  EndFlag$  = "hereistheendoftheoldelement"
  InsertStringAtElementPos(WebGadget,Index,EndFlag$,"AfterEnd") ; Set a flag at the end of the element
  InsertStringAtElementPos(WebGadget,Index,StartFlag$,"BeforeBegin") ; Set a flag at the start of the element
        
  WholeText$ = GetDocumentHTMLContent(WebGadget) ; get the whole text of the document
  SysFreeString_(bstr)
  p1 = FindString(WholeText$,StartFlag$,0) ; Search our two flags to know the position of the old content
  If p1 = 0 : MessageRequester("Error","The start flag is lost!!! (SetElementOuterTextFromIndex)",0) : ProcedureReturn -1 : EndIf
  p2 = FindString(WholeText$,EndFlag$,p1)
  If p2 = 0 : MessageRequester("Error","The end flag is lost!!! (SetElementOuterTextFromIndex)",0) : ProcedureReturn -1 : EndIf
  ;
  ; Replace the old content by the new one

  WholeText$ = Left(WholeText$,p1-1)+NewOuterText$+Right(WholeText$,Len(WholeText$)-(p2+ Len(EndFlag$))+1)
  ;
  ; Set the new content to the browser
  SetDocumentHTMLContent(WebGadget,WholeText$)

EndProcedure
;
Procedure FindInWebGadget(ToSearch$,NextOrNot.l,WebGadget) ; by Zapman
  ; Look for the "ToSearch$" string into the current Element of the HTML document contained by WebGadget and select (highlight) the corresponding text if found
  ; The "current element" is the one which has the focus.
  ; Set "NextOrNot" to zero to get a normal search. Set it to one to get a "find next" search.
  If ToSearch$
    TextRange.IHTMLTxtRange = GetTxtRange(WebGadget)
    If TextRange
      If NextOrNot
        TextRange\collapse(#VARIANT_FALSE) ; collapse to the end of the previous selection
      EndIf
      bStr = StringToBStr (ToSearch$)
      varOut.VARIANT\vt = #VT_BOOL
      If TextRange\findText(PeekS(bstr, -1, #PB_Unicode),$7FFFFFFF,0,@varOut) = #S_OK
        TextRange\select()
        TextRange\parentElement(@Element.IHTMLElement)
        If Element
          TextRange\movetoelementtext(Element)
          Element\Release() 
        EndIf
      EndIf
      SysFreeString_(bStr)
      TextRange\Release() 
    EndIf
  EndIf
EndProcedure
;
;_______________________________________________________________________________________________
;
;****************************************************** Has Layout or not? *******************************************************
;
;_______________________________________________________________________________________________
;
;
;
Procedure GetHasLayoutFromElement(Element.IHTMLElement) ; by Zapman
  ; Return 1 if the Element has a layout (an absolute position)
  ; Return 0 in the opposite case
  Result = -1
  If Element
    If Element\QueryInterface(?IID_IHTMLElement2, @Element2.IHTMLElement2) = #S_OK And Element2
      If  Element2\get_currentStyle(@Style.IHTMLCurrentStyle) = #S_OK And Style
        If Style\QueryInterface(?IID_IHTMLCurrentStyle2, @Style2.IHTMLCurrentStyle2) = #S_OK And Style2
          If Style2\get_hasLayout(@Layout.l) = #S_OK
            If  Layout = #VARIANT_TRUE
              Result = 1
            Else
              Result = 0
            EndIf
          EndIf
          Style2\Release()
        EndIf
        Style\Release()
      EndIf
      Element2\Release()
    EndIf
  EndIf
  ProcedureReturn Result
EndProcedure
;
;_______________________________________________________________________________________________
;
;******************************************************* Editable Elements *******************************************************
;
;_______________________________________________________________________________________________
;
;
;
Procedure SetElementEditableFromPoint(WebGadget,x,y,value$) ; by Zapman
  ;1- Retrieve the Element under the position of x,y
  ;2- Make this element editable or not
  ; value$ can be "true" (editable), "false" (non-editable) or "inherit" (as its parent)
  result = 0
  Element.IHTMLElement = GetIHTMLElementFromPoint(WebGadget,x,y)
  If Element
    If Element\QueryInterface(?IID_IHTMLElement3, @Element3.IHTMLElement3) = #S_OK And Element3
      bStr = StringToBStr (value$)
      If Element3\put_contentEditable(PeekS(bstr, -1, #PB_Unicode)) = #S_OK
        result = 1
      EndIf
      SysFreeString_(bStr)
      Element3\Release()
    EndIf
    Element\Release()
  EndIf
  ProcedureReturn result
EndProcedure
;
Procedure SetElementEditableFromIndex(WebGadget,Index,value$) ; by Zapman
  ;1- Retrieve the Element under the position of x,y
  ;2- Make this element editable or not
  ; value$ can be "true" (editable), "false" (non-editable) or "inherit" (as its parent)
  result = 0
  Element.IHTMLElement = GetIHTMLElementFromIndex(WebGadget,Index)
  If Element
    If Element\QueryInterface(?IID_IHTMLElement3, @Element3.IHTMLElement3) = #S_OK And Element3
      bStr = StringToBStr (value$)
      If Element3\put_contentEditable(PeekS(bstr, -1, #PB_Unicode)) = #S_OK
        result = 1
      EndIf
      SysFreeString_(bStr)
      Element3\Release()
    EndIf
    Element\Release()
  EndIf
  ProcedureReturn result
EndProcedure

[Kwai chang caine]

Suite car comme dirait zezette "ça tiens pas tout dans les cases"
"Alors ça dépend ça dépasse"

Code : Tout sélectionner

;
Procedure SetParentElementEditableFromPoint(WebGadget,x,y,value$) ; by Zapman
  ;1- Retrieve the Element under the position of x,y
  ;2- Look for the parent element which has a layout (an absolute position)
  ;3- Make the parent element editable or not
  ; value$ can be "true" (editable), "false" (non-editable) or "inherit" (as its parent)
  result = 0
  DocumentDispatch.IDispatch = GetDocumentDispatch(WebGadget)
  If DocumentDispatch
    If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @Document.IHTMLDocument2) = #S_OK And Document
      If Document\elementFromPoint(x,y,@Element.IHTMLElement) = #S_OK And Element
        ;

        Parent.IHTMLElement = 0
        cont = 1
        Repeat
          Layout = GetHasLayoutFromElement(Element) ; Look for the first parent having LAYOUT property
          If Layout = 1
            Tagname$ = ""
            bstr.l = 0
            If Element\get_tagName(@bstr) = #S_OK And bstr
              Tagname$ = PeekS(bstr, -1, #PB_Unicode)
              SysFreeString_(bstr)
            EndIf
            If LCase(Tagname$)="td" Or  LCase(Tagname$)="tr" Or  LCase(Tagname$)="table" ; Explorer considere that those element as having a layout, but that's wrong!
              Layout = 0
            EndIf
          EndIf
          If Layout = 0
            If Element\get_parentElement(@Parent.IHTMLElement) = #S_OK And Parent
              Element\Release()
              Element = Parent
            EndIf
          EndIf
        Until Layout
        ;
        If Layout = 1
          If Element\QueryInterface(?IID_IHTMLElement3, @Element3.IHTMLElement3) = #S_OK And Element3
            bStr = StringToBStr (value$)
            If Element3\put_contentEditable(PeekS(bstr, -1, #PB_Unicode)) = #S_OK
              result = 1
            EndIf
            SysFreeString_(bStr)
            Element3\Release()
          EndIf
        EndIf
        
        If Element : Element\Release() : EndIf
      EndIf
      
      Document\Release()
    EndIf
    
    DocumentDispatch\Release()
  EndIf
  ProcedureReturn result
EndProcedure
;
; See also the "SetWebGadgetEditable" procedure in the "WebGadget" section
;
;_______________________________________________________________________________________________
;
;****************************************************** Let's play with links  ******************************************************
;                                                             The following is made by Fr34k
;_______________________________________________________________________________________________
;

;- IDispatch Implementation

Structure IDispatchVtbl
  QueryInterface.l
  AddRef.l
  Release.l
  GetTypeInfoCount.l
  GetTypeInfo.l
  GetIDsOfNames.l
  Invoke.l
EndStructure

Structure IDispatchObject
  Vtbl.l    
  RefCount.l
  
  Function.l
  WebGadget.l
  Window.IHTMLWindow2
  IsMouseHandler.l
EndStructure

Global NewList IDispatchObjects.IDispatchObject()

Procedure IDispatch_QueryInterface(*THIS.IDispatchObject, *IID.IID, *Object.LONG)
  If *Object = 0
    ProcedureReturn #E_INVALIDARG
  ElseIf CompareMemory(*IID, ?IID_IUnknown, SizeOf(IID)) Or CompareMemory(*IID, ?IID_IDispatch, SizeOf(IID))
    *Object\l = *THIS
    *THIS\RefCount + 1
    ProcedureReturn #S_OK  
  Else
    *Object\l = 0
    ProcedureReturn #E_NOINTERFACE  
  EndIf
EndProcedure
;
Procedure IDispatch_AddRef(*THIS.IDispatchObject)
  *THIS\RefCount + 1
  ProcedureReturn *THIS\RefCount
EndProcedure
;
Procedure IDispatch_Release(*THIS.IDispatchObject)
  *THIS\RefCount - 1
  If *THIS\RefCount <= 0    
    ChangeCurrentElement(IDispatchObjects(), *THIS)    
    IDispatchObjects()\Window\Release()    
    DeleteElement(IDispatchObjects())
    ProcedureReturn 0
  Else
    ProcedureReturn *THIS\RefCount
  EndIf
EndProcedure
;
Procedure IDispatch_GetTypeInfoCount(*THIS.IDispatchObject, *pctinfo.LONG)
  If *pctinfo = 0
    ProcedureReturn #E_INVALIDARG
  Else
    *pctinfo\l = 0
    ProcedureReturn #S_OK
  EndIf
EndProcedure
;
Procedure IDispatch_GetTypeInfo(*THIS.IDispatchObject, iTInfo, lcid, *pptInfo)
  ProcedureReturn #E_NOTIMPL
EndProcedure
;
Procedure IDispatch_GetIDsOfNames(*THIS.IDispatchObject, *riid.IID, *rgszNames, cNames, lcid, *rgDispID.LONG)
  If CompareMemory(*riid, ?IID_NULL, SizeOf(IID)) = 0
    ProcedureReturn #DISP_E_UNKNOWNINTERFACE
  ElseIf *rgDispID = 0 Or cNames = 0
    ProcedureReturn #E_INVALIDARG
  Else
    While cNames > 0 ; we provide no names, so set all passed fields to DISPID_UNKNOWN (-1)
      *rgDispID\l = -1
      *rgDispID + 4
      cNames - 1
    Wend
    ProcedureReturn #DISP_E_UNKNOWNNAME
  EndIf
EndProcedure
;
Procedure IDispatch_Invoke(*THIS.IDispatchObject, dispIdMember, *riid.IID, lcid, wFlags.w, *pDispParams.DISPPARAMS, *pVarResult.VARIANT, *pExcpInfo, *puArgErr)
  If CompareMemory(*riid, ?IID_NULL, SizeOf(IID)) = 0
    ProcedureReturn #DISP_E_UNKNOWNINTERFACE
  ElseIf dispIdMember <> 0 Or wFlags <> #DISPATCH_METHOD
    ProcedureReturn #DISP_E_MEMBERNOTFOUND
  ElseIf *pDispParams = 0
    ProcedureReturn #E_INVALIDARG
  ElseIf *pDispParams\cNamedArgs > 0
    ProcedureReturn #DISP_E_NONAMEDARGS
  ElseIf *pDispParams\cArgs > 0
    ProcedureReturn #DISP_E_BADPARAMCOUNT
  Else
    
    If *THIS\Window\get_event(@Event.IHTMLEventObj) = #S_OK
    
      If *THIS\IsMouseHandler
        If Event\get_button(@button) = #S_OK
          If button = 2 Or button = 3 Or button = 6 Or button = 7
            varReturn.VARIANT\vt = #VT_BOOL
            varReturn\boolVal    = #VARIANT_FALSE        
            Event\put_returnValue(varReturn)
          EndIf
        EndIf
      
      Else
    
        If Event\get_srcElement(@Element.IHTMLElement) = #S_OK
        
          ; Walk up the tags until the actual link is found, as there can be
          ; an image inside the link for example
          ;
          Repeat
            Abort = 1
            If Element\get_tagName(@bstr_tag) = #S_OK And bstr_tag
              Tag$ = PeekS(bstr_tag, -1, #PB_Unicode)
              SysFreeString_(bstr_tag)
              
              If UCase(Tag$) <> "A"
              Debug Tag$
                If Element\get_parentElement(@Parent.IHTMLElement) = #S_OK
                  Element\Release()
                  Element = Parent
                  Abort = 0
                EndIf
              EndIf
            EndIf
          Until Abort
        
          If Element\get_className(@bstr_class) = #S_OK And bstr_class
            Class$ = PeekS(bstr_class, -1, #PB_Unicode)
            SysFreeString_(bstr_class)
          EndIf
          
          If Element\get_id(@bstr_id) = #S_OK And bstr_id
            ID$ = PeekS(bstr_id, -1, #PB_Unicode)
            SysFreeString_(bstr_id)        
          EndIf
          
          If Element\get_innerText(@bstr_text) = #S_OK And bstr_text
            Text$ = PeekS(bstr_text, -1, #PB_Unicode)
            SysFreeString_(bstr_text)        
          EndIf
                    
          If Element\getAttribute("href", 0, @varResult.VARIANT) = #S_OK
            If varResult\vt = #VT_BSTR And varResult\bstrVal
              Link$ = PeekS(varResult\bstrVal, -1, #PB_Unicode)
              SysFreeString_(varResult\bstrVal)             
            EndIf
          EndIf
          
          If CallFunctionFast(*THIS\Function, *THIS\WebGadget, Link$, Text$, ID$, Class$)
            varReturn.VARIANT\vt = #VT_BOOL
            varReturn\boolVal    = #VARIANT_TRUE        
          Else
            varReturn.VARIANT\vt = #VT_BOOL
            varReturn\boolVal     = #VARIANT_FALSE        
          EndIf        
          Event\put_returnValue(varReturn)
        
        EndIf
      
      EndIf
      
      Event\Release()
    EndIf
    
    ProcedureReturn #S_OK
  EndIf
EndProcedure
;
;
Global IDispatchVtbl.IDispatchVtbl

IDispatchVtbl\QueryInterface   = @IDispatch_QueryInterface()
IDispatchVtbl\AddRef           = @IDispatch_AddRef()
IDispatchVtbl\Release          = @IDispatch_Release()
IDispatchVtbl\GetTypeInfoCount = @IDispatch_GetTypeInfoCount()
IDispatchVtbl\GetTypeInfo      = @IDispatch_GetTypeInfo()
IDispatchVtbl\GetIDsOfNames    = @IDispatch_GetIDsOfNames()
IDispatchVtbl\Invoke           = @IDispatch_Invoke()

Procedure WebGadget_CatchLinks(WebGadget, Callback); by Fr34k
; Deactivate all the links of the HTML document contained by the WebGadget
; and call the procedures indicated by IDispatchVtbl when the user click onto a link
  DocumentDispatch.IDispatch = GetDocumentDispatch(WebGadget)
  If DocumentDispatch
    If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @Document.IHTMLDocument2) = #S_OK And Document
    
      If Document\get_links(@LinkCollection.IHTMLElementCollection) = #S_OK And LinkCollection
        If LinkCollection\get_length(@LinkCount) = #S_OK
        
          If LinkCount = 0
            result = 1
          Else
          
            If Document\get_parentWindow(@Window.IHTMLWindow2) = #S_OK And Window
              
              AddElement(IDispatchObjects())
              IDispatchObjects()\Vtbl     = @IDispatchVtbl
              IDispatchObjects()\RefCount = 1
              IDispatchObjects()\Window   = Window
              IDispatchObjects()\WebGadget   = WebGadget
              IDispatchObjects()\Function = Callback
              IDispatchObjects()\IsMouseHandler = 0
              Dispatch.IDispatch = @IDispatchObjects()
              
              varDispatch.VARIANT
              varDispatch\vt = #VT_DISPATCH
              varDispatch\pdispVal = Dispatch                    
              
              AddElement(IDispatchObjects())
              IDispatchObjects()\Vtbl     = @IDispatchVtbl
              IDispatchObjects()\RefCount = 1
              IDispatchObjects()\Window   = Window
              IDispatchObjects()\WebGadget   = WebGadget
              IDispatchObjects()\Function = Callback
              IDispatchObjects()\IsMouseHandler = 1
              MouseDispatch.IDispatch = @IDispatchObjects()                  
              
              varDispatch2.VARIANT
              varDispatch2\vt = #VT_DISPATCH
              varDispatch2\pdispVal = MouseDispatch                
              
              For index = 0 To LinkCount-1
                varIndex.VARIANT\vt = #VT_I4
                varIndex\lVal = index      
                ElementDispatch.IDispatch = 0
                
                If LinkCollection\item(varIndex, varIndex, @ElementDispatch.IDispatch) = #S_OK And ElementDispatch
                  If ElementDispatch\QueryInterface(?IID_IHTMLElement, @Element.IHTMLElement) = #S_OK And Element          
                  
                    Element\put_onclick(varDispatch) 
                    Element\put_onmouseup(varDispatch2) 
                    Element\put_onmousedown(varDispatch2) 
                    Element\Release()
                    
                  EndIf          
            
                  ElementDispatch\Release()
                EndIf                  
              Next index
              
              MouseDispatch\Release()
              If Dispatch\Release() <> 0
                result = 1
              EndIf
              
            EndIf                           
          EndIf          
        EndIf
        
        LinkCollection\Release()
      EndIf
                  
      Document\Release()
    EndIf          
    DocumentDispatch\Release()
  EndIf
  ProcedureReturn result
EndProcedure
;
Procedure WebGadget_UnCatchLinks(WebGadget) ; by Zapman from a Fr34k procedure
; Simply deactivate all the links of the HTML document contained by the WebGadget
  DocumentDispatch.IDispatch = GetDocumentDispatch(WebGadget)
  If DocumentDispatch
    If DocumentDispatch\QueryInterface(?IID_IHTMLDocument2, @Document.IHTMLDocument2) = #S_OK And Document
    
      If Document\get_links(@LinkCollection.IHTMLElementCollection) = #S_OK And LinkCollection 
        If LinkCollection\get_length(@LinkCount) = #S_OK
        
          If LinkCount = 0
            result = 1
          Else
          
            If Document\get_parentWindow(@Window.IHTMLWindow2) = #S_OK And Window  
              varDispatch.VARIANT
              varDispatch\vt = #VT_DISPATCH
              varDispatch\pdispVal = 0
              For index = 0 To LinkCount-1
                varIndex.VARIANT\vt = #VT_I4
                varIndex\lVal = index      
                ElementDispatch.IDispatch = 0
                
                If LinkCollection\item(varIndex, varIndex, @ElementDispatch.IDispatch) = #S_OK And ElementDispatch ; must check this value according to the docs, as even on failure, #S_OK is returned
                  If ElementDispatch\QueryInterface(?IID_IHTMLElement, @Element.IHTMLElement) = #S_OK And Element
                  
                    Element\put_onclick(varDispatch) 
                    Element\put_onmouseup(varDispatch) 
                    Element\put_onmousedown(varDispatch) 
                    Element\Release()
                    
                  EndIf          
                  ElementDispatch\Release()
                EndIf                  
              Next index
              
            EndIf                           
          EndIf
        EndIf
        
        LinkCollection\Release()
      EndIf
                  
      Document\Release()
    EndIf          
    DocumentDispatch\Release()
  EndIf
  ProcedureReturn result
EndProcedure

Procedure.s PutMyMarkupsAndGetTheElementCode(WebGadget) ; by Zapman 
 TextRange.IHTMLTxtRange = GetTxtRange(WebGadget) 
  If TextRange 
    bstr.l = 0 
    If TextRange\get_text(@bstr) = #S_OK And bstr And PeekS(bstr,-1,#PB_Unicode) 
      SelectedText$ = PeekS(bstr,-1,#PB_Unicode) 
      SysFreeString_(bstr) 
      If TextRange\parentElement(@Element.IHTMLElement) = #S_OK And Element 
        bstr.l = 0 
        If Element\get_outerText(@bstr) = #S_OK And bstr And PeekS(bstr,-1,#PB_Unicode) 
          ElementText$ = PeekS(bstr,-1,#PB_Unicode) 
          SysFreeString_(bstr) 
          MarkupServices.IMarkupServices = GetIMarkupServices(WebGadget) 
          If MarkupServices 
            MarkupServices\CreateMarkupPointer (@MarkupPointer1.IMarkupPointer) 
            If MarkupPointer1 
              MarkupServices\CreateMarkupPointer (@MarkupPointer2.IMarkupPointer) 
              If MarkupPointer2 
                If Trim(SelectedText$) = Trim(ElementText$) ; Selection matchs with the whole Element content -> Include the tags into the selection. 
                  MarkupPointer1\MoveAdjacentToElement(Element,#ELEM_ADJ_BeforeBegin) 
                  MarkupPointer2\MoveAdjacentToElement(Element,#ELEM_ADJ_AfterEnd) 
                Else 
                  MarkupServices\MovePointersToRange(TextRange,MarkupPointer1,MarkupPointer2) 
                EndIf 
                InsertedString1$ = "hereisthestartoftheoldcode" 
                bStr = StringToBStr (InsertedString1$) 
                MarkupServices\InsertText(bStr,Len(InsertedString1$),MarkupPointer1) 
                SysFreeString_(bStr) 
                InsertedString2$ = "hereistheendoftheoldcode" 
                bStr = StringToBStr (InsertedString2$) 
                MarkupServices\InsertText(bStr,Len(InsertedString2$),MarkupPointer2) 
                SysFreeString_(bStr) 
                MarkupPointer2\Release() 
                If Element\get_outerHTML(@bStr) = #S_OK And bStr 
                  Result$ = ReadBSTR(bstr) 
                  SysFreeString_(bStr) 
                  If FindString(Result$,InsertedString1$,0)=0 Or FindString(Result$,InsertedString2$,0)=0 ; one of the markups has been inserted before the entry tag of after the ending tag 
                    If Element\get_parentElement(@Parent.IHTMLElement) = #S_OK And Parent 
                      Element\Release() 
                      Element = Parent 
                      If Element\get_outerHTML(@bStr) = #S_OK And bStr 
                        Result$ = ReadBSTR(bstr) 
                        SysFreeString_(bStr) 
                      EndIf 
                    Else 
                      Result$ = "" 
                    EndIf 
                  EndIf 
                EndIf 
              EndIf 
              MarkupPointer1\Release() 
            EndIf 
            MarkupServices\Release() 
          EndIf 
        EndIf 
        Element\Release() 
      EndIf 
    EndIf 
    TextRange\Release() 
  EndIf 
  ProcedureReturn Result$ 
EndProcedure 

Global StringToPaste$ = "<h1>Just to try</h1>" 

Procedure StringToPaste(WebGadget,StringToPaste$)
 
 #OLECMDID_PASTE = 13 
 VarIn.variant\VT = #VT_BSTR 
 VarIn\bstrVal = StringToBStr (StringToPaste$) 
 WebGadget_Exec(WebGadget,#OLECMDID_PASTE,#OLECMDEXECOPT_DONTPROMPTUSER,@VarIn,@VarOut.variant) 
 SysFreeString_(VarIn\bstrVal) 

EndProcedure
 
Procedure RemoveMyMarkupsAndSelectTextInside(WebGadget) ; by Zapman 
  TextRange.IHTMLTxtRange = GetTxtRange(WebGadget) 
  If TextRange 
    MarkupServices.IMarkupServices = GetIMarkupServices(WebGadget) 
    If MarkupServices 
      If TextRange\parentElement(@Element.IHTMLElement) = #S_OK And Element 
        MarkupServices\CreateMarkupPointer (@MarkupPointerS1.IMarkupPointer) 
        If MarkupPointerS1 
          MarkupServices\CreateMarkupPointer (@MarkupPointerS2.IMarkupPointer) 
          If MarkupPointerS2 
            MarkupPointerS1\MoveAdjacentToElement(Element,#ELEM_ADJ_BeforeBegin) ; Extend TextRange to the whole Element content 
            MarkupPointerS2\MoveAdjacentToElement(Element,#ELEM_ADJ_AfterEnd) 
            MarkupServices\MoveRangeToPointers(MarkupPointerS1,MarkupPointerS2,TextRange) 
            bStr = StringToBStr ("hereisthestartoftheoldcode") 
            varOut.VARIANT\vt = #VT_BOOL 
            If TextRange\findText(PeekS(bstr, -1, #PB_Unicode),$7FFFFFFF,0,@varOut) = #S_OK       ; look for the first markup 
              MarkupServices\MovePointersToRange(TextRange,MarkupPointerS1,MarkupPointerS2) 
              MarkupServices\Remove(MarkupPointerS1,MarkupPointerS2)                                                   ; remove my first markup 
              bStr = StringToBStr ("hereistheendoftheoldcode") 
              varOut.VARIANT\vt = #VT_BOOL 
              If TextRange\findText(PeekS(bstr, -1, #PB_Unicode),$7FFFFFFF,0,@varOut) = #S_OK      ; look for the second markup 
                MarkupServices\CreateMarkupPointer (@MarkupPointerE1.IMarkupPointer) 
                If MarkupPointerE1 
                  MarkupServices\CreateMarkupPointer (@MarkupPointerE2.IMarkupPointer) 
                  If MarkupPointerE2 
                    MarkupServices\MovePointersToRange(TextRange,MarkupPointerE1,MarkupPointerE2) 
                    MarkupServices\Remove(MarkupPointerE1,MarkupPointerE2)                                              ; remove my second markup 
                    MarkupServices\MoveRangeToPointers(MarkupPointerS1,MarkupPointerE2,TextRange) 
                     TextRange\select() 
                    MarkupPointerE2\Release() 
                    Result = 1 
                  EndIf ; If MarkupPointerE2 
                  MarkupPointerE1\Release() 
                EndIf ; If MarkupPointerE1 
              EndIf ; If TextRange\findText(PeekS(bstr, -1, #PB_Unicode),$7FFFFFFF,0,@varOut) = #S_OK 
            EndIf ; If TextRange\findText(PeekS(bstr, -1, #PB_Unicode),$7FFFFFFF,0,@varOut) = #S_OK 
            MarkupPointerS2\Release() 
          EndIf ; If MarkupPointerS2 
          MarkupPointerS1\Release() 
        EndIf ; If MarkupPointerS1 
        Element\Release() 
      EndIf ; If TextRange\parentElement(@Element.IHTMLElement) = #S_OK And Element 
      MarkupServices\Release() 
    EndIf ; If MarkupServices 
    TextRange\Release() 
  EndIf ; If TextRange 
  ProcedureReturn Result 
EndProcedure

; Procedure.s PutHTMLCodeAtCaretPos(WebGadget,HTMLCode$) ; by Zapman 
;   WebGadget_Exec(WebGadget,#OLECMDID_DELETE,#OLECMDEXECOPT_DODEFAULT,0,0) ; this line is necessary because PasteHTML doesn't always erase completely the old content (that's one of the IE bugs) 
;   TextRange.IHTMLTxtRange = GetTxtRange(WebGadget) 
;   If TextRange 
;     bstr = StringToBStr (HTMLCode$) 
;     TextRange\PasteHTML(ReadBSTR(bstr)) 
;     SysFreeString_(bstr) 
;     TextRange\Release() 
;   EndIf 
; EndProcedure

OpenWindow(0,0,0,1200,700,"Test",#PB_Window_ScreenCentered|#PB_Window_MaximizeGadget|#PB_Window_MinimizeGadget|#PB_Window_SizeGadget) 
CreateGadgetList(WindowID(0)) 
ComboBoxGadget(1, 100, 650, 200, 200 ,#PB_ComboBox_Editable)
WebGadget(0,20,20,1100,600,"") 
SetGadgetText(0,"http://www.purebasic.fr")
Delay (200)
AddGadgetItem(1, -1, "Voir URL du Browser")
AddGadgetItem(1, -1, "Voir le contenu de la page")
AddGadgetItem(1, -1, "Rechercher dans la page")
AddGadgetItem(1, -1, "Atteindre un élément")
AddGadgetItem(1, -1, "Voir élément sélectionné")

Repeat 

 Event = WaitWindowEvent() 
 
 Select GetGadgetText(1)
 
  Case "Voir URL du Browser"
   
   MessageRequester("Essai Internet Explorer", GetDocumentURLFromBrowser(0) ,0)
   SetGadgetText(1,"")
   
  Case "Voir le contenu de la page"
   
   MessageRequester("Essai Internet Explorer", GetDocumentHTMLContent(0) ,0)
   SetGadgetText(1,"")
  
  Case "Rechercher dans la page"
   
   Recherche$ = InputRequester("Essai Internet Explorer", "Tapez votre recherche", "")
   FindInWebGadget(Recherche$,1,0)         
   SetGadgetText(1,"")
  
  Case "Atteindre un élément"
   
   Recherche$ = InputRequester("Essai Internet Explorer", "Quel numero d'element voulez-vous atteindre ?", "")
   GetIHTMLElementFromIndex(0,Val(Recherche$))  
   SetGadgetText(1,"")
  
  Case "Voir élément sélectionné"
   Debug  GetFocusedIHTMLElement(0) 
   SetGadgetText(1,"")
  
 EndSelect  
 
Until Event = #PB_Event_CloseWindow 


; *************************************************************************************************************************
;                                        CODE DE COMMANDE D'ORIGINE DE ZAPMAN
; *************************************************************************************************************************

; ButtonWidth = 60 : ButtonHeight = 18 : ButtonLineHeight = ButtonHeight + 6
; ;
; MyWindow=OpenWindow(#PB_Any,0,0,600,400,"WebgadgetLibrary demo",#PB_Window_ScreenCentered|#PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_MaximizeGadget | #PB_Window_SizeGadget | #PB_Window_TitleBar) 
; If CreateGadgetList(WindowID(MyWindow))=0:End:EndIf
; ;
; WebGadget = WebGadget(#PB_Any,0,0,WindowWidth(MyWindow),WindowHeight(MyWindow)-ButtonLineHeight,"about:blank")
; ;
; ;HTMLSample$ = "<html><head></head><body><div align="+Chr(34)+"center"+Chr(34)+"><p>WebGadget Library demo</p><p>&nbsp;</p><p>By Fr34k And Zapman</p></div></body></html>"
; HTMLSample$ ="http://www.google.fr"
; SetDocumentHTMLContent(WebGadget,HTMLSample$)
; ;
; HPos = 5
; ButtonFind = ButtonGadget(#PB_Any,HPos,WindowHeight(MyWindow)-ButtonHeight-2,ButtonWidth,ButtonHeight,"Find")
; HPos + ButtonWidth +10
; ComboContent = ComboBoxGadget(#PB_Any,HPos,WindowHeight(MyWindow)-ButtonHeight-4,100,100)
; AddGadgetItem(ComboContent,-1,"Element 0 infos")
; AddGadgetItem(ComboContent,-1,"Element 1 infos")
; AddGadgetItem(ComboContent,-1,"Element 2 infos")
; AddGadgetItem(ComboContent,-1,"Element 3 infos")
; AddGadgetItem(ComboContent,-1,"Element 4 infos")
; AddGadgetItem(ComboContent,-1,"Element 5 infos")
; AddGadgetItem(ComboContent,-1,"Element 6 infos")
; AddGadgetItem(ComboContent,-1,"Element 7 infos")
; SetGadgetState(ComboContent,0)
; HPos  +102
; ButtonDisplay = ButtonGadget(#PB_Any,HPos,WindowHeight(MyWindow)-ButtonHeight-2,ButtonWidth,ButtonHeight,">>Display")
; HPos  + ButtonWidth + 10
; ButtonEdit = ButtonGadget(#PB_Any,HPos,WindowHeight(MyWindow)-ButtonHeight-2,80,ButtonHeight,"Edit mode")
; HPos  + 80 + 10
; ButtonRankSpirit = ButtonGadget(#PB_Any,HPos,WindowHeight(MyWindow)-ButtonHeight-2,ButtonWidth,ButtonHeight,"RankSpirit")
; HPos  + ButtonWidth + 40
; MouseText = TextGadget(#PB_Any,HPos,WindowHeight(MyWindow)-ButtonHeight,130,ButtonHeight,"Last clic was over...")
; 
; EditMode$ = "Off"
; Repeat  
;   ;
;   EventID = WaitWindowEvent()
;   If  EventID = #PB_Event_CloseWindow
;     Quit = 1
;   ElseIf EventID=#WM_SIZE
;     ResizeGadget(WebGadget,#PB_Ignore,#PB_Ignore,WindowWidth(MyWindow),WindowHeight(MyWindow)-ButtonLineHeight)
;     ResizeGadget(ButtonFind,#PB_Ignore,WindowHeight(MyWindow)-ButtonHeight-2,#PB_Ignore,#PB_Ignore)
;     ResizeGadget(ComboContent,#PB_Ignore,WindowHeight(MyWindow)-ButtonHeight-4,#PB_Ignore,#PB_Ignore)
;     ResizeGadget(ButtonDisplay,#PB_Ignore,WindowHeight(MyWindow)-ButtonHeight-2,#PB_Ignore,#PB_Ignore)
;     ResizeGadget(ButtonEdit,#PB_Ignore,WindowHeight(MyWindow)-ButtonHeight-2,#PB_Ignore,#PB_Ignore)
;     ResizeGadget(ButtonRankSpirit,#PB_Ignore,WindowHeight(MyWindow)-ButtonHeight-2,#PB_Ignore,#PB_Ignore)
;     ResizeGadget(MouseText,#PB_Ignore,WindowHeight(MyWindow)-ButtonHeight,#PB_Ignore,#PB_Ignore)
;   ElseIf EventID = #WM_LBUTTONDOWN
;     GetWindowRect_(GadgetID(WebGadget),re.RECT) 
;     GetCursorPos_(pt.POINT)
;     ;
;     If pt\y<re\bottom
;       pt\x - re\left
;       pt\y - re\top
;       x = pt\X
;       y = pt\y
;       GetElementInfosFromPoint(WebGadget,x,y,@Element.ElementInfo)
;       SetGadgetText(MouseText,"Last clic was over: "+Element.ElementInfo\tagname)
;       SetGadgetState(ComboContent,Element\Index)
;     EndIf
;     
;   ElseIf EventID=#PB_Event_Gadget
;     If EventGadget() = ButtonFind
;       SearchString$ = InputRequester("Search","Enter the expression to search:","Zapman")
;       If SearchString$
;         FindInWebGadget(SearchString$,0,WebGadget)
;       EndIf
;     ElseIf EventGadget() = ButtonDisplay
;       Index = GetGadgetState(ComboContent)
;       If Index<0 : Index = 0 : EndIf
;       GetElementInfosFromIndex(WebGadget,Index,Element.ElementInfo)
;       tx$ = "TagPosition: "+Element\taglist+Chr(13)
;       tx$ + "posX: "+Str(Element\offsetTop)+Chr(13)
;       tx$ + "posY: "+Str(Element\offsetLeft)+Chr(13)+Chr(13)
;       tx$ + "Content: "+ Element\outerHTML
;       MessageRequester("Element 1 content",tx$,0)
;     ElseIf EventGadget() = ButtonEdit
;       If EditMode$ = "Off"
;         EditMode$ = "On"
;         SetGadgetText(ButtonEdit,"Browser Mode")
;       Else
;         EditMode$ = "Off"
;         SetGadgetText(ButtonEdit,"Edit Mode")
;       EndIf
;       SetWebGadgetEditable(WebGadget,EditMode$)
;     ElseIf EventGadget() = ButtonRankSpirit
;       SetGadgetText(WebGadget,"about:<body><h1>Loading...</h1></body>")
;       While WindowEvent() : Wend
;       SetGadgetText(WebGadget,"http://www.rankspirit.com")
;       SetWebGadgetEditable(WebGadget,EditMode$)
;         
;     EndIf
;   EndIf
; Until Quit