Ofertas de alojamiento 



Donativo para el sitio de elGuille

Buscar en Google y en elGuille.info:
Búsqueda personalizada

Código fuente de LanConfig 2008

El formulario Acerca de (fAcercaDe)

 
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 del formulario Acerca de (fAcercaDe).



 

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.

 

'------------------------------------------------------------------------------
' Formulario Acerca de "el Guille"                                  (12/Jul/06)
' Adaptado del AcercaDe del visor de imágenes.
'
' Revisión del 23/Dic/07: Mensajes en el idioma correspondiente
'
' ©Guillermo 'guille' Som, 2006-2008
'------------------------------------------------------------------------------
Option Explicit On
Option Strict On

Imports Microsoft.VisualBasic
Imports vb = Microsoft.VisualBasic
Imports System
Imports System.Windows.Forms
Imports System.Drawing

Imports clickOnce = System.Deployment
Imports System.Text.RegularExpressions

Public Class fAcercaDe
    '
    Const laUrl As String = "http://www.elguille.info/NET/vs2008/utilidades/LanConfig2008.aspx"
    ' Para mover la ventana
    Private ratonPulsado As Boolean
    Private pX, pY As Integer
    Private bugInfo As String
    Private fvi As System.Diagnostics.FileVersionInfo

    Private Sub fAcercaDe_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
        ' Asignar directamente los valores del idioma actual        (23/Dic/07)
        ' (no se ha creado el formulario como multilanguage)
        btnAceptar.Text = My.Resources.fAcercaDeAceptar
        linkBug.Text = My.Resources.fAcercaDeLinkBug
        ToolTip1.SetToolTip(linkBug, " " & My.Resources.fAcercaDeLinkBugTool & " ")

        ' Título de la aplicación
        ' Usar el nombre del producto
        If My.Application.Info.ProductName <> "" Then
            labelTitulo.Text = My.Application.Info.ProductName
        Else
            ' Si falta el título de la aplicación, utilice el nombre de la aplicación sin la extensión
            labelTitulo.Text = System.IO.Path.GetFileNameWithoutExtension(My.Application.Info.AssemblyName)
        End If

        Dim ensamblado As System.Reflection.Assembly = System.Reflection.Assembly.GetExecutingAssembly
        fvi = System.Diagnostics.FileVersionInfo.GetVersionInfo(ensamblado.Location)
        bugInfo = labelTitulo.Text & " v" & fvi.FileVersion

        ' Información de Copyright
        labelAutor.Text = My.Application.Info.Copyright

        labelDescripcion.Text = labelTitulo.Text & _
                        " v" & My.Application.Info.Version.ToString() & _
                        " (" & fvi.FileVersion & ")" & vbCrLf & vbCrLf & _
                        My.Resources.AssemblyDescription.Replace("  ", vbCrLf) & _
                            fLanCfg.FechaRevision & vbCrLf & vbCrLf & _
                        My.Resources.AssemblyTitle & vbCrLf & vbCrLf & _
                        My.Application.Info.Trademark.Replace("  ", vbCrLf)

        Me.labelWeb.Text = My.Resources.fAcercaDeComprobando
        timerWeb.Enabled = True
    End Sub

    Private Sub pMouseDown(ByVal sender As Object, _
                           ByVal e As MouseEventArgs) _
                           Handles Me.MouseDown, TableLayoutPanel1.MouseDown, _
                                   labelTitulo.MouseDown, labelDescripcion.MouseDown, _
                                   labelAutor.MouseDown
        ' Mover el formulario mientras se mantenga el ratón pulsado
        ratonPulsado = True
        pX = e.X
        pY = e.Y
    End Sub

    Private Sub pMouseMove(ByVal sender As Object, _
                           ByVal e As MouseEventArgs) _
                           Handles Me.MouseMove, TableLayoutPanel1.MouseMove, _
                                   labelTitulo.MouseMove, labelDescripcion.MouseMove, _
                                   labelAutor.MouseMove
        If ratonPulsado Then
            Me.Left += e.X - pX
            Me.Top += e.Y - pY
        End If
    End Sub

    Private Sub pMouseUp(ByVal sender As Object, _
                         ByVal e As MouseEventArgs) _
                         Handles Me.MouseUp, TableLayoutPanel1.MouseUp, _
                                 labelTitulo.MouseUp, labelDescripcion.MouseUp, _
                                 labelAutor.MouseUp
        ratonPulsado = False
    End Sub

    Private Sub LinkURL_LinkClicked(ByVal sender As Object, _
                                    ByVal e As LinkLabelLinkClickedEventArgs) _
                                    Handles linkURL.LinkClicked
        ' Comprobar si tenemos conexión a Internet                  (26/Abr/06)
        ' Aunque podemos tener conexión a la red, pero no a Internet.
        If My.Computer.Network.IsAvailable Then
            System.Diagnostics.Process.Start(linkURL.Text)
        End If
    End Sub

    Private Sub btnAceptar_Click(ByVal sender As Object, ByVal e As EventArgs) Handles btnAceptar.Click
        Me.Close()
    End Sub

    Private Sub linkBug_LinkClicked(ByVal sender As Object, _
                                    ByVal e As LinkLabelLinkClickedEventArgs) _
                                    Handles linkBug.LinkClicked
        ' Enviar un bug o mejora                                    (13/Jul/06)
        If My.Computer.Network.IsAvailable Then
            Dim sb As New System.Text.StringBuilder
            sb.AppendFormat("http://www.elguille.info/elguille_bugsmejoras.asp?subject=Bug o mejora en {0}", _
                            bugInfo)
            System.Diagnostics.Process.Start(sb.ToString)
        End If
    End Sub

    Private Function versionWeb() As String
        Try
            Dim request As System.Net.WebRequest = System.Net.WebRequest.Create(laUrl)
            Dim response As System.Net.WebResponse
            Dim reader As System.IO.StreamReader
            ' Obtener la respuesta.
            response = request.GetResponse()
            ' Abrir el stream de la respuesta recibida.
            reader = New System.IO.StreamReader(response.GetResponseStream())
            ' Leer el contenido.
            Dim s As String = reader.ReadToEnd()
            ' Cerrar los streams abiertos.
            reader.Close()
            response.Close()

            ' Comprobar el valor de <meta name="version" 
            ' En Groups(1) estará la versión
            ' Comprobar que haya más de una cifra                   (14/Abr/07)
            ' Tener en cuenta que se pueda usar en el formato > y /> (con o sin espacio)
            Dim r As New Regex("<meta name=""version"" content=""(\d{1,}.\d{1,}.\d{1,}.\d{1,})""\s?/?>")
            For Each m As Match In r.Matches(s)
                If m.Groups.Count > 1 Then
                    Return m.Groups(1).Value
                End If
            Next
        Catch 'ex As Exception
            Return ""
        End Try
        Return ""
    End Function

    Private Sub timerWeb_Tick(ByVal sender As Object, _
                              ByVal e As EventArgs) _
                              Handles timerWeb.Tick
        timerWeb.Enabled = False

        Dim sb As New System.Text.StringBuilder
        If clickOnce.Application.ApplicationDeployment.IsNetworkDeployed Then
            sb.Append(My.Resources.fAcercaDeClickOnce)
            sb.AppendLine()
            Dim inf As clickOnce.Application.UpdateCheckInfo
            inf = My.Application.Deployment.CheckForDetailedUpdate
            If inf.UpdateAvailable Then
                sb.AppendFormat("{0}: v{1}", My.Resources.fAcercaDeNueva, inf.AvailableVersion.ToString)
            Else
                sb.Append(My.Resources.fAcercaDeMasReciente)
            End If
        Else
            sb.Append(My.Resources.fAcercaDeNoClickOnce)
            sb.AppendLine()
            Dim vWeb As String = versionWeb()
            ' Por si no lee bien la versión                         (14/Abr/07)
            If String.IsNullOrEmpty(vWeb) Then
                vWeb = "0.0.0.0"
            End If
            ' Para comprobar mejor las versiones de la Web          (14/Abr/07)
            ' (del AcercaDe usado en colorear código)
            ' Solo funcionará bien con valores de 1 cifra           (14/Feb/07)
            ' ya que 1.0.3.11 será menor que 1.0.3.9 aunque no sea así...
            ' Convertirlo en cadena de números de dos cifras
            Dim aWeb() As String = vWeb.Split("."c)
            Dim aFic() As String = fvi.FileVersion.Split("."c)
            Dim wMayor As Boolean = False
            vWeb = ""
            Dim sFic As String = ""
            For i As Integer = 0 To aWeb.Length - 1
                vWeb &= CInt(aWeb(i)).ToString("00") & "."
            Next
            For i As Integer = 0 To aFic.Length - 1
                sFic &= CInt(aFic(i)).ToString("00") & "."
            Next
            If vWeb > sFic Then ' fvi.FileVersion Then
                sb.AppendFormat("{0} v{1}", My.Resources.fAcercaDeAppDisp, vWeb)
            Else
                sb.Append(My.Resources.fAcercaDeMasReciente)
            End If
        End If

        Me.labelWeb.Text = sb.ToString
    End Sub
End Class

 

Espero que te sea de utilidad.

Nos vemos.
Guillermo

 


 


Cosas que te pueden interesar



Mentor de
SolidQ
Most Valuable Professional
MVP de .NET (antes Visual Basic)
de octubre de 1997 a septiembre de 2015



Orador internacional de Ineta
Orador de Ineta Latam

ir al índice del Guille


Escribir un mensaje al Guille (mensaje EN elGuille.info)
Has entrado usando el host: www.mundoprogramacion.com
Puedes verlo también en: http://www.elguille.info/net/vs2008/utilidades/lanconfig2008_facercade_vb.aspx