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
''' <summary>
'''
''' </summary>
''' <param name="iEstado">3-Interactive / 4-Complete</param>
''' <remarks></remarks>
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
''' <summary>
''' Asigna el DocActivo al documento en el que se encuentra el Elemento buscado
''' </summary>
''' <param name="Tipo"></param>
''' <param name="Id"></param>
''' <param name="Nombre"></param>
''' <param name="Texto"></param>
''' <param name="bTextoExacto"></param>
''' <param name="Atributo"></param>
''' <param name="ValAtributo"></param>
''' <param name="bAtributoExacto"></param>
''' <param name="bCol"></param>
''' <param name="sHTML"></param>
''' <param name="bHTMLExacto"></param>
''' <returns></returns>
''' <remarks></remarks>
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
''' <summary>
'''
''' </summary>
''' <param name="oDoc">Documento HTML en el que se busca el Elemento</param>
''' <param name="Tipo">Tipo de TAG HTML</param>
''' <param name="Id"></param>
''' <param name="Nombre"></param>
''' <param name="Texto"></param>
''' <param name="bTextoExacto"></param>
''' <param name="Atributo"></param>
''' <param name="ValAtributo"></param>
''' <param name="bAtributoExacto"></param>
''' <param name="bCol">Si es True Rellena un List con todos los Elementos que coincidan</param>
''' <returns></returns>
''' <remarks></remarks>
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
Comments