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