el Guille, la Web del Visual Basic, C#, .NET y más...

Código fuente de LanConfig 2008

La clase LanCfg

 
Publicado el 12/Ene/2008
Actualizado el 12/Ene/2008
Autor: Guillermo 'guille' Som

Este es el código fuente (en línea) de la utilidad LanConfig 2008. En esta página está el de la clase LanCfg.



 

Introducción:

Pues eso... aunque puedes bajarte el código fuente del proyecto para Visual Basic 2008 desde la página principal de la utilidad LanConfig 2008, (que como sabes es una utilidad para manejar las configuraciones de redes que tienes instalada en tu quipo), me he decidido a publicar el código fuente de forma independiente y en línea, con idea de que puedas ver algunas de las cosas que hace la aplicación sin tener que bajarte el proyecto y verlo de forma desconectada.

En los temas relacionados te pongo los links a las diferentes partes (formularios y clases) que utiliza este proyecto.

 

'------------------------------------------------------------------------------
' Clase para guardar cada uno de los valores de configuración LAN   (01/Ago/07)
' Permitir configuración DHCP
'
' ©Guillermo 'guille' Som, 2007-2008
'------------------------------------------------------------------------------
Option Strict On

Imports Microsoft.VisualBasic
Imports vb = Microsoft.VisualBasic
Imports System

Imports System.Net
Imports System.Text

Imports System.Security.Principal
Imports System.Diagnostics

Imports System.Collections.Generic

