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