Imports System.Windows.Forms Imports SHDocVw Imports mshtml Public Class NaviWeb2 Public oTabla As IHTMLTable, Tabla_TR As IHTMLTableRow, Tabla_TD As IHTMLTableCell Private Doc As mshtml.HTMLDocument Public oFrame As IHTMLFrameBase Declare Sub Sleep Lib "kernel32.dll" (ByVal Milliseconds As Integer) Public Sub New(oNav As SHDocVw.InternetExplorer) oNavegador = oNav CargaVariables() End Sub #Region "PROPIEDADES" Private _sError As String Public Property sError() As String Get Return _sError End Get Set(value As String) _sError = value End Set End Property Private _tSleep As Integer Public Property tSleep() As Integer Get Return _tSleep End Get Set(ByVal value As Integer) _tSleep = value End Set End Property Private WithEvents oNavegador As SHDocVw.InternetExplorer Public Property Navegador() As SHDocVw.InternetExplorer Get Return oNavegador End Get Set(oNav As SHDocVw.InternetExplorer) oNavegador = oNav End Set End Property Private _bNaviScriptError As Boolean Public Property bNaviScriptError() As Boolean Get Return _bNaviScriptError End Get Set(ByVal value As Boolean) _bNaviScriptError = value End Set End Property Private _DocNavi As IHTMLDocument3 Public Property DocNavi() As IHTMLDocument3 Get Return _DocNavi End Get Set(oDoc As IHTMLDocument3) _DocNavi = oDoc End Set End Property Private _DocActivo As mshtml.HTMLDocument Public Property DocActivo() As mshtml.HTMLDocument Get Return _DocActivo End Get Set(oDoc As mshtml.HTMLDocument) _DocActivo = oDoc End Set End Property Private _DocActivo2 As IHTMLDocument3 Public Property DocActivo2() As IHTMLDocument3 Get Return _DocActivo2 End Get Set(oDoc As IHTMLDocument3) _DocActivo2 = oDoc End Set End Property Private _bCompleto As Boolean Public Property bCompleto() As Boolean Get Return _bCompleto End Get Set(ByVal value As Boolean) _bCompleto = value End Set End Property Private oFormu As IHTMLFormElement Public Property Formu() As IHTMLFormElement Get Return oFormu End Get Set(oForm As IHTMLFormElement) oFormu = oForm End Set End Property Private _oElemento As IHTMLElement Public Property oElemento() As IHTMLElement Get Return _oElemento End Get Set(Obj As IHTMLElement) _oElemento = Obj End Set End Property Private _oElemento2 As HtmlElement Public Property oElemento2() As HtmlElement Get Return _oElemento2 End Get Set(Obj As HtmlElement) _oElemento2 = Obj End Set End Property Private oEvento As IHTMLEventObj Public Property Evento() As IHTMLEventObj Get 'Return oEvento Return _DocActivo.CreateEventObject() End Get Set(Obj As IHTMLEventObj) oEvento = Obj End Set End Property Private oCombo As IHTMLSelectElement Public Property Combo() As IHTMLSelectElement Get Return oCombo End Get Set(Obj As IHTMLSelectElement) oCombo = Obj End Set End Property Private _L_oElementos As List(Of IHTMLElement) Public Property L_Elementos() As List(Of IHTMLElement) Get Return _L_oElementos End Get Set(Obj As List(Of IHTMLElement)) _L_oElementos = Obj End Set End Property Private bbComboValor As Boolean Public Property bComboValor As Boolean Get Return bbComboValor End Get Set(b As Boolean) bbComboValor = b End Set End Property '************* PROPIEDADES DE LAS VENTANA EMERGENTE 1 Private oNavegador_POP As SHDocVw.InternetExplorer Public Property Navegador_POP() As SHDocVw.InternetExplorer Get Return oNavegador_POP End Get Set(oNav As SHDocVw.InternetExplorer) oNavegador_POP = oNav End Set End Property Private _DocActivo_POP As mshtml.HTMLDocument Public Property DocActivo_POP() As mshtml.HTMLDocument Get Return _DocActivo_POP End Get Set(oDoc As mshtml.HTMLDocument) _DocActivo_POP = oDoc End Set End Property Private _DocActivo2_POP As IHTMLDocument3 Public Property DocActivo2_POP() As IHTMLDocument3 Get Return _DocActivo2_POP End Get Set(oDoc As IHTMLDocument3) _DocActivo2_POP = oDoc End Set End Property Private _bCompleto_POP As Boolean Public Property bCompleto_POP() As Boolean Get Return _bCompleto_POP End Get Set(ByVal value As Boolean) _bCompleto_POP = value End Set End Property Private _bPop As Boolean Public Property bPop() As Boolean Get Return _bPop End Get Set(value As Boolean) _bPop = value End Set End Property Private _bPopVisible As Boolean Public Property bPopVisible() As Boolean Get Return _bPopVisible End Get Set(value As Boolean) _bPopVisible = value End Set End Property Private _TituloPop As String Public Property TituloPop() As String Get Return _TituloPop End Get Set(value As String) _TituloPop = value End Set End Property '************* PROPIEDADES DE LAS VENTANA EMERGENTE 2 'Private oNavegador_POP2 As AxSHDocVw.AxWebBrowser 'Public Property Navegador_POP2() As AxSHDocVw.AxWebBrowser ' Get ' Return oNavegador_POP2 ' End Get ' Set(oNav As AxSHDocVw.AxWebBrowser) ' oNavegador_POP2 = oNav ' End Set 'End Property 'Private _DocActivo_POP2 As IHTMLDocument3 'Public Property DocActivo_POP2() As IHTMLDocument3 ' Get ' Return _DocActivo_POP2 ' End Get ' Set(oDoc As IHTMLDocument3) ' _DocActivo_POP2 = oDoc ' End Set 'End Property '************* PROPIEDADES DE LAS VENTANA EMERGENTE 2 Private oNavegador_POP2 As SHDocVw.InternetExplorer Public Property Navegador_POP2() As SHDocVw.InternetExplorer Get Return oNavegador_POP2 End Get Set(oNav As SHDocVw.InternetExplorer) oNavegador_POP2 = oNav End Set End Property Private _DocActivo_POP2 As mshtml.HTMLDocument Public Property DocActivo_POP2() As mshtml.HTMLDocument Get Return _DocActivo_POP2 End Get Set(oDoc As mshtml.HTMLDocument) _DocActivo_POP2 = oDoc End Set End Property Private _DocActivo2_POP2 As IHTMLDocument3 Public Property DocActivo2_POP2() As IHTMLDocument3 Get Return _DocActivo2_POP2 End Get Set(oDoc As IHTMLDocument3) _DocActivo2_POP2 = oDoc End Set End Property Private _bCompleto_POP2 As Boolean Public Property bCompleto_POP2() As Boolean Get Return _bCompleto_POP2 End Get Set(ByVal value As Boolean) _bCompleto_POP2 = value End Set End Property Private _bPop2 As Boolean Public Property bPop2() As Boolean Get Return _bPop2 End Get Set(value As Boolean) _bPop2 = value End Set End Property Private _bPopVisible2 As Boolean Public Property bPopVisible2() As Boolean Get Return _bPopVisible2 End Get Set(value As Boolean) _bPopVisible2 = value End Set End Property Private _TituloPop2 As String Public Property TituloPop2() As String Get Return _TituloPop2 End Get Set(value As String) _TituloPop2 = value End Set End Property '************* PROPIEDADES DE LAS VENTANA EMERGENTE 3 'Private oNavegador_POP2 As AxSHDocVw.AxWebBrowser 'Public Property Navegador_POP2() As AxSHDocVw.AxWebBrowser ' Get ' Return oNavegador_POP2 ' End Get ' Set(oNav As AxSHDocVw.AxWebBrowser) ' oNavegador_POP2 = oNav ' End Set 'End Property 'Private _DocActivo_POP2 As IHTMLDocument3 'Public Property DocActivo_POP2() As IHTMLDocument3 ' Get ' Return _DocActivo_POP2 ' End Get ' Set(oDoc As IHTMLDocument3) ' _DocActivo_POP2 = oDoc ' End Set 'End Property Private _bPop3 As Boolean Public Property bPop3() As Boolean Get Return _bPop3 End Get Set(value As Boolean) _bPop3 = value End Set End Property Private _bPopVisible3 As Boolean Public Property bPopVisible3() As Boolean Get Return _bPopVisible3 End Get Set(value As Boolean) _bPopVisible3 = value End Set End Property Private _TituloPop3 As String Public Property TituloPop3() As String Get Return _TituloPop3 End Get Set(value As String) _TituloPop3 = value End Set End Property #End Region #Region "MÉTODOS PÚBLICOS" Public Sub IniciaNavi() oNavegador = New SHDocVw.InternetExplorer oNavegador.Silent = True oNavegador.Visible = True End Sub Public Sub MataNavi() oNavegador.Quit() oNavegador = Nothing End Sub Public Sub Navegar(sURL As String) oNavegador.Navigate(sURL) ' While Not _bCompleto : Application.DoEvents() : End While EsperaCarga(3) _DocNavi = oNavegador.Document End Sub ''' ''' ''' ''' 3-Interactive / 4-Complete ''' Public Sub EsperaCarga(iEstado As Integer) Sleep(_tSleep) While oNavegador.Busy Or oNavegador.ReadyState <> iEstado And oNavegador.ReadyState <> 4 Application.DoEvents() End While End Sub Public Sub Espera(Segundos As Integer) Sleep(Segundos * 1000) 'For i As Integer = 0 To Num * 25000 ' Application.DoEvents() 'Next End Sub ''' ''' Asigna el DocActivo al documento en el que se encuentra el Elemento buscado ''' ''' ''' ''' ''' ''' ''' ''' ''' ''' ''' ''' ''' ''' Public Function DameDoc(Tipo As String, Optional Id As String = "", _ Optional Nombre As String = "", _ Optional Texto As String = "", _ Optional bTextoExacto As Boolean = True, _ Optional Atributo As String = "", _ Optional ValAtributo As String = "", _ Optional bAtributoExacto As Boolean = True, Optional bCol As Boolean = False, _ Optional sHTML As String = "", _ Optional bHTMLExacto As Boolean = True) As Boolean DameDoc = False Dim Docu As IHTMLDocument3 Dim DocuTemp1 As IHTMLDocument3, DocuTemp2 As IHTMLDocument3, DocuTemp3 As IHTMLDocument3, DocuTemp4 As IHTMLDocument3, DocuTemp5 As IHTMLDocument3 Dim iFrame1 As Integer, iFrame2 As Integer, iFrame3 As Integer, iFrame4 As Integer, iFrame5 As Integer Docu = oNavegador.Document '************************************************************************>> EL DOCUMENTO NO TIENE FRAMES If Docu.frames.length = 0 Then If ExisteElemento(Docu, Tipo, Id, Nombre, Texto, bTextoExacto, Atributo, ValAtributo, bAtributoExacto, bCol, sHTML, bHTMLExacto) Then _DocActivo = Docu : Return True End If Else '***********************************************************************************>> FRAMES NIVEL1 For iFrame1 = 0 To Docu.frames.length - 1 DocuTemp1 = Docu.frames(iFrame1).document If ExisteElemento(DocuTemp1, Tipo, Id, Nombre, Texto, bTextoExacto, Atributo, ValAtributo, bAtributoExacto, bCol, sHTML, bHTMLExacto) Then _DocActivo = DocuTemp1 : Return True End If If DocuTemp1.frames.length > 0 Then '****************************************************************************>> FRAMES NIVEL2 For iFrame2 = 0 To DocuTemp1.frames.length - 1 DocuTemp2 = DocuTemp1.frames(iFrame2).document If ExisteElemento(DocuTemp2, Tipo, Id, Nombre, Texto, bTextoExacto, Atributo, ValAtributo, bAtributoExacto, bCol, sHTML, bHTMLExacto) Then _DocActivo = DocuTemp2 : Return True End If If DocuTemp2.frames.length > 0 Then '**********************************************************************>> FRAMES NIVEL3 For iFrame3 = 0 To DocuTemp2.frames.length - 1 DocuTemp3 = DocuTemp2.frames(iFrame3).document If ExisteElemento(DocuTemp3, Tipo, Id, Nombre, Texto, bTextoExacto, Atributo, ValAtributo, bAtributoExacto, bCol, sHTML, bHTMLExacto) Then _DocActivo = DocuTemp3 : Return True End If If DocuTemp3.frames.length > 0 Then '***************************************************************>> FRAMES NIVEL4 For iFrame4 = 0 To DocuTemp3.frames.length - 1 DocuTemp4 = DocuTemp3.frames(iFrame4).document If ExisteElemento(DocuTemp4, Tipo, Id, Nombre, Texto, bTextoExacto, Atributo, ValAtributo, bAtributoExacto, bCol, sHTML, bHTMLExacto) Then _DocActivo = DocuTemp4 : Return True End If If DocuTemp4.frames.length > 0 Then '*******************************************************>> FRAMES NIVEL5 For iFrame5 = 0 To DocuTemp4.frames.length - 1 DocuTemp5 = DocuTemp4.frames(iFrame5).document If ExisteElemento(DocuTemp5, Tipo, Id, Nombre, Texto, bTextoExacto, Atributo, ValAtributo, bAtributoExacto, bCol, sHTML, bHTMLExacto) Then _DocActivo = DocuTemp5 : Return True End If 'If Docu.frames.length > 0 Then 'End If Next '*******************************************************>> FRAMES NIVEL5 End If Next '***************************************************************>> FRAMES NIVEL4 End If Next '***********************************************************************>> FRAMES NIVEL3 End If Next '********************************************************************************>> FRAMES NIVEL2 End If Next '****************************************************************************************>> FRAMES NIVEL1 End If End Function ''' ''' ''' ''' Documento HTML en el que se busca el Elemento ''' Tipo de TAG HTML ''' ''' ''' ''' ''' ''' ''' ''' Si es True Rellena un List con todos los Elementos que coincidan ''' ''' Public Function ExisteElemento(oDoc As IHTMLDocument3, Tipo As String, _ Optional Id As String = "", _ Optional Nombre As String = "", _ Optional Texto As String = "", _ Optional bTextoExacto As Boolean = True, _ Optional Atributo As String = "", _ Optional ValAtributo As String = "", _ Optional bAtributoExacto As Boolean = True, Optional bCol As Boolean = False, _ Optional sHTML As String = "", _ Optional bHTMLExacto As Boolean = True) As Boolean Dim NomAtributo As String, ValorAtributo As String ExisteElemento = False 'Doc = DirectCast(oDoc, mshtml.HTMLDocument) 'Doc = Nothing If bCol Then _L_oElementos = New List(Of IHTMLElement) 'For Each item In oDoc.getElementsByName(Nombre) ' If Nombre <> "" And item.Name = Nombre Then ExisteElemento = True ' Debug.Print(item.name) 'Next For Each item In oDoc.getElementsByTagName(Tipo) ExisteElemento = False 'Debug.Print(item.name) '******** ID If Id <> "" Then If bTextoExacto And item.Id = Id Then ExisteElemento = True If Not bTextoExacto And InStr(1, Trim(UCase(item.Id)), Trim(UCase(Id))) > 0 Then ExisteElemento = True End If '******** NOMBRE If Nombre <> "" Then If item.Name = Nombre Then ExisteElemento = True End If '******** TEXTO If Texto <> "" Then If bTextoExacto And Trim(UCase(item.InnerText)) = Trim(UCase(Texto)) Then ExisteElemento = True End If If Not bTextoExacto And InStr(1, Trim(UCase(item.InnerText)), Trim(UCase(Texto))) > 0 Then ExisteElemento = True End If End If '******** HTML Try If sHTML <> "" Then If bHTMLExacto And item.InnerHTML = sHTML Then ExisteElemento = True End If If Not bHTMLExacto And InStr(1, item.InnerHTML, sHTML) > 0 Then ExisteElemento = True End If End If Catch ex As Exception End Try '******** ATRIBUTO If Atributo <> "" Then ValorAtributo = item.getAttribute(Atributo) If Not IsNothing(ValorAtributo) Then If bAtributoExacto Then If ValorAtributo = ValAtributo Then ExisteElemento = True Else If InStr(1, ValorAtributo, ValAtributo) > 0 Then ExisteElemento = True End If End If 'For z = 0 To item.attributes.length - 1 ' NomAtributo = item.attributes(z).name ' ValorAtributo = item.attributes(z).value ' If NomAtributo = Atributo Then ' If bAtributoExacto Then ' If ValorAtributo = ValAtributo Then ExisteElemento = True ' Else ' If InStr(1, ValorAtributo, ValAtributo) > 0 Then ExisteElemento = True ' End If ' End If ' 'Debug.Print(z & " : " & item.attributes(z).name) ' 'Debug.Print(z & " : " & item.attributes(z).value) 'Next End If If ExisteElemento Then _oElemento = item ' _oElemento2 = item '**** EL ELEMENTO ES UN COMBO If Trim(UCase(Tipo)) = "SELECT" Then oCombo = oElemento End If '**** EL ELEMENTO ES UNA TABLA If Trim(UCase(Tipo)) = "TABLE" Then oTabla = oElemento End If '*** SI ES COLECCIÓN AÑADIMO ELEMENTO Y CONTINUAMOS BUCLE If bCol Then _L_oElementos.Add(oElemento) Else Exit Function End If End If Next If bCol And _L_oElementos.Count > 0 Then ExisteElemento = True End Function 'Public Function ExisteElemento2(oDoc As IHTMLDocument3, Tipo As String, _ ' Optional Id As String = "", _ ' Optional Nombre As String = "", _ ' Optional Texto As String = "", _ ' Optional bTextoExacto As Boolean = True, _ ' Optional Atributo As String = "", _ ' Optional ValAtributo As String = "", _ ' Optional bAtributoExacto As Boolean = True, ' Optional bCol As Boolean = False, _ ' Optional sHTML As String = "", _ ' Optional bHTMLExacto As Boolean = True) As Boolean ' ExisteElemento2 = False ' Dim Docu As IHTMLDocument3 ' Dim iFrames As Integer ' Doc = DirectCast(oDoc, mshtml.HTMLDocument) ' If Doc.frames.length = 0 Then ' End If ' For iFrames = 0 To Doc.frames.length ' Next ' If bCol Then L_oElemento = New List(Of IHTMLElement) ' 'For Each item In oDoc.getElementsByName(Nombre) ' ' If Nombre <> "" And item.Name = Nombre Then ExisteElemento2 = True ' ' Debug.Print(item.name) ' 'Next ' For Each item In oDoc.getElementsByTagName(Tipo) ' 'Debug.Print(item.name) ' '******** ID ' If Id <> "" And item.Id = Id Then ExisteElemento2 = True ' '******** NOMBRE ' If Nombre <> "" And item.Name = Nombre Then ' ExisteElemento2 = True ' End If ' '******** TEXTO ' If Texto <> "" Then ' If bTextoExacto And item.InnerText = Texto Then ' ExisteElemento2 = True ' End If ' If Not bTextoExacto And InStr(1, item.InnerText, Texto) > 0 Then ' ExisteElemento2 = True ' End If ' End If ' '******** HTML ' If sHTML <> "" Then ' If bHTMLExacto And item.InnerHTML = sHTML Then ' ExisteElemento2 = True ' End If ' If Not bHTMLExacto And InStr(1, item.InnerHTML, sHTML) > 0 Then ' ExisteElemento2 = True ' End If ' End If ' '******** ATRIBUTO ' If Atributo <> "" Then ' If Not item.GetAttribute(Atributo) Is Nothing Then ' If bAtributoExacto Then ' If item.GetAttribute(Atributo) = ValAtributo Then ExisteElemento2 = True ' Else ' If InStr(1, item.GetAttribute(Atributo), ValAtributo) > 0 Then ExisteElemento2 = True ' End If ' End If ' 'If bAtributoExacto And item.GetAttribute(Atributo) = ValAtributo Then ' ' ExisteElemento2 = True ' 'End If ' 'If Not bAtributoExacto And InStr(1, item.GetAttribute(Atributo), ValAtributo) > 0 Then ' ' ExisteElemento2 = True ' 'End If ' End If ' If ExisteElemento2 Then ' oElemento = item ' If Tipo = "SELECT" Then oCombo = oElemento ' If bCol Then L_oElemento.Add(oElemento) Else Exit Function ' End If ' Next ' Doc = Nothing 'End Function Public Function DameValor(oDoc As IHTMLDocument3, Tipo As String, Nombre As String) As String DameValor = "" If Not ExisteElemento(oDoc, Tipo, , Nombre) Then Exit Function DameValor = oElemento.value End Function Public Sub Click(Optional bEsperaCarga As Boolean = True) oElemento.click() Sleep(_tSleep) If bEsperaCarga Then EsperaCarga(4) End Sub Public Sub Valor(sTexto As String, Optional bComboSel As Boolean = False, _ Optional bFocus As Boolean = False, _ Optional bOnFocus As Boolean = False, _ Optional bOnChange As Boolean = False, _ Optional bOnBlur As Boolean = False) On Error GoTo TrataError If bFocus Then oElemento.focus() If bOnFocus Then oElemento.onfocus() oElemento.setAttribute("value", sTexto) '*** El Elemento es un Combo If bComboSel Then bbComboValor = False For i As Integer = 0 To oElemento.length - 1 If Trim(UCase(oElemento.item(i).text)) = Trim(UCase(sTexto)) Then oElemento.selectedIndex = i : bbComboValor = True : Exit For End If Next End If If bOnChange Then oElemento.onchange() If bOnBlur Then oElemento.onblur() Exit Sub TrataError: _sError = "TABLA_HTML_SQL : Valor() : " & Err.Description End Sub Public Function Combo_Elementos() As Integer Combo_Elementos = oCombo.length End Function Public Function Combo_ExisteValor(sValor As String) As Boolean Combo_ExisteValor = False For i As Integer = 0 To Combo_Elementos() - 1 Debug.Print(Trim(UCase(oCombo.item(i).text))) If Trim(UCase(oCombo.item(i).text)) = Trim(UCase(sValor)) Then Combo_ExisteValor = True : Exit Function Next End Function #Region "TABLA" Public Function Tabla_Celda_Valor(Fila As Integer, Columna As Integer) As String If IsNothing(oTabla.rows(Fila).Cells(Columna).Innertext) Then Return "" Tabla_Celda_Valor = Trim(oTabla.rows(Fila).Cells(Columna).Innertext.ToString) End Function Public Function Tabla_Filas() As Integer Tabla_Filas = oTabla.rows.length End Function Public Function Tabla_Columnas(Fila As Integer) As Integer Tabla_Columnas = oTabla.rows(Fila).cells.length End Function #End Region #End Region #Region "MÉTODOS PRIVADOS" Private Sub CargaVariables() _tSleep = 2000 '_bNaviScriptError = True 'oNavegador.ScriptErrorsSuppressed = _bNaviScriptError End Sub #End Region End Class