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 103     Registrar "+Objeto creado"
  93         '<EhFooter>
  94         Exit Sub
  95 Crear_Objeto_IE_Err:
  96         Controlar_Error Erl, Err.Description, "Reseter.NET.Crear_Objeto_IE.Ref 12/2/2008 : 09:38:35"
  97         Resume Next
  98         '</EhFooter>
  99 End Sub
 100
 101 Public Sub Destruir_Conexion()
 102         '<EhHeader>
 103         On Error GoTo Destruir_Conexion_Err
 104         '</EhHeader>
 105 100     Set IE = Nothing
 106         '<EhFooter>
 107         Exit Sub
 108 Destruir_Conexion_Err:
 109         Controlar_Error Erl, Err.Description, "Reseter.NET.Destruir_Conexion.Ref 12/2/2008 : 09:38:35"
 110         Resume Next
 111         '</EhFooter>
 112 End Sub
 113
 114 Public Function RenovarLAN() As Long
 115         '<EhHeader>
 116         On Error GoTo RenovarLAN_Err
 117         '</EhHeader>
 118 100     RenovarLAN = ShellExecute(frmPrincipal.hWnd, "", "ipconfig /renew all", "", "", 0)
 119 101     Registrar "~Renovación concluyó en " & RenovarLAN
 120         '<EhFooter>
 121         Exit Function
 122 RenovarLAN_Err:
 123         Controlar_Error Erl, Err.Description, "Reseter.NET.RenovarLAN.Ref 12/2/2008 : 09:38:35"
 124         Resume Next
 125         '</EhFooter>
 126 End Function
 127
 128 Public Sub res_Web()
 129         '<EhHeader>
 130         On Error GoTo res_Web_Err
 131         '</EhHeader>
 132         On Error GoTo subError
 133         'Reseteo via pagina web
 134 100     Registrar "+-[MODO WEB] Enviando datos"
 135
 136         ' Si es reseteo WEB lo primero que tenemos que hacer es armar la direccion a la que
 137         ' vamos a navegar en base a los datos del preprocesador
 138 101     With IE
 139
 140             'Procesamos la dirección a navegar en base al tipo de acción.
 141 102         Select Case m_Datos.accionTipo
 142
 143                 Case Is = ed_java
 144                     'Si solo vamos a ejecutar Java, solo tenemos que pasar el comando como la dirección
 145 103                 m_Datos.Direccion = m_Datos.accionEX
 146
 147 104             Case Else
 148                     'En el caso de que vayamos a navegar o hacer clic, tenemos que contruir la direción
 149 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
 150             End Select
 151
 152 106         If flag_Navegar Then .Navigate m_Datos.Direccion
 153 107         Registrar "Res_Web => armado: '" & m_Datos.Direccion & "'"
 154
 155 108         Do While .Busy
 156 109             Esperar 0.1
 157             Loop
 158
 159 110         Do While .ReadyState <> 4
 160 111             Esperar 0.1
 161             Loop
 162
 163 112         frmWeb.txtLog.Text = "!!! " & m_Datos.Direccion
 164
 165 113         Select Case m_Datos.accionTipo
 166
 167                 Case ed_clic
 168
 169 114                 If m_Datos.nForm = -1 And m_Datos.nCont = -1 Then
 170 115                     Registrar "# de Formulario y Control invalido."
 171                     Else
 172
 173 116                     If (.Document.Forms.Length - 1) >= m_Datos.nForm Then
 174 117                         If .Document.Forms(m_Datos.nForm).Length - 1 >= m_Datos.nCont Then
 175 118                             .Document.Forms(m_Datos.nForm)(m_Datos.nCont).Click
 176 119                             Registrar "Res_Web: Datos enviados [" & m_Datos.nForm & ", " & m_Datos.nCont & "]"
 177                             Else
 178 120                             Registrar "Res_Web: Err -> No existian suficientes controles"
 179 121                             NetError = True
 180                             End If
 181
 182                         Else
 183 122                         Registrar "Res_Web: Err -> No existian suficientes formularios"
 184 123                         NetError = True
 185                         End If
 186                     End If
 187
 188 124             Case ed_llenar
 189
 190 125                 If m_Datos.nForm = -1 And m_Datos.nCont = -1 Then
 191 126                     Registrar "Sin datos, saltando de Llenado"
 192                     Else
 193
 194 127                     If (.Document.Forms.Length - 1) >= m_Datos.nForm Then
 195 128                         If .Document.Forms(m_Datos.nForm).Length - 1 >= m_Datos.nCont Then
 196 129                             .Document.Forms(m_Datos.nForm)(m_Datos.nCont).Value = m_Datos.accionEX2
 197 130                             Registrar "Res_Web: Texto llenado"
 198                             Else
 199 131                             Registrar "Res_Web: Err -> No existian suficientes controles"
 200 132                             NetError = True
 201                             End If
 202
 203                         Else
 204 133                         Registrar "Res_Web: Err -> No existian suficientes formularios"
 205 134                         NetError = True
 206                         End If
 207                     End If
 208
 209 135             Case ed_java
 210 136                 Registrar "Res_Web: JAVA excutado"
 211
 212 137             Case ed_navegar
 213                     'No hacer nada
 214             End Select
 215
 216         End With
 217
 218         Exit Sub
 219 subError:
 220 138     NetError = True
 221
 222 139     Select Case Err.Number
 223
 224             Case 91
 225 140             Registrar "++Error -> probablemente el router es incorrecto"
 226
 227 141         Case Else
 228 142             Registrar "++Error -> se desconoce la causa para un error #" & Err.Number
 229         End Select
 230
 231         '<EhFooter>
 232         Exit Sub
 233 res_Web_Err:
 234         Controlar_Error Erl, Err.Description, "Reseter.NET.res_Web.Ref 12/2/2008 : 09:38:35"
 235         Resume Next
 236         '</EhFooter>
 237 End Sub
 238
 239 Public Sub res_Telnet()
 240         'Reseteo via telnet
 241         '28/04/07 - 2.0.4: Unido con "Iniciar_Telnet", "Iniciar_Telnet" eliminado
 242         '<EhHeader>
 243         On Error GoTo res_Telnet_Err
 244         '</EhHeader>
 245 100     Registrar "+-[MODO TELNET] Enviando datos"
 246         '102     MsgBox "Telnet Iniciado"
 247 101     TelnetComandos() = Split(m_Datos.accionEX, ";")
 248 102     Registrar "No. de comandos a enviar: " & UBound(TelnetComandos) + 1
 249 103     nComando = 0
 250 104     Call frmTelnet.ProcTelnet
 251         '<EhFooter>
 252         Exit Sub
 253 res_Telnet_Err:
 254         Controlar_Error Erl, Err.Description, "Reseter.NET.res_Telnet.Ref 12/2/2008 : 09:38:35"
 255         Resume Next
 256         '</EhFooter>
 257 End Sub
 258
 259 Public Sub lpObjetoIE()
 260         '<EhHeader>
 261         On Error GoTo lpObjetoIE_Err
 262         '</EhHeader>
 263 100     KillTimer 0, hpObjetoIE
 264 101     Set IE = CreateObject("InternetExplorer.Application")
 265 102     IE.RegisterAsBrowser = True
 266 103     IE.Visible = False
 267 104     IE.Offline = False
 268 105     IE.Silent = False
 269
 270 106     If IE Is Nothing Then Registrar "El objeto IE no se pudo crear"
 271         '<EhFooter>
 272         Exit Sub
 273 lpObjetoIE_Err:
 274         Controlar_Error Erl, Err.Description, "Reseter.NET.lpObjetoIE.Ref 12/2/2008 : 09:38:35"
 275         Resume Next
 276         '</EhFooter>
 277 End Sub
 278
 279 Public Sub res_auro()
 280         'Reseteo via pagina web
 281         '<EhHeader>
 282         On Error GoTo res_auro_Err
 283         '</EhHeader>
 284 100     Registrar "+-[MODO WEB/AURONET] Enviando datos"
 285
 286 101     With ppSocket
 287 102         .Direccion = m_Datos.Direccion
 288         End With
 289
 290         '<EhFooter>
 291         Exit Sub
 292 res_auro_Err:
 293         Controlar_Error Erl, Err.Description, "Reseter.NET.res_auro.Ref 12/2/2008 : 09:38:35"
 294         Resume Next
 295         '</EhFooter>
 296 End Sub