Public Class LanCfg
    Implements IComparable(Of LanCfg), ICloneable

    '--------------------------------------------------------------------------
    ' Enumeraciones
    '--------------------------------------------------------------------------

    ''' <summary>
    ''' Enumeración para acceder a las propiedades
    ''' </summary>
    ''' <remarks></remarks>
    Public Enum Propiedades
        Nombre
        NombreCfg
        IPLocal
        PuertaEnlace
        DNS1
        DNS2
    End Enum

    ''' <summary>
    ''' Los formatos a usar con ToString
    ''' </summary>
    ''' <remarks></remarks>
    Public Enum Formatos
        Info
        Netsh
        NombreCfg
    End Enum

    ' Para asignar en el constructor                                (23/Dic/07)
    Private Shared ReadOnly m_EsAdministrador As Boolean

    '--------------------------------------------------------------------------
    ' Constructores
    '--------------------------------------------------------------------------

    ' Asignar el valor de si es administrador                       (30/Dic/07)
    ' en el constructor compartido
    Shared Sub New()
        m_EsAdministrador = EsAdministrador()
    End Sub

    Public Sub New()
    End Sub

    ''' <summary>
    ''' Constructor indicando el nombre de la configuración
    ''' </summary>
    ''' <param name="nombreCfg"></param>
    ''' <remarks></remarks>
    Public Sub New(ByVal nombreCfg As String)
        Me.NombreCfg = nombreCfg
    End Sub

    '--------------------------------------------------------------------------
    ' Propiedades
    '--------------------------------------------------------------------------

    Private m_NombreCfg As String
    ''' <summary>
    ''' Nombre amigable de la configuración
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Property NombreCfg() As String
        Get
            Return m_NombreCfg
        End Get
        Set(ByVal value As String)
            m_NombreCfg = value
        End Set
    End Property

    Private m_Nombre As String
    ''' <summary>
    ''' Nombre de la conexión de red en el equipo
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks>
    ''' Windows Vista por defecto le da nombres largos con espacios
    ''' pero es recomendable cambiarle el nombre para que no tenga espacios
    ''' si tiene espacios no funcionará (creo)
    ''' </remarks>
    Public Property Nombre() As String
        Get
            Return m_Nombre
        End Get
        Set(ByVal value As String)
            m_Nombre = value
        End Set
    End Property

    Private m_IPLocal As IPAddress
    ''' <summary>
    ''' Dirección IP local, por ejemplo 192.168.n.22
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Property IPLocal() As IPAddress
        Get
            If Me.m_IPLocal Is Nothing Then
                Return IPAddress.None
            End If
            Return m_IPLocal
        End Get
        Set(ByVal value As IPAddress)
            ' Comprobar el formato
            m_IPLocal = value
        End Set
    End Property

    Private m_PuertaEnlace As IPAddress
    ''' <summary>
    ''' La puerta de enlace (para conectar al router)
    ''' Normalmente será 182.168.n.1 o 192.168.n.254
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Property PuertaEnlace() As IPAddress
        Get
            If Me.m_PuertaEnlace Is Nothing Then
                Return IPAddress.None
            End If
            Return m_PuertaEnlace
        End Get
        Set(ByVal value As IPAddress)
            ' Comprobar el formato
            m_PuertaEnlace = value
        End Set
    End Property

    Private m_DNS1 As IPAddress
    ''' <summary>
    ''' Dirección IP de la DNS primaria
    ''' (para la resolución de nombres DNS)
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Property DNS1() As IPAddress
        Get
            If Me.m_DNS1 Is Nothing Then
                Return IPAddress.None
            End If
            Return m_DNS1
        End Get
        Set(ByVal value As IPAddress)
            ' Comprobar el formato
            m_DNS1 = value
        End Set
    End Property

    Private m_DNS2 As IPAddress
    ''' <summary>
    ''' Dirección IP de la DNS secundaria
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Property DNS2() As IPAddress
        Get
            If Me.m_DNS2 Is Nothing Then
                Return IPAddress.None
            End If
            Return m_DNS2
        End Get
        Set(ByVal value As IPAddress)
            ' Comprobar el formato
            m_DNS2 = value
        End Set
    End Property

    ' Propiedades para el DHCP automático                           (21/Dic/07)
    Private m_AutoIP As Boolean
    ''' <summary>
    ''' Si las IP y Gateway se asignan automáticamente por DHCP
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Property AutoIP() As Boolean
        Get
            Return m_AutoIP
        End Get
        Set(ByVal value As Boolean)
            m_AutoIP = value
            If value = False Then
                m_AutoDNS = False
            End If
        End Set
    End Property

    Private m_AutoDNS As Boolean
    ''' <summary>
    ''' Si las DNS se ajustan automáticamente
    ''' (solo si AutoIP está seleccionada)
    ''' </summary>
    ''' <value></value>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Property AutoDNS() As Boolean
        Get
            Return m_AutoDNS
        End Get
        Set(ByVal value As Boolean)
            ' Solo asignar el valor si AutoIP es True
            If m_AutoIP = False Then
                m_AutoDNS = False
            Else
                m_AutoDNS = value
            End If
        End Set
    End Property


    '--------------------------------------------------------------------------
    ' Métodos
    '--------------------------------------------------------------------------

    ''' <summary>
    ''' Asigna la IP según una cadena
    ''' </summary>
    ''' <param name="propiedad">
    ''' Propiedad a la que asignar
    ''' (usando la enumeración Propiedades)
    ''' </param>
    ''' <param name="valor">
    ''' El valor a asignar
    ''' Si es una cadena vacia, se asignará un valor IPAddress.None
    ''' </param>
    ''' <remarks>
    ''' Se pueden indicar en varios formatos,
    ''' pero es recomendable hacer al estilo de 192.168.1.1
    ''' </remarks>
    Public Sub SetIPAddress(ByVal propiedad As Propiedades, ByVal valor As String)
        ' Si la cadena está vacía, asignar un valor None
        ' pero solo a las direcciones IP
        If String.IsNullOrEmpty(valor) Then
            Select Case propiedad
                Case Propiedades.IPLocal
                    Me.IPLocal = IPAddress.None
                Case Propiedades.PuertaEnlace
                    Me.PuertaEnlace = IPAddress.None
                Case Propiedades.DNS1
                    Me.DNS1 = IPAddress.None
                Case Propiedades.DNS2
                    Me.DNS2 = IPAddress.None
            End Select

            Exit Sub
        End If

        ' Detectar los posibles errores al asignar la IP
        Try
            Select Case propiedad
                Case Propiedades.IPLocal
                    Me.IPLocal = IPAddress.Parse(valor)
                Case Propiedades.PuertaEnlace
                    Me.PuertaEnlace = IPAddress.Parse(valor)
                Case Propiedades.DNS1
                    Me.DNS1 = IPAddress.Parse(valor)
                Case Propiedades.DNS2
                    Me.DNS2 = IPAddress.Parse(valor)
                Case Propiedades.Nombre
                    Me.Nombre = valor
                Case Propiedades.NombreCfg
                    Me.NombreCfg = valor
            End Select
        Catch ex As Exception
            ' Lanzar un error de la clase LanCfgException
            Throw New LanCfgException( _
                        propiedad.ToString, _
                        My.Resources.LanCfgAsigIP & " " & propiedad.ToString, _
                        ex)
        End Try
    End Sub

    ''' <summary>
    ''' Devolver una cadena con los datos de configuración
    ''' </summary>
    ''' <param name="formato">
    ''' El formato a usar:
    ''' Info: para mostrar la información de las direcciones
    ''' Netsh: El formato a usar con la utilidad netsh
    ''' NombreCfg: El nombre de la configuración y la IP
    ''' </param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Overloads Function ToString(ByVal formato As Formatos) As String
        Dim sb As New StringBuilder

        Select Case formato
            Case Formatos.Info
                sb.AppendFormat("{0}: ", Me.Nombre)
                If AutoIP Then
                    sb.Append("(Auto IP) ")
                Else
                    sb.AppendFormat("{0}, {1}, ", _
                                    Me.IPLocal.ToString, _
                                    Me.PuertaEnlace.ToString)
                End If
                If AutoDNS Then
                    sb.Append("(Auto DNS)")
                Else
                    sb.AppendFormat("{0}, {1}", _
                                    Me.DNS1.ToString, _
                                    Me.DNS2.ToString)
                End If
            Case Formatos.Netsh
                ' No incluir el comando, solo los argumentos

                ' Si AutoIP = True las IP se asignan por DHCP       (21/Dic/07)
                If AutoIP = True Then
                    ' netsh interface ip set address name="%iface%" source=dhcp 
                    sb.AppendFormat("interface ip set address name=""{0}"" source=dhcp", _
                                    Me.Nombre)
                Else
                    sb.AppendFormat("interface ip set address name=""{0}"" " & _
                                    "source=static addr={1} mask=255.255.255.0 " & _
                                    "gateway={2} gwmetric=1", _
                                    Me.Nombre, Me.IPLocal.ToString, Me.PuertaEnlace.ToString)
                End If
                sb.AppendLine()
                ' Si se deben asignar automáticamente las DNS
                If AutoDNS = True Then
                    ' netsh interface ip set dns name="%iface%" source=dhcp
                    sb.AppendFormat("interface ip set dns name=""{0}"" source=dhcp", _
                                    Me.Nombre)
                    sb.AppendLine()
                    ' netsh interface ip set wins name="%iface%" source=dhcp
                    sb.AppendFormat("interface ip set wins name=""{0}"" source=dhcp", _
                                    Me.Nombre)
                Else
                    sb.AppendFormat("interface ip set dns name=""{0}"" " & _
                                    "source=static addr={1} register=PRIMARY", _
                                    Me.Nombre, Me.DNS1.ToString)
                    sb.AppendLine()
                    sb.AppendFormat("interface ip add dns name=""{0}"" addr={1}", _
                                    Me.Nombre, Me.DNS2.ToString)
                End If
            Case Else
                Return Me.ToString
        End Select

        Return sb.ToString
    End Function

    ''' <summary>
    ''' Devuelve una cadena para mostrar este dato de configuración IP
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Overrides Function ToString() As String
        Return String.Format("{0}: {1}", NombreCfg, Me.IPLocal.ToString)
    End Function

    ''' <summary>
    ''' Aplicar la configuración actual
    ''' </summary>
    ''' <returns>
    ''' Una cadena con los mensajes de error
    ''' </returns>
    ''' <remarks></remarks>
    Public Function AplicarConfig(Optional ByVal esQuiet As Boolean = False) As String
        ' Para los mensajes de error
        Dim sb As New System.Text.StringBuilder

        ' Usar la variable privada                                  (23/Sep/07)
        If m_EsAdministrador = False Then
            sb.Append(My.Resources.LanCfgError)
            sb.AppendLine()
            sb.Append(My.Resources.LanCfgAdmin)
            Return sb.ToString
        End If

        Dim comandos As New List(Of String)
        Dim lineas() As String = Me.ToString(LanCfg.Formatos.Netsh). _
                                        Split(vbCrLf.ToCharArray, _
                                              StringSplitOptions.RemoveEmptyEntries)
        comandos.AddRange(lineas)


        ' Iniciar el proceso y redirigir la salida para capturarla
        For Each args As String In comandos
            Dim p As New Process

            p.StartInfo.FileName = "netsh "
            p.StartInfo.Arguments = args

            If esQuiet Then
                p.StartInfo.WindowStyle = ProcessWindowStyle.Hidden
            Else
                ' Cuando UseShellExecute = False, no hace caso a esta asignación:
                'p.StartInfo.WindowStyle = ProcessWindowStyle.Minimized

                ' Indicamos que queremos redirigir la salida de errores
                p.StartInfo.RedirectStandardError = True
                ' Para redirigir la salida, UseShellExecute debe ser falso
                p.StartInfo.UseShellExecute = False
            End If


            ' Capturamos los errores
            Try
                ' Iniciamos el proceso
                p.Start()

                ' Esperamos tres segundos por si no se cierra la ventana
                p.WaitForExit(3000)

                If esQuiet = False Then
                    ' Leer el contenido de la salida y mostrarla
                    'sb = New System.Text.StringBuilder
                    Dim s As String = p.StandardError.ReadToEnd()
                    If String.IsNullOrEmpty(s) = False Then
                        sb.Append(args)
                        sb.AppendLine()
                        sb.AppendFormat("  {0}", s)
                        sb.AppendLine()
                        sb.AppendLine()
                    End If
                End If

            Catch ex As Exception
                'sb.Append("ERROR al ejecutar:")
                sb.Append(My.Resources.LanCfgErrorEjec)
                sb.AppendLine()
                sb.AppendFormat("  {0}", args)
                sb.AppendLine()
                sb.Append(ex.Message)
                sb.AppendLine()
            End Try
        Next

        Return sb.ToString
    End Function

    '
    ' Los métodos para las implementaciones de las interfaces       (25/Dic/07)
    '

    ''' <summary>
    ''' Compara el nombre amigable (NombreCfg) de la instancia actual con otra
    ''' </summary>
    ''' <param name="other"></param>
    ''' <returns>
    ''' Un valor cero si son iguales, 
    ''' mayor de cero si la actual es mayor,
    ''' menor de cero si la actual es menor
    ''' </returns>
    ''' <remarks>
    ''' 25/Dic/07
    ''' Esto puede servir para clasificar objetos de este tipo
    ''' </remarks>
    Public Function CompareTo(ByVal other As LanCfg) As Integer _
                                    Implements System.IComparable(Of LanCfg).CompareTo
        ' Comparar el nombre amigable
        Return String.Compare(Me.NombreCfg, other.NombreCfg)
    End Function

    ''' <summary>
    ''' Hace una copia de este objeto
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Public Function Clone() As Object Implements System.ICloneable.Clone
        Return Me.MemberwiseClone
    End Function


    '--------------------------------------------------------------------------
    ' Métodos estáticos
    '--------------------------------------------------------------------------

    ''' <summary>
    ''' Averiguar si se ejecuta como administrador
    ''' </summary>
    ''' <returns>
    ''' Verdadero o falso según se ejecute como administrador o no
    ''' </returns>
    ''' <remarks>
    ''' Parte del código por Adam Braden
    ''' </remarks>
    Public Shared Function EsAdministrador() As Boolean
        My.User.InitializeWithWindowsUser()

        Return My.User.IsInRole(ApplicationServices.BuiltInRole.Administrator)
    End Function

    ' Para obtener las configuraciones actuales
    Public Shared Function GetLanConfig() As List(Of LanCfg)
        ' El comando a ejecutar es:
        ' netsh interface ip show config
        Dim col As New List(Of LanCfg)
        ' Si no es administrador, devolver una colección vacía
        If m_EsAdministrador = False Then
            Return col
        End If

        Dim p As New Process

        p.StartInfo.FileName = "netsh "
        p.StartInfo.Arguments = "interface ip show config" ' >LanConfig.txt"

        ' Indicamos que queremos redirigir la salida estándard
        p.StartInfo.RedirectStandardOutput = True
        ' Para redirigir la salida, UseShellExecute debe ser falso
        p.StartInfo.UseShellExecute = False

        ' Poner la ventana minimizada                               (04/Ene/08)
        p.StartInfo.WindowStyle = ProcessWindowStyle.Minimized

        Try
            ' Iniciamos el proceso
            p.Start()

            ' Esperamos tres segundos por si no se cierra la ventana
            p.WaitForExit(3000)

            ' Capturamos la salida
            Dim s As String = p.StandardOutput.ReadToEnd()

            ' Crear un array con los valores leídos
            Dim valores() As String = s.Split(vbCrLf.ToCharArray, _
                                              StringSplitOptions.RemoveEmptyEntries)

            Dim c As LanCfg = Nothing
            Dim sCadena1 As String = ChrW(34)
            Dim sCadena2 As String = ChrW(34)
            Dim lenCadena1 As Integer = 1
            Dim lenCadena2 As Integer = 1
            If s.IndexOf("ÿ¯") > -1 Then
                ' Es francés
                sCadena1 = "ÿ¯"
                sCadena2 = "®ÿ"
                lenCadena1 = 2
                lenCadena2 = 2
            End If

            For i As Integer = 0 To valores.Length - 1
                s = valores(i)
                If vb.Len(s) = 0 Then Continue For

                Dim j As Integer = s.LastIndexOf(sCadena1)
                If j > -1 Then

                    ' Esta asignación debe estar antes
                    ' de asignar el valor nulo, 
                    ' ya que si no, se asignaría a la instancia anterior
                    c = New LanCfg

                    Dim k As Integer = s.LastIndexOf(sCadena2, j - lenCadena1)

                    ' Si no hay comillas dobles... bueno, pasar de esto...
                    If k = -1 Then
                        ' Asignar un valor nulo
                        ' para no tenerlo en cuenta
                        c = Nothing
                        Continue For
                    End If

                    ' El nombre será lo que esté entre k y j
                    Dim sNombre As String
                    ' Mirar si se debe usar otra codificación       (03/Ene/08)
                    ' En XP y Windows Server 2000/2003 los caracteres especiales no se ven bien
                    ' Por ejemplo:
                    '   Configuraci¢n para la interfaz "Conexi¢n de \~rea local"
                    ' en vez de:
                    '   Configuración para la interfaz "Conexión de área local"
                    ' 
                    sNombre = s.Substring(k + lenCadena2, j - (k + lenCadena2))

                    ' Por si es XP y similar                        (03/Ene/08)
                    ' Si no se corrige, no encuentra la conexión
                    If sNombre = "Conexi¢n de \~rea local" Then
                        sNombre = "Conexión de área local"
                    ElseIf sNombre.StartsWith("ÿ") Then
                        sNombre = sNombre.Substring(1)
                    End If
                    c.Nombre = sNombre
                    c.NombreCfg = "Cfg " & sNombre
                    ' lo agregamos a la colección
                    col.Add(c)

                ElseIf c IsNot Nothing Then
                    ' Comprobar si está habilitado el DHCP
                    If s.TrimStart().StartsWith("DHCP") Then
                        ' Comprobar si está habilitado
                        Dim k As Integer = s.IndexOf(":")
                        ' En francés es Non y en alemán es Nein     (04/Ene/08)
                        ' Usar la "N" para "no"
                        If s.Substring(k + 1).TrimStart().ToLower().StartsWith("n") Then
                            c.AutoIP = False
                            c.AutoDNS = False
                        Else
                            c.AutoIP = True
                        End If
                    ElseIf s.Contains("IP") Then
                        ' La dirección IP
                        Dim k As Integer = s.IndexOf(":")
                        Dim n As Integer = s.IndexOf("IP")
                        ' (no hay más cadenas que tengan estas letras
                        ' pero mejor asegurarse de que están antes de los dos puntos)
                        ' En alemán está de esta forma: IP-Adresse: (04/Ene/08)
                        If n > k Then
                            Continue For
                        End If
                        ' Asignamos el valor aunque esté en automático
                        s = s.Substring(k + 1).Trim()
                        'c.IPLocal = IPAddress.Parse(s)
                        c.SetIPAddress(LanCfg.Propiedades.IPLocal, s)

                        ' También puede estar como "predeterminada :" (03/Ene/08)
                        ' En francés es "Passerelle par défaut\~:"
                        ' En alemán es "Standardgateway:"
                    ElseIf s.ToLower().Contains("gateway:") OrElse s.Contains("predeterminada") _
                    OrElse s.TrimStart().ToLower().StartsWith("passarelle") Then
                        ' La puerta de enlace
                        Dim k As Integer = s.IndexOf(":")
                        s = s.Substring(k + 1).Trim()
                        c.SetIPAddress(LanCfg.Propiedades.PuertaEnlace, s)
                    ElseIf s.Contains("DNS") Then
                        ' Si son los valores de los servidores DNS
                        ' Pueden ser estáticos o dinámicos (por DHCP)
                        ' En cualquier caso, si el valor empieza por "n" es que no están asignados
                        ' se supone que el DNS es automático
                        Dim k As Integer = s.IndexOf(":")
                        'If s.Substring(k + 1).TrimStart().ToLower().StartsWith("n") Then
                        '    c.AutoDNS = True
                        '    Continue For
                        'End If
                        ' En alemán: Keine, en francés: Aucun en vez de none o ninguno
                        ' En holandés: Geen, italiano: Nessuno, Portugués: Nenhum, Sueco: Inget
                        ' Comprobar con 3 letras, si no, con una    (04/Ene/08)
                        Select Case s.Substring(k + 1).TrimStart().ToLower().Substring(0, 3)
                            Case "non", "nin", "kei", "auc", "gee", "nes", "nen", "ing"
                                c.AutoDNS = True
                                Continue For
                            Case Else
                                Select Case s.Substring(k + 1).TrimStart().ToLower().Substring(0, 1)
                                    Case "n", "k", "a", "g", "i"
                                        c.AutoDNS = True
                                        Continue For
                                End Select
                        End Select
                        ' Averiguar el valor del DNS y si están asignados
                        If s.Contains("DNS") Then
                            c.AutoDNS = True
                        Else
                            c.AutoDNS = False
                        End If
                        ' Asignar las direcciones
                        s = s.Substring(k + 1).Trim()
                        c.SetIPAddress(LanCfg.Propiedades.DNS1, s)
                        ' Si hay más estarán en las siguientes líneas...
                        ' probamos suerte!!!
                        If i < valores.Length - 2 Then
                            s = valores(i + 1)
                            ' El valor estará "solano"
                            If String.IsNullOrEmpty(s) = False _
                            AndAlso s.Contains(":") = False Then
                                c.SetIPAddress(LanCfg.Propiedades.DNS2, s.Trim())
                                ' Pasamos de este valor
                                i += 1
                                ' y no tenemos en cuenta más direcciones DNS, 
                                ' de todas formas solo podemos almacenar dos...
                                'Continue For
                            End If
                        End If
                    End If
                End If
            Next

        Catch ex As Exception
            Using sw As New StreamWriter("LanConfig_Error_" & _
                                         DateTime.Now.ToString("yyyy_MM_dd_HH_mm_ss") & ".log", _
                                         True, System.Text.Encoding.Default)
                sw.WriteLine("ERROR= " & ex.Message)
                sw.Close()
            End Using
        End Try

        Return col
    End Function
End Class

 

Espero que te sea de utilidad.

Nos vemos.
Guillermo

 


 


La fecha/hora en el servidor es: 13/11/2024 11:17:33

La fecha actual GMT (UTC) es: 

©Guillermo 'guille' Som, 1996-2024