Imports System.Windows.Forms Imports mshtml Public Class NaviWeb Public L_Elemento As List(Of IHTMLElement) Public oTabla As IHTMLTable, Tabla_TR As IHTMLTableRow, Tabla_TD As IHTMLTableCell Private Doc As mshtml.HTMLDocument Public oFrame As IHTMLFrameBase Public Sub New(oNav As AxSHDocVw.AxWebBrowser) oNavegador = oNav bbNaviScriptError = True 'oNavegador.ScriptErrorsSuppressed = bbNaviScriptError 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 oNavegador As AxSHDocVw.AxWebBrowser Public Property Navegador() As AxSHDocVw.AxWebBrowser Get Return oNavegador End Get Set(oNav As AxSHDocVw.AxWebBrowser) oNavegador = oNav End Set End Property Private bbNaviScriptError As Boolean Public Property bNaviScriptError As Boolean Get Return bbNaviScriptError End Get Set(b As Boolean) bbNaviScriptError = b 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 IHTMLDocument3 Public Property DocActivo() As IHTMLDocument3 Get Return _DocActivo End Get Set(oDoc As IHTMLDocument3) _DocActivo = oDoc 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 Elemento() As IHTMLElement Get Return oElemento End Get Set(Obj As IHTMLElement) oElemento = 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_Elemento As List(Of IHTMLElement) 'Public Property L_Elemento() As List(Of IHTMLElement) ' Get ' Return _L_Elemento ' End Get ' Set(Obj As List(Of IHTMLElement)) ' _L_Elemento = 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 AxSHDocVw.AxWebBrowser Public Property Navegador_POP() As AxSHDocVw.AxWebBrowser Get Return oNavegador_POP End Get Set(oNav As AxSHDocVw.AxWebBrowser) oNavegador_POP = oNav End Set End Property Private _DocActivo_POP As IHTMLDocument3 Public Property DocActivo_POP() As IHTMLDocument3 Get Return _DocActivo_POP End Get Set(oDoc As IHTMLDocument3) _DocActivo_POP = oDoc 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 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 Navegar(sURL As String) oNavegador.Navigate(sURL) EsperaCarga(3) _DocNavi = oNavegador.Document End Sub ''' ''' ''' ''' 3-Interactive / 4-Complete ''' Public Sub EsperaCarga(iEstado As Integer) While oNavegador.ReadyState <> iEstado And oNavegador.ReadyState <> 4 Application.DoEvents() End While End Sub 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 '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 bItem As Boolean ' ' Dim bItemCol As Boolean = False ' bItem = False ' ExisteElemento = False ' 'Doc = DirectCast(oDoc, mshtml.HTMLDocument) ' 'Doc = Nothing ' If bCol Then L_Elemento = 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) ' 'Debug.Print(item.name) ' '******** ID ' If Id <> "" And item.Id = Id Then bItem = True ' '******** NOMBRE ' If Nombre <> "" Then ' If item.Name = Nombre Then bItem = True ' End If ' '******** TEXTO ' If Texto <> "" Then ' If bTextoExacto And Trim(UCase(item.InnerText)) = Trim(UCase(Texto)) Then ' bItem = True ' End If ' If Not bTextoExacto And InStr(1, Trim(UCase(item.InnerText)), Trim(UCase(Texto))) > 0 Then ' bItem = True ' End If ' End If ' '******** HTML ' Try ' If sHTML <> "" Then ' If bHTMLExacto And item.InnerHTML = sHTML Then ' bItem = True ' End If ' If Not bHTMLExacto And InStr(1, item.InnerHTML, sHTML) > 0 Then ' bItem = True ' End If ' End If ' Catch ex As Exception ' End Try ' '******** ATRIBUTO ' If Atributo <> "" Then ' If Not item.GetAttribute(Atributo) Is Nothing Then ' If bAtributoExacto Then ' If item.GetAttribute(Atributo).ToString = ValAtributo Then bItem = True ' Else ' If InStr(1, item.GetAttribute(Atributo).ToString, ValAtributo) > 0 Then bItem = True ' End If ' End If ' 'If bAtributoExacto And item.GetAttribute(Atributo) = ValAtributo Then ' ' ExisteElemento = True ' 'End If ' 'If Not bAtributoExacto And InStr(1, item.GetAttribute(Atributo), ValAtributo) > 0 Then ' ' ExisteElemento = True ' 'End If ' End If ' If bItem Then ' oElemento = item ' If Tipo = "SELECT" Then oCombo = oElemento ' If Tipo = "TABLE" Then oTabla = oElemento ' If bCol Then L_Elemento.Add(oElemento) Else Return bItem ' bItem = False ' End If ' Next ' If bCol And L_Elemento.Count > 0 Then Return True ' Return False '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 bElemento As Boolean = False ExisteElemento = False 'Doc = DirectCast(oDoc, mshtml.HTMLDocument) 'Doc = Nothing If bCol Then L_Elemento = New List(Of IHTMLElement) 'For Each item In oDoc.getElementsByName(Nombre) ' If Nombre <> "" And item.Name = Nombre Then bElemento = True ' Debug.Print(item.name) 'Next For Each item In oDoc.getElementsByTagName(Tipo) 'ExisteElemento = False 'Debug.Print(item.name) '******** ID If Id <> "" And item.Id = Id Then bElemento = True '******** NOMBRE If Nombre <> "" Then If item.Name = Nombre Then bElemento = True End If '******** TEXTO If Texto <> "" Then If bTextoExacto And Trim(UCase(item.InnerText)) = Trim(UCase(Texto)) Then bElemento = True End If If Not bTextoExacto And InStr(1, Trim(UCase(item.InnerText)), Trim(UCase(Texto))) > 0 Then bElemento = True End If End If '******** HTML Try If sHTML <> "" Then If bHTMLExacto And item.InnerHTML = sHTML Then bElemento = True End If If Not bHTMLExacto And InStr(1, item.InnerHTML, sHTML) > 0 Then bElemento = True End If End If Catch ex As Exception End Try '******** ATRIBUTO If Atributo <> "" Then If Not item.GetAttribute(Atributo) Is Nothing Then If bAtributoExacto Then If item.GetAttribute(Atributo).ToString = ValAtributo Then bElemento = True Else If InStr(1, item.GetAttribute(Atributo).ToString, ValAtributo) > 0 Then bElemento = True End If End If 'If bAtributoExacto And item.GetAttribute(Atributo) = ValAtributo Then ' bElemento = True 'End If 'If Not bAtributoExacto And InStr(1, item.GetAttribute(Atributo), ValAtributo) > 0 Then ' bElemento = True 'End If End If If bElemento Then ExisteElemento = bElemento oElemento = item If Tipo = "SELECT" Then oCombo = oElemento If Tipo = "TABLE" Then oTabla = oElemento If bCol Then L_Elemento.Add(oElemento) Else Exit Function bElemento = False End If Next ' If bCol And L_Elemento.Count > 0 Then Return 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() oElemento.click() 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 = "NaviWeb : 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 Public Sub Espera(Num As Long) Dim i As Long For i = 0 To Num * 250000 Application.DoEvents() Next i End Sub #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 End Class