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.
'------------------------------------------------------------------------------
' Configuración de red local para Windows Vista (01/Ago/07)
' Usando un código "batch" de Juansa Llopis
'
' Se permite configurar con DNS automático (21/Dic/07)
'
' Se debe ejecutar como administrador
'
' ©Guillermo 'guille' Som, 2007-2008
'------------------------------------------------------------------------------
Option Strict On
Imports Microsoft.VisualBasic
Imports System
Imports System.Windows.Forms
Imports System.Drawing
Imports System.Collections.Generic
Imports LanConfig.elGuille.info.Util
Partial Public Class fLanCfg
Private Const gatewayNuevo As String = "nuevo"
Private copiaConfiguraciones As New List(Of LanCfg)
Private copiadasConfiguraciones As Boolean = False
Public Const FechaRevision As String = " 09/Ene/2008"
' Para los argumentos de la línea de comandos (23/Dic/07)
Private colArgumentos As New List(Of String)
Private esQuiet As Boolean = False
Private m_EsAdministrador As Boolean = False
' El path del fichero de ayuda
Private ficAyuda As String
' Para el nombre de la sección general de la configuración
Private Const cfgVentana As String = "Ventana"
Private Const cfgConfigs As String = "Configuraciones"
' Para que no se analice código cuando está iniciando
Private iniciando As Boolean = True
' Para acceder a los datos de configuración "personalizadas"
Private cfg As ConfigXml
Private Sub guardarCfg()
' Eliminar la sección (pero parece que no lo borra)
' (aunque no importa, ya que solo se tienen en cuenta los datos actuales)
cfg.RemoveSection(cfgConfigs)
' El total de configuraciones
cfg.SetKeyValue(cfgConfigs, "Total", Me.cboConfig.Items.Count)
' La configuración que está actualmente seleccionada
cfg.SetKeyValue(cfgConfigs, "Default", Me.cboConfig.SelectedIndex)
' Guardar los datos de cada configuración
For i As Integer = 0 To Me.cboConfig.Items.Count - 1
Dim c As LanCfg = TryCast(Me.cboConfig.Items(i), LanCfg)
If c Is Nothing Then Continue For
Dim s As String = cfgConfigs & "/Cfg_" & i.ToString("000")
' Para que se pueda usar el formato / hay que crear la sección
' con SetValue
cfg.SetValue(cfgConfigs, "Cfg_" & i.ToString("000"), c.NombreCfg)
'cfg.SetKeyValue(s, "NombreCfg", c.NombreCfg)
cfg.SetKeyValue(s, "Nombre", c.Nombre)
cfg.SetKeyValue(s, "AutoIP", c.AutoIP)
cfg.SetKeyValue(s, "AutoDNS", c.AutoDNS)
cfg.SetKeyValue(s, "IPLocal", c.IPLocal.ToString)
cfg.SetKeyValue(s, "PuertaEnlace", c.PuertaEnlace.ToString)
cfg.SetKeyValue(s, "DNS1", c.DNS1.ToString)
cfg.SetKeyValue(s, "DNS2", c.DNS2.ToString)
Next
cfg.Save()
End Sub
Private Sub leerCfg()
Dim n As Integer = cfg.GetValue(cfgConfigs, "Total", 0)
Me.cboConfig.Items.Clear()
Me.cboConfigCfg.Items.Clear()
For i As Integer = 0 To n - 1
Dim s As String = cfgConfigs & "/Cfg_" & i.ToString("000")
Dim c As New LanCfg
With c
'.NombreCfg = cfg.GetValue(s, "NombreCfg", "")
.NombreCfg = cfg.GetValue(cfgConfigs, "Cfg_" & i.ToString("000"), "")
.Nombre = cfg.GetValue(s, "Nombre", "")
' Leer los valores para el DHCP (21/Dic/07)
.AutoIP = cfg.GetValue(s, "AutoIP", False)
.AutoDNS = cfg.GetValue(s, "AutoDNS", False)
If .AutoIP = False Then
.SetIPAddress(LanCfg.Propiedades.IPLocal, cfg.GetValue(s, "IPLocal", ""))
.SetIPAddress(LanCfg.Propiedades.PuertaEnlace, cfg.GetValue(s, "PuertaEnlace", ""))
End If
If .AutoDNS = False Then
.SetIPAddress(LanCfg.Propiedades.DNS1, cfg.GetValue(s, "DNS1", ""))
.SetIPAddress(LanCfg.Propiedades.DNS2, cfg.GetValue(s, "DNS2", ""))
End If
End With
' Solo añadir las que tengan un nombre
If String.IsNullOrEmpty(c.Nombre) = False Then
Me.cboConfig.Items.Add(c)
Me.cboConfigCfg.Items.Add(c)
' Solo copiarlo la primera vez (25/Dic/07)
' este valor se asigna a False al cargarse el programa
If Me.copiadasConfiguraciones = False Then
copiaConfiguraciones.Add(TryCast(c.Clone, LanCfg))
End If
End If
Next
' Si llega aquí, pues es que ya se han copiado (25/Dic/07)
Me.copiadasConfiguraciones = True
' El valor predeterminado
n = cfg.GetValue(cfgConfigs, "Default", -1)
If n > -1 Then
Me.cboConfig.SelectedIndex = n
Me.cboConfigCfg.SelectedIndex = n
ElseIf Me.cboConfig.Items.Count > 0 Then
Me.cboConfig.SelectedIndex = 0
Me.cboConfigCfg.SelectedIndex = 0
End If
End Sub
Private Sub Form1_FormClosing(ByVal sender As Object, _
ByVal e As FormClosingEventArgs) _
Handles Me.FormClosing
' Al cerrar el formulario, guardar los datos de configuración
' solo si no se habían guardado
If Me.btnGuardar.Enabled Then
guardarCfg()
End If
' Guardar la posicioón y tamaño del formulario
' Si está minimizado, usar los valores que se usarán al restaurar
If Me.WindowState = FormWindowState.Normal Then
cfg.SetKeyValue(cfgVentana, "FormTop", Me.Top)
cfg.SetKeyValue(cfgVentana, "FormLeft", Me.Left)
cfg.SetKeyValue(cfgVentana, "FormHeight", Me.Height)
cfg.SetKeyValue(cfgVentana, "FormWidth", Me.Width)
Else
If Me.WindowState = FormWindowState.Normal Then
cfg.SetKeyValue(cfgVentana, "FormTop", Me.RestoreBounds.Top)
cfg.SetKeyValue(cfgVentana, "FormLeft", Me.RestoreBounds.Left)
cfg.SetKeyValue(cfgVentana, "FormHeight", Me.RestoreBounds.Height)
cfg.SetKeyValue(cfgVentana, "FormWidth", Me.RestoreBounds.Width)
End If
End If
cfg.Save()
End Sub
Private Sub Form1_Load(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles MyBase.Load
Dim fic As String
m_EsAdministrador = LanCfg.EsAdministrador
' Leer los argumentos de la línea de comandos
' si se indica /Q (-q, -quiet, /QUIET) no mostrar el formulario
' si se indica /H (-h, -help, /HELP) mostrar las opciones de línea de comandos
Dim argumentos() As String = Environment.GetCommandLineArgs()
' que como mínimo tenga el primer argumento, que es el nombre del ejecutable
colArgumentos.Add(argumentos(0))
esQuiet = False
Dim esHelp As Boolean = False
If argumentos.Length > 1 Then
For i As Integer = 1 To argumentos.Length - 1
' No tener en cuenta los vacios
argumentos(i) = Microsoft.VisualBasic.Trim(argumentos(i))
If String.IsNullOrEmpty(argumentos(i)) Then
Continue For
End If
' permitir más de un - delante del argumento
While argumentos(i).StartsWith("--")
argumentos(i) = argumentos(i).Substring(1)
End While
Select Case argumentos(i).ToLower
Case "-q", "/q", "-quiet", "/quiet"
esQuiet = True
Case "-h", "/h", "-help", "/help"
esHelp = True
Exit For
Case Else
colArgumentos.Add(argumentos(i))
End Select
Next
If esHelp Then
'
'TODO: Habría que asignar el idioma para que las cadenas
' se muestren en el adecuado a la configuración
'
' Mostrar la ayuda y salir)
MessageBox.Show(My.Application.Info.ProductName & _
" [/H] [[/Q] [config1 [config2] [configN]]" & vbCrLf & vbCrLf & _
"/H " & My.Resources.fLanCfgHelpString2 & vbCrLf & _
"/Q " & My.Resources.fLanCfgHelpString3 & vbCrLf & _
" " & My.Resources.fLanCfgHelpString4 & vbCrLf & _
vbCrLf & My.Resources.fLanCfgHelpString5, _
My.Resources.fLanCfgHelpString1, _
MessageBoxButtons.OK, _
MessageBoxIcon.Information)
' Usar End para que no intente guardar los valores de configuración
End
End If
If m_EsAdministrador = False Then
esQuiet = False
End If
' Comprobar si se inicia desde la línea de comandos (23/Dic/07)
' Si solo hay un argumento, es que no hay configuraciones
' por tanto, asignar esQuiet = False
If colArgumentos.Count = 1 Then
esQuiet = False
End If
If esQuiet Then
Me.Visible = False
fic = ficheroCfg(False)
' Crear el objeto de configuración
cfg = New ConfigXml(fic, False)
leerCfg()
' Llamarla directamente sin timer ni nada
' con idea de que no se muestre el formulario
lineaComandos()
' Salir de forma normal
' en el método se habrá llamado a Me.Close()
Exit Sub
End If
End If
' El path del fichero de ayuda
ficAyuda = My.Application.Info.DirectoryPath & "\ayuda\LanConfig.chm"
' El fichero de configuración
' (se tiene en cuenta el directorio a usar)
fic = ficheroCfg()
' Crear el objeto de configuración
cfg = New ConfigXml(fic, False)
' Esto es para que no se vea el movimiento...
' Leer los valores del tamaño y posición del formulario
Me.Top = cfg.GetValue(cfgVentana, "FormTop", Me.Top)
Me.Left = cfg.GetValue(cfgVentana, "FormLeft", Me.Left)
Me.Height = cfg.GetValue(cfgVentana, "FormHeight", Me.Height)
Me.Width = cfg.GetValue(cfgVentana, "FormWidth", Me.Width)
' Leerlo después de iniciar la variable cfg
' leer cultura y aplicar idioma
Dim lang As String
' Obtener el idioma de la configuración
lang = My.Settings.language
If String.IsNullOrEmpty(lang) Then
Dim value As CultureInfo = CultureInfo.CurrentUICulture
lang = value.ToString
End If
actualizarIdioma(lang)
' Asignar el tamaño y posición después de leer los datos del idioma
' Leer los valores del tamaño y posición del formulario
Me.Top = cfg.GetValue(cfgVentana, "FormTop", Me.Top)
Me.Left = cfg.GetValue(cfgVentana, "FormLeft", Me.Left)
Me.Height = cfg.GetValue(cfgVentana, "FormHeight", Me.Height)
Me.Width = cfg.GetValue(cfgVentana, "FormWidth", Me.Width)
Me.statusInfo.Tag = Me.statusInfo.Text
Me.btnGuardar.Enabled = False
' Comprobar si se inicia desde la línea de comandos (23/Dic/07)
' (si llega aquí es que esQuiet = False)
If colArgumentos.Count > 1 Then
timerArgs.Interval = 100
timerArgs.Start()
End If
iniciando = False
End Sub
''' <summary>
''' Por si se inicia con argumentos de la línea de comandos
''' </summary>
''' <remarks></remarks>
Private Sub lineaComandos()
' Comprobar si hay argumentos en la línea de comandos (23/Dic/07)
Dim argsn As Integer = colArgumentos.Count
If argsn > 1 Then
' Usar la colección definida a nivel del formulario
' ya que tendrá los argumentos sin los comandos especiales
'Dim colArgumentos() As String = Environment.GetCommandLineArgs
Dim argsCfg As New List(Of LanCfg)
Dim argsCfgNo As New List(Of String)
Dim esta As Integer
' Comprobar si los argumentos son nombres de configuraciones
For i As Integer = 1 To argsn - 1
esta = -1
For Each obj As LanCfg In cboConfig.Items
If colArgumentos(i).ToLower().CompareTo(obj.NombreCfg.ToLower()) = 0 Then
argsCfg.Add(obj)
esta = i
Exit For
End If
Next
If esta = -1 Then
argsCfgNo.Add(colArgumentos(i))
End If
Next
' Por defecto se aplican las configuraciones
' si no coincide ninguna, se quitará
Dim aplicarCfg As Boolean = True
Dim noCfg As Integer = (argsn - 1) - argsCfg.Count
Dim sPlural As String
Dim sbCfg As New System.Text.StringBuilder()
With sbCfg
For Each c As String In argsCfgNo
.AppendFormat(" {0}{1}", c, vbCrLf)
Next
End With
If noCfg = (argsn - 1) Then
' Si no hay nada que configurar
' y se ha indicado que no se muestren mensajes
' terminar
If esQuiet Then Me.Close()
aplicarCfg = False
If noCfg = 1 Then
sPlural = My.Resources.fLanCfgArgString1
Else
sPlural = My.Resources.fLanCfgArgString2
End If
MessageBox.Show(sPlural & vbCrLf & _
sbCfg.ToString(), _
My.Resources.fLanCfgArgString3, _
MessageBoxButtons.OK, _
MessageBoxIcon.Exclamation)
ElseIf noCfg > 0 Then
If esQuiet = False Then
Dim sPlural2 As String
If noCfg = 1 Then
sPlural = My.Resources.fLanCfgArgString4
Else
sPlural = My.Resources.fLanCfgArgString5 & " " & _
noCfg & " " & My.Resources.fLanCfgArgString6
End If
If argsCfg.Count = 1 Then
sPlural2 = My.Resources.fLanCfgArgString7
Else
sPlural2 = My.Resources.fLanCfgArgString8
End If
With sbCfg
.AppendFormat(" {0}", My.Resources.fLanCfgArgString9)
.AppendLine()
For Each c As LanCfg In argsCfg
.AppendFormat(" {0}{1}", c.NombreCfg, vbCrLf)
Next
End With
If MessageBox.Show(sPlural & vbCrLf & _
sbCfg.ToString() & vbCrLf & _
sPlural2, _
My.Resources.fLanCfgArgString3, _
MessageBoxButtons.YesNo, _
MessageBoxIcon.Exclamation Or MessageBoxIcon.Question _
) = Windows.Forms.DialogResult.No Then
aplicarCfg = False
End If
End If
End If
If aplicarCfg Then
Dim colorinesFondo, colorinesFore As Color
If esQuiet = False Then
colorinesFondo = Me.statusInfo.BackColor
colorinesFore = Me.statusInfo.ForeColor
Me.statusInfo.BackColor = Color.Green
Me.statusInfo.ForeColor = Color.White
Me.statusInfo.Text = My.Resources.fLanCfgArgStatus
Me.Cursor = Cursors.WaitCursor
Me.Refresh()
End If
Try
For Each c As LanCfg In argsCfg
' ignorar los errores que se produzcan...
aplicarConfig(c)
Next
Catch 'ex As Exception
End Try
If esQuiet = False Then
Me.statusInfo.BackColor = colorinesFondo
Me.statusInfo.ForeColor = colorinesFore
Me.statusInfo.Text = Me.statusInfo.Tag.ToString
Me.Cursor = Cursors.Default
Me.Refresh()
Else
Me.Close()
End If
End If
End If
End Sub
Private Sub fLanCfg_Move(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles Me.Move
' Esto es necesario para que no se ejecute este código
' mientras se está cargando (iniciando) el formulario
If iniciando Then Exit Sub
' Asignar la posición del formulario
If Me.WindowState = FormWindowState.Normal Then
cfg.SetKeyValue(cfgVentana, "FormTop", Me.Top)
cfg.SetKeyValue(cfgVentana, "FormLeft", Me.Left)
End If
End Sub
Private Sub fLanCfg_Resize(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles Me.Resize
' Esto es necesario para que no se ejecute este código
' mientras se está cargando (iniciando) el formulario
If iniciando Then Exit Sub
' Solo si no está minimizado o maximizado
' Asignar los valores del tamaño del formulario
If Me.WindowState = FormWindowState.Normal Then
cfg.SetKeyValue(cfgVentana, "FormHeight", Me.Height)
cfg.SetKeyValue(cfgVentana, "FormWidth", Me.Width)
End If
End Sub
Private Sub btnAplicar_Click(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles btnAplicar.Click, mnuAplicar.Click
' Ejecutar el comando netsh con los datos de la configuración seleccionada
' si no se tiene privilegios de administrador seguramente no tendrá efecto
' pero no se produce un error.
Dim n As Integer = Me.cboConfig.SelectedIndex
If n = -1 Then Exit Sub
Dim c As LanCfg = TryCast(Me.cboConfig.Items(n), LanCfg)
If c Is Nothing Then Exit Sub
Me.statusInfo.Tag = Me.statusInfo.Text
Me.statusInfo.Text = My.Resources.Resources.fLanCfgstatusinfo4.ToString
Me.btnAplicar.Enabled = False
Me.Cursor = Cursors.WaitCursor
Me.Refresh()
' Para los mensajes de error
Dim sb As New System.Text.StringBuilder
' aplicar la configuración
sb.Append(aplicarConfig(c))
Me.Cursor = Cursors.Default
' Si se ha producido algún error
If sb.Length > 0 Then
MessageBox.Show(sb.ToString, _
My.Resources.Resources.fLanCfgmessage1, _
MessageBoxButtons.OK, _
MessageBoxIcon.Exclamation)
End If
' Guardar la configuración del seleccionado
cfg.SetKeyValue("Configuraciones", "Default", Me.cboConfig.SelectedIndex)
Me.statusInfo.Text = Me.statusInfo.Tag.ToString
Me.btnAplicar.Enabled = True
Me.Refresh()
End Sub
''' <summary>
''' Aplicar la configuración indicada por el objeto del tipo LanCfg
''' </summary>
''' <param name="c"></param>
''' <returns></returns>
''' <remarks>
''' 23/Dic/07
''' Puesto como un método independiente para usar desde la línea de comandos
''' </remarks>
Private Function aplicarConfig(ByVal c As LanCfg) As String
If c Is Nothing Then Return My.Resources.Resources.fLanCfgmessage1
' Para los mensajes de error
Dim sb As New System.Text.StringBuilder
' aplicar la configuración
' usando el método de la clase LanCfg
sb.Append(c.AplicarConfig(esQuiet))
Return sb.ToString
End Function
''' <summary>
''' Recupera los valores que había al iniciar la aplicación
''' (se descartan los cambios realizados)
''' </summary>
''' <param name="sender"></param>
''' <param name="e"></param>
''' <remarks>
''' 25/Dic/07
''' </remarks>
Private Sub btnRecuperarValores_Click(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles btnRecuperarValores.Click
' Esto no es necesario, pero... (08/Ene/08)
If Me.copiaConfiguraciones.Count = 0 Then
Me.btnRecuperarValores.Enabled = False
Exit Sub
End If
If MessageBox.Show(My.Resources.fLanCfgRecuperar1 & vbCrLf & _
My.Resources.fLanCfgRecuperar2, _
My.Resources.fLanCfgRecuperar3, _
MessageBoxButtons.YesNo, _
MessageBoxIcon.Question, _
MessageBoxDefaultButton.Button2 _
) = Windows.Forms.DialogResult.Yes Then
Me.cboConfig.Items.Clear()
Me.cboConfigCfg.Items.Clear()
For Each c As LanCfg In Me.copiaConfiguraciones
Me.cboConfig.Items.Add(c)
Me.cboConfigCfg.Items.Add(c)
Next
' Comprobaciones extras (08/Ene/08)
' por el error que le dio al McPegauss
If cboConfig.Items.Count > 0 Then
cboConfig.SelectedIndex = 0
End If
If cboConfigCfg.Items.Count > 0 Then
cboConfigCfg.SelectedIndex = 0
cboConfigCfg_SelectedIndexChanged(Nothing, Nothing)
End If
End If
End Sub
Private Sub btnGuardar_Click(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles btnGuardar.Click
' Asignar estos datos al combo principal y guardarlos
' Actualizar los datos con el combo principal
Dim n As Integer = Me.cboConfig.SelectedIndex
Me.cboConfig.Items.Clear()
For i As Integer = 0 To Me.cboConfigCfg.Items.Count - 1
Dim c As LanCfg = TryCast(Me.cboConfigCfg.Items(i), LanCfg)
If c IsNot Nothing Then
Me.cboConfig.Items.Add(c)
End If
Next
If n > -1 AndAlso Me.cboConfig.Items.Count > n Then
Me.cboConfig.SelectedIndex = n
ElseIf n = -1 AndAlso Me.cboConfig.Items.Count > 0 Then
Me.cboConfig.SelectedIndex = 0
End If
guardarCfg()
Me.btnGuardar.Enabled = False
btnActualizar.Enabled = False
End Sub
Private Sub btnNuevo_Click(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles btnNuevo.Click
' Limpiar los campos para agregar un valor nuevo
' En realidad solo se borra el nombre y la IP local
Me.txtNombreCfg.Text = "config"
Me.txtNombre.Text = "LAN"
Me.txtIP.Text = ""
' Borrar todos los valores (30/Dic/07)
txtGateway.Text = ""
txtGateway.Tag = "nuevo"
txtDNS1.Text = ""
txtDNS2.Text = ""
Me.chkAutoIP.Checked = True
Me.chkAutoDNS.Checked = True
btnActualizar.Enabled = True
End Sub
Private Sub btnActualizar_Click(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles btnActualizar.Click
' Actualizar los datos de configuración
' No permitir cadenas vacias en estos tres valores
If String.IsNullOrEmpty(Me.txtNombreCfg.Text) Then
Me.txtNombreCfg.Focus()
Exit Sub
End If
If String.IsNullOrEmpty(Me.txtNombre.Text) Then
Me.txtNombre.Focus()
Exit Sub
End If
If String.IsNullOrEmpty(Me.txtIP.Text) AndAlso chkAutoIP.Checked = False Then
Me.txtIP.Focus()
Exit Sub
End If
' Si no se indican DNS, avisar de que se deben escribir (30/Dic/07)
If Me.chkAutoDNS.Checked = False Then
If String.IsNullOrEmpty(txtDNS1.Text) _
AndAlso String.IsNullOrEmpty(txtDNS1.Text) Then
txtDNS1.Focus()
Beep()
Exit Sub
End If
End If
' Se buscará entre las que haya en el combo (por el nombre)
' si no existe, se añade, si existe, se sustituye
Dim n As Integer = -1
For i As Integer = 0 To Me.cboConfig.Items.Count - 1
Dim c As LanCfg = TryCast(Me.cboConfig.Items(i), LanCfg)
If c IsNot Nothing Then
If c.NombreCfg = Me.txtNombreCfg.Text Then
n = i
Exit For
End If
End If
Next
' Detectar los errores al asignar (05/Ago/07)
Try
If n > -1 Then
' Sustituir
Dim c As LanCfg = TryCast(Me.cboConfigCfg.Items(n), LanCfg)
c.SetIPAddress(LanCfg.Propiedades.Nombre, Me.txtNombre.Text)
c.SetIPAddress(LanCfg.Propiedades.NombreCfg, Me.txtNombreCfg.Text)
' Asignar los valores para los valores auto (21/Dic/07)
c.AutoIP = chkAutoIP.Checked
c.AutoDNS = chkAutoDNS.Checked
' Solo asignar los valores si no es Auto (21/Dic/07)
If Me.chkAutoIP.Checked = False Then
c.SetIPAddress(LanCfg.Propiedades.IPLocal, Me.txtIP.Text)
c.SetIPAddress(LanCfg.Propiedades.PuertaEnlace, Me.txtGateway.Text)
Else
c.SetIPAddress(LanCfg.Propiedades.IPLocal, "")
c.SetIPAddress(LanCfg.Propiedades.PuertaEnlace, "")
End If
' FIX 23/Dic/07: Estaba sin el False: If Me.chkAutoDNS.Checked Then
If Me.chkAutoDNS.Checked = False Then
c.SetIPAddress(LanCfg.Propiedades.DNS1, Me.txtDNS1.Text)
c.SetIPAddress(LanCfg.Propiedades.DNS2, Me.txtDNS2.Text)
Else
c.SetIPAddress(LanCfg.Propiedades.DNS1, "")
c.SetIPAddress(LanCfg.Propiedades.DNS2, "")
End If
Me.cboConfigCfg.SelectedIndex = n
Else
' Crear una nueva y añadirla
Dim c As New LanCfg
With c
.Nombre = Me.txtNombre.Text
.NombreCfg = Me.txtNombreCfg.Text
' Asignar los valores para los valores auto (21/Dic/07)
.AutoIP = chkAutoIP.Checked
.AutoDNS = chkAutoDNS.Checked
' Solo asignar los valores si no es Auto (21/Dic/07)
If Me.chkAutoIP.Checked = False Then
.SetIPAddress(LanCfg.Propiedades.IPLocal, Me.txtIP.Text)
.SetIPAddress(LanCfg.Propiedades.PuertaEnlace, Me.txtGateway.Text)
Else
.SetIPAddress(LanCfg.Propiedades.IPLocal, "")
.SetIPAddress(LanCfg.Propiedades.PuertaEnlace, "")
End If
' FIX 30/Dic/07: Estaba sin el False: If Me.chkAutoDNS.Checked Then
If Me.chkAutoDNS.Checked = False Then
.SetIPAddress(LanCfg.Propiedades.DNS1, Me.txtDNS1.Text)
.SetIPAddress(LanCfg.Propiedades.DNS2, Me.txtDNS2.Text)
Else
.SetIPAddress(LanCfg.Propiedades.DNS1, "")
.SetIPAddress(LanCfg.Propiedades.DNS2, "")
End If
End With
Me.cboConfigCfg.Items.Add(c)
Me.cboConfigCfg.SelectedIndex = Me.cboConfigCfg.Items.Count - 1
End If
Catch ex As LanCfgException
Select Case ex.Source
Case LanCfg.Propiedades.IPLocal.ToString
Me.txtIP.Focus()
Case LanCfg.Propiedades.PuertaEnlace.ToString
Me.txtGateway.Focus()
Case LanCfg.Propiedades.DNS1.ToString
Me.txtDNS1.Focus()
Case LanCfg.Propiedades.DNS2.ToString
Me.txtDNS2.Focus()
'Case Else
End Select
MessageBox.Show( _
My.Resources.Resources.fLanCfgmessage2.ToString & vbCrLf & ex.Message, _
My.Resources.Resources.fLanCfgmessage3.ToString, _
MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
'"Error al asignar los valores:"
'"Error al asignar la IP"
Catch ex As Exception
MessageBox.Show( _
"Error:" & vbCrLf & ex.Message, _
"Error", _
MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
End Try
If Me.cboConfigCfg.SelectedIndex = -1 Then
Me.cboConfigCfg.SelectedIndex = 0
End If
' El botón de eliminar
Me.btnEliminar.Enabled = (Me.cboConfigCfg.Items.Count > 0)
' Habilitar el botón de guardar
Me.btnGuardar.Enabled = True
' Este botón solo habilitarlo al modificar algo (30/Dic/07)
btnActualizar.Enabled = False
End Sub
Private Sub btnEliminar_Click(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles btnEliminar.Click
' Elimnar la configuración seleccionada
Dim n As Integer = Me.cboConfigCfg.SelectedIndex
If n = -1 Then Exit Sub
Me.cboConfigCfg.Items.RemoveAt(n)
' Actualizar el combo principal
' El combo principal se asigna al pulsar en Guardar
If Me.cboConfigCfg.SelectedIndex = -1 Then
Me.cboConfigCfg.SelectedIndex = 0
End If
' Habilitar los botones
Me.btnEliminar.Enabled = (Me.cboConfigCfg.Items.Count > 0)
Me.btnGuardar.Enabled = True
End Sub
Private Sub cboConfigCfg_SelectedIndexChanged(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles cboConfigCfg.SelectedIndexChanged
' Mostrar los datos de configuración seleccionada
' (datos de configuración)
Dim n As Integer = Me.cboConfigCfg.SelectedIndex
If n = -1 Then Exit Sub
Dim c As LanCfg = TryCast(Me.cboConfigCfg.Items(n), LanCfg)
If c Is Nothing Then Exit Sub
' Quitar la marca de nuevo del gateway (si la hubiera) (30/Dic/07)
txtGateway.Tag = ""
With c
Me.txtNombre.Text = .Nombre
Me.txtNombreCfg.Text = .NombreCfg
' Asignar los valores para el DHCP (21/Dic/07)
Me.chkAutoIP.Checked = .AutoIP
Me.chkAutoDNS.Checked = .AutoDNS
If .AutoIP = False Then
Me.txtIP.Text = .IPLocal.ToString
Me.txtGateway.Text = .PuertaEnlace.ToString
'Else
' No asignar una cadena vacía (25/Dic/07)
' ' dejar lo que hubiera
' Me.txtIP.Text = ""
' Me.txtGateway.Text = ""
End If
If .AutoDNS = False Then
Me.txtDNS1.Text = .DNS1.ToString
Me.txtDNS2.Text = .DNS2.ToString
'Else
' ' No asignar una cadena vacía (25/Dic/07)
' ' dejar lo que hubiera
' Me.txtDNS1.Text = ""
' Me.txtDNS2.Text = ""
End If
chkAutoIP_CheckedChanged(Nothing, Nothing)
End With
btnActualizar.Enabled = False
End Sub
Private Sub cboConfig_SelectedIndexChanged(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles cboConfig.SelectedIndexChanged
' Mostrar los datos de la configuración seleccionada
' (datos principales)
Dim n As Integer = Me.cboConfig.SelectedIndex
If n = -1 Then Exit Sub
Dim c As LanCfg = TryCast(Me.cboConfig.Items(n), LanCfg)
If c Is Nothing Then Exit Sub
Me.LabelActual.Text = c.ToString(LanCfg.Formatos.Info)
End Sub
Private Sub fLanCfg_HelpRequested(ByVal sender As Object, _
ByVal hlpevent As HelpEventArgs) _
Handles MyBase.HelpRequested
Help.ShowHelp(Me, ficAyuda, HelpNavigator.TopicId, My.Resources.Resources.hlpGeneral)
End Sub
Private Sub GroupBox1_HelpRequested(ByVal sender As Object, _
ByVal hlpevent As HelpEventArgs) _
Handles groupBoxConfig.HelpRequested
Help.ShowHelp(Me, ficAyuda, HelpNavigator.TopicId, My.Resources.Resources.hlpConfig)
End Sub
Private Sub mnuCerrar_Click(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles mnuCerrar.Click
Me.Close()
End Sub
Private Sub mnuAyudaGeneral_Click(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles mnuAyudaGeneral.Click
Help.ShowHelp(Me, ficAyuda, HelpNavigator.TopicId, My.Resources.Resources.hlpGeneral)
End Sub
Private Sub mnuAyudaConfig_Click(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles mnuAyudaConfig.Click
Help.ShowHelp(Me, ficAyuda, HelpNavigator.TopicId, My.Resources.Resources.hlpConfig)
End Sub
Private Sub mnuAyudaActualizaciones_Click(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles mnuAyudaActualizaciones.Click
Help.ShowHelp(Me, ficAyuda, HelpNavigator.TopicId, My.Resources.Resources.hlpActualizaciones)
End Sub
Private Sub mnuAyudaBugs_Click(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles mnuAyudaBugs.Click
Help.ShowHelp(Me, ficAyuda, HelpNavigator.TopicId, My.Resources.Resources.hlpBugs)
End Sub
Private Sub mnuAcercaDe_Click(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles mnuAcercaDe.Click
My.Forms.fAcercaDe.ShowDialog()
End Sub
Private Sub actualizarIdioma(ByVal lengua As String)
iniciando = True
Thread.CurrentThread.CurrentCulture = New CultureInfo(lengua)
Thread.CurrentThread.CurrentUICulture = New CultureInfo(lengua)
Me.Controls.Clear()
InitializeComponent()
iniciando = False
txtGateway.Tag = ""
For Each item As ToolStripItem In Me.mnuIdioma.DropDownItems
If TypeOf item Is ToolStripMenuItem Then
Dim mnu As ToolStripMenuItem = TryCast(item, ToolStripMenuItem)
mnu.Checked = False
End If
Next
Select Case Microsoft.VisualBasic.Left(lengua, 2).ToLower
Case "ca"
mnuIdiomaCat.Checked = True
Case "en"
mnuIdiomaIng.Checked = True
Case "eu"
Me.mnuIdiomaVas.Checked = True
Case "gl"
Me.mnuIdiomaGallego.Checked = True
Case Else
mnuIdiomaEsp.Checked = True
End Select
My.Settings.language = lengua
' Comprobar si se está ejecutando como administrador
If m_EsAdministrador = False Then
Me.btnAplicar.Enabled = False
Me.mnuAplicar.Enabled = False
Me.statusInfo.Text = My.Resources.Resources.fLanCfgstatusinfo1 & _
My.Resources.Resources.fLanCfgstatusinfo2
Me.statusInfo.ForeColor = Color.Red
Me.statusInfo.Font = New Font(Me.statusInfo.Font, FontStyle.Bold)
Me.statusOpAdmin.Image = My.Resources.escudo16_Exclamation
Me.statusOpAdmin.ToolTipText = My.Resources.fLanCfgstatusinfo1
Else
Me.btnAplicar.Enabled = True
Me.mnuAplicar.Enabled = True
With My.Application.Info
Me.statusInfo.Text = .ProductName & " v" & .Version.ToString & " - " & _
My.Resources.Resources.fLanCfgstatusinfo3
End With
Me.statusOpAdmin.Image = My.Resources.escudo16_OK
Me.statusOpAdmin.ToolTipText = "Admin"
End If
' Leer los valores de configuración
leerCfg()
Me.btnEliminar.Enabled = (Me.cboConfigCfg.Items.Count > 0)
Me.mostrarImagenesMenus()
' Habilitar este botón solo si había datos (08/Ene/08)
Me.btnRecuperarValores.Enabled = (copiaConfiguraciones.Count > 0)
btnActualizar.Enabled = False
btnGuardar.Enabled = False
End Sub
Private Sub idiomas_Click(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles mnuIdiomaCat.Click, _
mnuIdiomaIng.Click, mnuIdiomaEsp.Click, _
mnuIdiomaVas.Click, mnuIdiomaGallego.Click
Dim lang As String
If sender Is Me.mnuIdiomaCat Then
lang = "ca-ES"
ElseIf sender Is Me.mnuIdiomaIng Then
lang = "en-US"
ElseIf sender Is Me.mnuIdiomaVas Then
lang = "eu-ES"
ElseIf sender Is Me.mnuIdiomaGallego Then
lang = "gl-ES"
Else
lang = "es-ES"
End If
actualizarIdioma(lang)
End Sub
Private Sub mostrarImagenesMenus()
asignarImagenesMenus()
End Sub
' Opciones para el DHCP (21/Dic/07)
Private Sub chkAutoIP_CheckedChanged(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles chkAutoIP.CheckedChanged
Dim b As Boolean = Not chkAutoIP.Checked
txtIP.Enabled = b
txtGateway.Enabled = b
' si no se usa la IP automática, no se puede asignar el DNS auto
If b Then
chkAutoDNS.Checked = False
chkAutoDNS.Enabled = False
Else
chkAutoDNS.Enabled = True
End If
btnActualizar.Enabled = True
End Sub
Private Sub chkAutoDNS_CheckedChanged(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles chkAutoDNS.CheckedChanged
Dim b As Boolean = Not chkAutoDNS.Checked
txtDNS1.Enabled = b
txtDNS2.Enabled = b
btnActualizar.Enabled = True
End Sub
''' <summary>
''' Devuelve el nombre del fichero de configuración
''' según la opción seleccionada en el menú
''' </summary>
''' <param name="asignarMenus">
''' Opcional, para indicar si se asignan los valores a los menús
''' (por defecto es True).
''' Indicar False para que no se muestre el formulario
''' (si se inicia desde la línea de comandos)
''' </param>
''' <returns></returns>
''' <remarks>
''' 23/Dic/07
''' </remarks>
Private Function ficheroCfg(Optional ByVal asignarMenus As Boolean = True) As String
Dim fic As String
Dim dirCfg As String
' Para guardar el fichero en el directorio del ejecutable
With My.Application.Info
If My.Settings.usarMisDocumentos Then
' Mis Documentos\<aplicacion>
dirCfg = My.Computer.FileSystem.SpecialDirectories.MyDocuments & "\" & .ProductName
If My.Computer.FileSystem.DirectoryExists(dirCfg) = False Then
My.Computer.FileSystem.CreateDirectory(dirCfg)
End If
ElseIf My.Settings.usarDirPersonalizado Then
dirCfg = My.Settings.dirConfig
If String.IsNullOrEmpty(dirCfg) Then
dirCfg = My.Computer.FileSystem.SpecialDirectories.MyDocuments
End If
If dirCfg.ToLower().Contains(My.Application.Info.ProductName.ToLower()) = False Then
dirCfg = Path.Combine(dirCfg, My.Application.Info.ProductName)
End If
Try
If My.Computer.FileSystem.DirectoryExists(dirCfg) = False Then
My.Computer.FileSystem.CreateDirectory(dirCfg)
End If
Catch ex As Exception
' Si da error al crear el path indicado, usar el del programa
dirCfg = .DirectoryPath
My.Settings.usarDirPrograma = True
My.Settings.usarDirPersonalizado = False
My.Settings.usarMisDocumentos = False
End Try
Else
dirCfg = .DirectoryPath
End If
fic = dirCfg & "\" & .ProductName & ".cfg"
End With
' Asignar los valores de la configuración
My.Settings.dirConfig = dirCfg
Return fic
End Function
Private Sub timerArgs_Tick(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles timerArgs.Tick
' Detener el timer, solo lo queremos para lanzar el método (23/Dic/07)
timerArgs.Stop()
lineaComandos()
End Sub
Private Sub mnuFicPersonalizar_Click(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles mnuFicPersonalizar.Click
' Cerrarlo para que se inicie bien
' (no ponerlo dentro del With que hay más abajo,
' ya que daría error al llamar a ShowDialog)
My.Forms.fLanCfg_config.Close()
With My.Forms.fLanCfg_config
If .ShowDialog(Me) = Windows.Forms.DialogResult.OK Then
' Al aceptar se guardan los datos de configuración
' Asegurarse de mostrar las imágenes indicadas
My.Settings.Save()
asignarImagenesMenus()
' Asignar las configuraciones obtenidas (30/Dic/07)
' (si hay)
If .lvConfigs.CheckedItems.Count > 0 Then
For Each lvi As ListViewItem In .lvConfigs.CheckedItems
Dim c As LanCfg = TryCast(lvi.Tag, LanCfg)
If c IsNot Nothing Then
Me.cboConfigCfg.Items.Add(c)
Me.cboConfigCfg.SelectedIndex = Me.cboConfigCfg.Items.Count - 1
End If
Next
Me.btnGuardar.Enabled = True
End If
End If
End With
End Sub
Private Sub asignarImagenesMenus()
With My.Forms.fLanCfg_config
If My.Settings.mostrarImagenesTodos Then
' La de los idiomas
Me.mnuIdiomaEsp.Image = My.Resources.es
Me.mnuIdiomaCat.Image = My.Resources.catalunya
Me.mnuIdiomaVas.Image = My.Resources.euskadi
Me.mnuIdiomaIng.Image = My.Resources.us
Me.mnuIdiomaGallego.Image = My.Resources.galicia
If My.Settings.tipoImagenesMenus = 2 Then
Me.mnuAcercaDe.Image = .opcAcerca.DropDownItems(My.Settings.imgAcerca).Image
Me.mnuAplicar.Image = .opcAplicar.DropDownItems(My.Settings.imgAplicar).Image
Me.mnuAyuda.Image = .opcAyuda.DropDownItems(My.Settings.imgAyuda).Image
Me.mnuCerrar.Image = .opcCerrar.DropDownItems(My.Settings.imgCerrar).Image
Me.mnuFic.Image = .opcFichero.DropDownItems(My.Settings.imgFichero).Image
Me.mnuAyudaGeneral.Image = .opcGeneral.DropDownItems(My.Settings.imgGeneral).Image
Me.mnuFicPersonalizar.Image = .opcPersonalizar.DropDownItems(My.Settings.imgPersonalizar).Image
Me.mnuIdioma.Image = .opcIdioma.DropDownItems(My.Settings.imgIdioma).Image
ElseIf My.Settings.tipoImagenesMenus = 0 Then ' Juansa
Me.mnuAcercaDe.Image = .opcAcerca.DropDownItems(0).Image
Me.mnuAplicar.Image = .opcAplicar.DropDownItems(0).Image
Me.mnuAyuda.Image = .opcAyuda.DropDownItems(0).Image
Me.mnuCerrar.Image = .opcCerrar.DropDownItems(0).Image
Me.mnuFic.Image = .opcFichero.DropDownItems(0).Image
Me.mnuAyudaGeneral.Image = .opcGeneral.DropDownItems(0).Image
Me.mnuFicPersonalizar.Image = .opcPersonalizar.DropDownItems(0).Image
Me.mnuIdioma.Image = .opcIdioma.DropDownItems(0).Image
ElseIf My.Settings.tipoImagenesMenus = 1 Then ' Guille
Me.mnuAcercaDe.Image = .opcAcerca.DropDownItems(1).Image
Me.mnuAplicar.Image = .opcAplicar.DropDownItems(1).Image
Me.mnuAyuda.Image = .opcAyuda.DropDownItems(1).Image
Me.mnuCerrar.Image = .opcCerrar.DropDownItems(1).Image
Me.mnuFic.Image = .opcFichero.DropDownItems(1).Image
Me.mnuAyudaGeneral.Image = .opcGeneral.DropDownItems(1).Image
Me.mnuFicPersonalizar.Image = .opcPersonalizar.DropDownItems(1).Image
Me.mnuIdioma.Image = .opcIdioma.DropDownItems(1).Image
End If
If My.Settings.mostrarImagenesMenus = False Then
Me.mnuAyuda.Image = Nothing
Me.mnuFic.Image = Nothing
Me.mnuIdioma.Image = Nothing
End If
Else
' Quitar las imágenes
My.Settings.mostrarImagenesMenus = False
Me.mnuAcercaDe.Image = Nothing
Me.mnuAplicar.Image = Nothing
Me.mnuAyuda.Image = Nothing
Me.mnuCerrar.Image = Nothing
Me.mnuFic.Image = Nothing
Me.mnuAyudaGeneral.Image = Nothing
Me.mnuFicPersonalizar.Image = Nothing
Me.mnuIdioma.Image = Nothing
' Las de los idiomas
For Each mni As ToolStripItem In Me.mnuIdioma.DropDownItems
mni.Image = Nothing
Next
End If
End With
End Sub
Private Sub txtNombreCfg_TextChanged(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles txtNombreCfg.TextChanged
btnActualizar.Enabled = True
End Sub
Private Sub txtNombre_TextChanged(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles txtNombre.TextChanged
btnActualizar.Enabled = True
End Sub
Private Sub txtIP_TextChanged(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles txtIP.TextChanged
If iniciando Then Exit Sub
btnActualizar.Enabled = True
' Si el gateway está en blanco (30/Dic/07)
' asignar la misma IP que la Ip pero añadiendo 1 al final
If String.IsNullOrEmpty(txtIP.Text) = False _
AndAlso txtGateway.Tag.ToString = gatewayNuevo Then
' Asignar automáticamente el último valor de la IP
Dim valores() As String = _
txtIP.Text.Split(".".ToCharArray, StringSplitOptions.RemoveEmptyEntries)
Dim sb As New System.Text.StringBuilder
For i As Integer = 0 To valores.Length - 2
sb.Append(valores(i))
sb.Append(".")
Next
sb.Append("1")
txtGateway.Text = sb.ToString
End If
End Sub
Private Sub txtGateway_TextChanged(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles txtGateway.TextChanged
If iniciando Then Exit Sub
btnActualizar.Enabled = True
' Si se borra todo el contenido de este texto (30/Dic/07)
' indicar que es nuevo, pero no asignar los valores
' esto solo se hará si se modifica la IP.
If String.IsNullOrEmpty(txtGateway.Text) Then
txtGateway.Tag = gatewayNuevo
End If
End Sub
Private Sub txtDNS1_TextChanged(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles txtDNS1.TextChanged
btnActualizar.Enabled = True
End Sub
Private Sub txtDNS2_TextChanged(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles txtDNS2.TextChanged
btnActualizar.Enabled = True
End Sub
Private Sub LabelActual_TextChanged(ByVal sender As Object, _
ByVal e As EventArgs) _
Handles LabelActual.TextChanged
If Me.iniciando Then Exit Sub
toolTip1.SetToolTip(LabelActual, " " & LabelActual.Text & " ")
End Sub
End Class
Espero que te sea de utilidad.
Nos vemos.
Guillermo