bas/NET.bas

   1 Attribute VB_Name = "NET"
   2 Option Explicit
   3 Dim hpObjetoIE As Long
   4 Type IP
   5     Cambio As Boolean
   6     IP_Actual As String
   7 End Type
   8 Public Declare Function InternetGetConnectedState _
   9                Lib "wininet.dll" (ByRef lpdwFlags As Long, _
  10                                   ByVal dwReserved As Long) As Long
  11 'Local system uses a LAN to connect to the Internet.
  12 Public Const INTERNET_CONNECTION_LAN As Long = &H2
  13 'Offline
  14 Public Const INTERNET_CONNECTION_OFFLINE As Long = &H20
  15
  16 Public Function GetNetConnectString() As Boolean
  17     '<EhHeader>
  18     On Error GoTo GetNetConnectString_Err
  19     '</EhHeader>
  20     Dim dwflags As Long
  21     Dim msg As String
  22
  23     If InternetGetConnectedState(dwflags, 0&) Then
  24         If dwflags And INTERNET_CONNECTION_LAN Then
  25             GetNetConnectString = True
  26         End If
  27
  28         If dwflags And INTERNET_CONNECTION_OFFLINE Then
  29             GetNetConnectString = False
  30         End If
  31
  32     Else
  33         GetNetConnectString = False
  34     End If
  35
  36     '<EhFooter>
  37     Exit Function
  38 GetNetConnectString_Err:
  39     Controlar_Error Erl, Err.Description, "Reseter.NET.GetNetConnectString"
  40     Resume Next
  41     '</EhFooter>
  42 End Function
  43
  44 Public Function Cambio_IP() As IP
  45     'Idea original de sortux, implementado por Vlad y hosting por No-IP
  46     'Cambio: 22/03/07
  47     '1.0.16 -> Eliminado un "registrar "Enviando datos" innecesario
  48     'Cambio: 03/04/07
  49     '1.0.19 -> Detectar cambios
  50     '          Ahora es función y devuelve del cambio de ip
  51     '          Forzar recarga de pagina
  52     '<EhHeader>
  53     On Error GoTo Cambio_IP_Err
  54     '</EhHeader>
  55     Static AntiguaIp As String
  56     Dim ActualIp As String
  57     ActualIp = Trim$(pSocket.HTML_GET)
  58
  59     If Len(ActualIp) > 16 Or Len(ActualIp) < 8 Then
  60         Registrar "+IP Pública: imposible obtener."
  61         Cambio_IP.Cambio = True
  62         Exit Function
  63     End If
  64
  65     Cambio_IP.IP_Actual = ActualIp
  66     Cambio_IP.Cambio = (ActualIp = AntiguaIp)
  67
  68     If AntiguaIp = vbNullString Then AntiguaIp = GetSetting("Reseter4.0", "Datos", "UltimaIP", vbNullString)
  69     Registrar "+IP Pública: " & ActualIp & IIf(ActualIp = AntiguaIp, " (La IP no cambió)", IIf(AntiguaIp = vbNullString, vbNullString, " (OK, antes era: " & AntiguaIp & ")"))
  70     AntiguaIp = ActualIp
  71     SaveSetting "Reseter4.0", "Datos", "UltimaIP", ActualIp
  72     '<EhFooter>
  73     Exit Function
  74 Cambio_IP_Err:
  75     Controlar_Error Erl, Err.Description, "Reseter.NET.Cambio_IP"
  76     Resume Next
  77     '</EhFooter>
  78 End Function
  79
  80 Public Sub Crear_Objeto_IE()
  81     '100     Registrar "+Objeto IE: creando..."
  82     '<EhHeader>
  83     On Error GoTo Crear_Objeto_IE_Err
  84     '</EhHeader>
  85     hpObjetoIE = SetTimer(0, 0, 0, AddressOf lpObjetoIE)
  86     '<EhFooter>
  87     Exit Sub
  88 Crear_Objeto_IE_Err:
  89     Controlar_Error Erl, Err.Description, "Reseter.NET.Crear_Objeto_IE"
  90     Resume Next
  91     '</EhFooter>
  92 End Sub
  93
  94 Public Sub Destruir_Conexion()
  95     '<EhHeader>
  96     On Error GoTo Destruir_Conexion_Err
  97     '</EhHeader>
  98     Set IE = Nothing
  99     '<EhFooter>
 100     Exit Sub
 101 Destruir_Conexion_Err:
 102     Controlar_Error Erl, Err.Description, "Reseter.NET.Destruir_Conexion"
 103     Resume Next
 104     '</EhFooter>
 105 End Sub
 106
 107 Public Function RenovarLAN() As Long
 108     '<EhHeader>
 109     On Error GoTo RenovarLAN_Err
 110     '</EhHeader>
 111     RenovarLAN = ShellExecute(frmPrincipal.hWnd, "", "ipconfig /renew all", "", "", 0)
 112     Registrar "~Renovación concluyó en " & RenovarLAN
 113     '<EhFooter>
 114     Exit Function
 115 RenovarLAN_Err:
 116     Controlar_Error Erl, Err.Description, "Reseter.NET.RenovarLAN"
 117     Resume Next
 118     '</EhFooter>
 119 End Function
 120
 121 Public Sub res_Web()
 122     '<EhHeader>
 123     On Error GoTo res_Web_Err
 124     '</EhHeader>
 125     On Error GoTo subError
 126     'Reseteo via pagina web
 127     Registrar "+-[MODO WEB] Enviando datos"
 128
 129     ' Si es reseteo WEB lo primero que tenemos que hacer es armar la direccion a la que
 130     ' vamos a navegar en base a los datos del preprocesador
 131     With IE
 132
 133         'Procesamos la dirección a navegar en base al tipo de acción.
 134         Select Case m_Datos.accionTipo
 135
 136             Case Is = ed_java
 137                 'Si solo vamos a ejecutar Java, solo tenemos que pasar el comando como la dirección
 138                 m_Datos.Direccion = m_Datos.accionEX
 139
 140             Case Else
 141                 'En el caso de que vayamos a navegar o hacer clic, tenemos que contruir la direción
 142                 m_Datos.Direccion = "http://" & IIf(Len(m_Datos.usuario) <> 0, m_Datos.usuario & ":", vbNullString) & IIf(Len(m_Datos.clave) <> 0, m_Datos.clave & "@", vbNullString) & m_Datos.base & ":" & IIf(IsNumeric(m_Datos.puerto), m_Datos.puerto, 80) & m_Datos.accionEX
 143         End Select
 144
 145         If flag_Navegar Then .Navigate m_Datos.Direccion
 146         Registrar "Res_Web => armado: '" & m_Datos.Direccion & "'"
 147
 148         Do While .Busy
 149             Esperar 0.1
 150         Loop
 151
 152         Do While .ReadyState <> 4
 153             Esperar 0.1
 154         Loop
 155
 156         frmWeb.txtLog.Text = "!!! " & m_Datos.Direccion
 157
 158         Select Case m_Datos.accionTipo
 159
 160             Case ed_clic
 161
 162                 If m_Datos.nForm = -1 And m_Datos.nCont = -1 Then
 163                     Registrar "# de Formulario y Control invalido."
 164                 Else
 165
 166                     If (.Document.Forms.Length - 1) >= m_Datos.nForm Then
 167                         If .Document.Forms(m_Datos.nForm).Length - 1 >= m_Datos.nCont Then
 168                             .Document.Forms(m_Datos.nForm)(m_Datos.nCont).Click
 169                             Registrar "Res_Web: Datos enviados [" & m_Datos.nForm & ", " & m_Datos.nCont & "]"
 170                         Else
 171                             Registrar "Res_Web: Err -> No existian suficientes controles"
 172                             NetError = True
 173                         End If
 174
 175                     Else
 176                         Registrar "Res_Web: Err -> No existian suficientes formularios"
 177                         NetError = True
 178                     End If
 179                 End If
 180
 181             Case ed_llenar
 182
 183                 If m_Datos.nForm = -1 And m_Datos.nCont = -1 Then
 184                     Registrar "Sin datos, saltando de Llenado"
 185                 Else
 186
 187                     If (.Document.Forms.Length - 1) >= m_Datos.nForm Then
 188                         If .Document.Forms(m_Datos.nForm).Length - 1 >= m_Datos.nCont Then
 189                             .Document.Forms(m_Datos.nForm)(m_Datos.nCont).Value = m_Datos.accionEX2
 190                             Registrar "Res_Web: Texto llenado"
 191                         Else
 192                             Registrar "Res_Web: Err -> No existian suficientes controles"
 193                             NetError = True
 194                         End If
 195
 196                     Else
 197                         Registrar "Res_Web: Err -> No existian suficientes formularios"
 198                         NetError = True
 199                     End If
 200                 End If
 201
 202             Case ed_java
 203                 Registrar "Res_Web: JAVA excutado"
 204
 205             Case ed_navegar
 206                 'No hacer nada
 207         End Select
 208
 209     End With
 210
 211     Exit Sub
 212 subError:
 213     NetError = True
 214
 215     Select Case Err.Number
 216
 217         Case 91
 218             Registrar "++Error -> probablemente el router es incorrecto"
 219
 220         Case Else
 221             Registrar "++Error -> se desconoce la causa para un error #" & Err.Number
 222     End Select
 223
 224     '<EhFooter>
 225     Exit Sub
 226 res_Web_Err:
 227     Controlar_Error Erl, Err.Description, "Reseter.NET.res_Web"
 228     Resume Next
 229     '</EhFooter>
 230 End Sub
 231
 232 Public Sub res_Telnet()
 233     'Reseteo via telnet
 234     '28/04/07 - 2.0.4: Unido con "Iniciar_Telnet", "Iniciar_Telnet" eliminado
 235     '<EhHeader>
 236     On Error GoTo res_Telnet_Err
 237     '</EhHeader>
 238     Registrar "+-[MODO TELNET] Enviando datos"
 239     '102     MsgBox "Telnet Iniciado"
 240     TelnetComandos() = Split(m_Datos.accionEX, ";")
 241     Registrar "No. de comandos a enviar: " & UBound(TelnetComandos) + 1
 242     nComando = 0
 243     Call frmTelnet.ProcTelnet
 244     '<EhFooter>
 245     Exit Sub
 246 res_Telnet_Err:
 247     Controlar_Error Erl, Err.Description, "Reseter.NET.res_Telnet"
 248     Resume Next
 249     '</EhFooter>
 250 End Sub
 251
 252 'CSEH: Skip
 253 Public Sub lpObjetoIE()
 254     On Error Resume Next
 255     KillTimer 0, hpObjetoIE
 256     Set IE = CreateObject("InternetExplorer.Application")
 257
 258     If IE Is Nothing Then
 259         Registrar "+Objeto IE: no creado"
 260         Exit Sub
 261     End If
 262
 263     IE.RegisterAsBrowser = True
 264     IE.Visible = False
 265     IE.Offline = False
 266     IE.Silent = False
 267     Registrar "+Objeto IE: creado"
 268 End Sub
 269
 270 Public Sub res_auro()
 271     'Reseteo via pagina web
 272     '<EhHeader>
 273     On Error GoTo res_auro_Err
 274     '</EhHeader>
 275     Registrar "+-[MODO WEB/AURONET] Enviando datos"
 276
 277     With ppSocket
 278         .Direccion = m_Datos.Direccion
 279     End With
 280
 281     '<EhFooter>
 282     Exit Sub
 283 res_auro_Err:
 284     Controlar_Error Erl, Err.Description, "Reseter.NET.res_auro"
 285     Resume Next
 286     '</EhFooter>
 287 End Sub