Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)

[Eleкtro]

No importa la versión de Visual Studio

En realidad si que importa. Cada nueva versión de Visual Studio añade modificaciones mejoradas en el empleo de sintaxis de C#/VB.NET. Dichas mejores evidentemente son incompatibles en versiones anteriores de Visual Studio.

Por ejemplo en VB.NET 14.0 (Visual Studio 2015) se pueden especificar strings multi linea lieterales, mientras que en las versioens anteriores de VB.NET, no.

VB.NET 14.0:

Código (vbnet) [Seleccionar] Expandir

       Dim json = "{
 'Name': 'Bad Boys',
 'ReleaseDate': '1995-4-7T00:00:00',
 'Genres': ['Action','Comedy']
}"

El codigo de arriba daria error de compilación en versiones anteriores de VB.NET/VS. Habría que hacerlo más o menos así:

Código (vbnet) [Seleccionar] Expandir

       Dim json = "{" & Environment.NewLine &
"  'Name': 'Bad Boys'," & Environment.NewLine &
"  'ReleaseDate': '1995-4-7T00:00:00'," & Environment.NewLine &
"  'Genres': ['Action','Comedy']" & Environment.NewLine &
"}"

Los snippets que compartí en este hilo fueron desarrollados bajo VS2013, y algunos en VS2015.

PD: Como ya dije, C# también tiene sus mejoras.

¡Saludos!

[Eleкtro]

Hace mucho tiempo que no publico nada aquí...

Vamos allá:



¿Cómo validar el número de una tarjeta de crédito?

Para ello podemos implementar el algoritmo Luhn.

Código (vbnet) [Seleccionar] Expandir

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Uses the Luhn algorithm to determines whether the specified credit card number is valid.
''' <para></para>
''' Please de aware that not all valid credit cards can be verified with the Luhn algorithm because
''' it not covers all range of card numbers, however the Luhn algorithm does work for many, if not most, major credit cards.
''' <para></para>
''' The Luhn algorithm is simply used to prevent transpositional errors,
''' it is useful as a sanity check prior to submitting card numbers to a payment gateway,
''' but not suitable to absolutely validate whether a number is a valid card number.
''' <para></para>
''' The only way to absolutely verify a credit card number is to validate it via a payment gateway.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <remarks>
''' Luhn algorithm: <see href="https://en.wikipedia.org/wiki/Luhn_algorithm"/>
''' <para></para>
''' Microsoft's Luhn algorithm implementation: <see href="http://referencesource.microsoft.com/#System.ComponentModel.DataAnnotations/DataAnnotations/CreditCardAttribute.cs"/>
''' <para></para>
''' Credits to: <see href="http://www.vcskicks.com/credit-card-verification.php"/>
''' </remarks>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim visaNumber As String = "4012888888881881"
''' Dim isValid As Boolean = ValidateCreditCardNumber(visaNumber)
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="cardNumber">
''' The credit card number.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' <see langword="True"/> if the specified card number is a valid card number; otherwise, <see langword="False"/>.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
Public Shared Function ValidateCreditCardNumber(ByVal cardNumber As String) As Boolean

   cardNumber = cardNumber.Replace(" ", "").Replace("-", "").Trim()

   ' FIRST STEP: Double each digit starting from the right
   Dim doubledDigits As Integer() = New Integer(cardNumber.Length / 2 - 1) {}
   Dim k As Integer = 0
   For i As Integer = cardNumber.Length - 2 To 0 Step -2
       Dim digit As Integer
       If Not Integer.TryParse(cardNumber(i), digit) Then
           Return False
       End If
       doubledDigits(k) = digit * 2
       k += 1
   Next i

   ' SECOND STEP: Add up separate digits
   Dim total As Integer = 0
   For Each i As Integer In doubledDigits
       Dim number As String = i.ToString()
       For j As Integer = 0 To (number.Length - 1)
           total += Integer.Parse(number(j).ToString())
       Next j
   Next i

   ' THIRD STEP: Add up other digits
   Dim total2 As Integer = 0
   For i As Integer = cardNumber.Length - 1 To 0 Step -2
       Dim digit As Integer = Integer.Parse(cardNumber(i).ToString())
       total2 += digit
   Next i

   ' FOURTH STEP: Total
   Dim final As Integer = (total + total2)

   Return (final Mod 10 = 0) ' Well formed will divide evenly by 10.

End Function

Modo de empleo:

Código (vbnet) [Seleccionar] Expandir

' http://www.paypalobjects.com/en_US/vhelp/paypalmanager_help/credit_card_numbers.htm
Dim visaNumber As String = "4012888888881881"
Dim isValid As Boolean = ValidateCreditCardNumber(visaNumber)

Aquí les dejo unos números de tarjetas de crédito para testear:

Código (vbnet) [Seleccionar] Expandir

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Contains a collection of credit card numbers for testing purposes.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <remarks>
''' <see href="http://www.paypalobjects.com/en_US/vhelp/paypalmanager_help/credit_card_numbers.htm"/>
''' </remarks>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' For Each card As KeyValuePair(Of String, String()) In CreditCardsTestNumbers
'''     For Each cardnumber As String In card.Value
'''         Dim isValidNumber As Boolean = ValidateCreditCardNumber(cardnumber)
'''         Console.WriteLine("Card type: '{0}'; Number: '{1}'; Is Valid?: {2}", card.Key, cardnumber, isValidNumber)
'''     Next cardnumber
''' Next card
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
Public Shared ReadOnly CreditCardsTestNumbers As New Dictionary(Of String, String())(StringComparison.OrdinalIgnoreCase) From {
   {"American Express", {"378282246310005", "371449635398431"}},
   {"American Express Corporate", {"378734493671000"}},
   {"Australian BankCard", {"5610591081018250"}},
   {"Dankort (PBS)", {"5019717010103742", "76009244561"}},
   {"Diners Club", {"30569309025904", "38520000023237"}},
   {"Discover", {"6011111111111117", "6011000990139424"}},
   {"JCB", {"3530111333300000", "3566002020360505"}},
   {"Mastercard", {"5555555555554444", "5105105105105100"}},
   {"Switch/Solo (Paymentech)", {"6331101999990016"}},
   {"VISA", {"4111111111111111", "4012888888881881", "4222222222222"}}
}



¿Cómo auto-eliminar el executable de nuestra aplicación?

Para ello podemos escribir las instrucciones de eliminación en un archivo.bat externo, e iniciarlo.

¿Por qué Batch?, bueno, en un principio podriamos pensar en una solución usando puro código .NET por ejemplo compilando un código fuente en tiempo de ejecución para generar un executable de .NET temporal con las instrucciones de terminación del proceso y de eliminación del archivo, pero al hacer esto nos estaríamos metiendo en un círculo vicioso ya que el executable externo no se podría eliminar a si mismo, por ende, esta es una de las pocas ocasiones en las que Batch sirve para salvarnos de un apuro.

Código (vbnet) [Seleccionar] Expandir

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Deletes the self application executable file.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
Public Shared Sub DeleteSelfApplication()
   DeleteSelfApplication(TimeSpan.FromMilliseconds(0))
End Sub

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Deletes the self application executable file.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <param name="delay">
''' A delay interval to wait (asynchronously) before proceeding to automatic deletion.
''' </param>
''' ----------------------------------------------------------------------------------------------------
Public Shared Async Sub DeleteSelfApplication(ByVal delay As TimeSpan)

   If (delay.TotalMilliseconds > 0.0R) Then
       Dim t As New Task(Sub() Thread.Sleep(delay))
       t.Start()
       Await t
   End If

   Dim script As String = <a>
@Echo OFF
   
Set "exeName=%~nx1"
Set "exePath=%~f1"

:KillProcessAndDeleteExe
(TaskKill.exe /F /IM "%exeName%")1>NUL 2>&amp;1
If NOT Exist "%exePath%" (GoTo :SelfDelete)
(DEL /Q /F "%exePath%") || (GoTo :KillProcessAndDeleteExe)

:SelfDelete
(DEL /Q /F "%~f0")
</a>.Value

   Dim tmpFile As New FileInfo(Path.Combine(Path.GetTempPath, Path.GetTempFileName))
   tmpFile.MoveTo(Path.Combine(tmpFile.DirectoryName, tmpFile.Name & ".cmd"))
   tmpFile.Refresh()
   File.WriteAllText(tmpFile.FullName, script, Encoding.Default)

   Using p As New Process()
       With p.StartInfo
           .FileName = tmpFile.FullName
           .Arguments = String.Format(" ""{0}"" ", Application.ExecutablePath)
           .WindowStyle = ProcessWindowStyle.Hidden
           .CreateNoWindow = True
       End With
       p.Start()
       p.WaitForExit(0)
   End Using

   Environment.Exit(0)

End Sub

Modo de empleo:

Código (vbnet) [Seleccionar] Expandir

' Auto destruir el executable al instante:
DeleteSelfApplication()

' Auto destruir el executable de forma asincrónica con un tiempo de espera de 5 segundos:
DeleteSelfApplication(TimeSpan.FromSeconds(5))

El contenido del archivo.bat generado sería el siguiente:

Código (dos) [Seleccionar] Expandir

@Echo OFF

Set "exeName=%~nx1"
Set "exePath=%~f1"

:KillProcessAndDeleteExe
(TaskKill.exe /F /IM "%exeName%")1>NUL 2>&1
If NOT Exist "%exePath%" (GoTo :SelfDelete)
(DEL /Q /F "%exePath%") || (GoTo :KillProcessAndDeleteExe)

:SelfDelete
(DEL /Q /F "%~f0")
...Lo primero que hará el script será entrar en un búcle infinito donde se intentará matar el proceso, y una vez conseguido se dispondrá a eliminar el archivo, y por último eliminarse a sí mismo.



¿Cómo guardar y restaurar el estado expandido/colapsado de los nodos de un TreeView?

Pongámonos en situación, imaginemos que tenemos un control de tipo TreeView en el que tenemos que crear y destruir algunos de sus nodos o todos ellos de forma dinámica, y al hacerlo perderiamos el estado expandido/colapsado de cada nodo al refrescar la lista de nodos.

U otra situación distinta, en la que simplemente quisieramos guardar el estado del TreeView al cerrar la aplicación, para cargar ese estado en el próximo inicio de la aplicación.

Bien, pues para solucionar ese tipo de problema primero crearíamos la siguiente función que nos devolverá una lista con todos los nodos y sus nodos hijos de un TreeView:

Código (vbnet) [Seleccionar] Expandir

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Gets all the parent nodes and all its child nodes in the source <see cref="TreeView"/>.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim nodeList As List(Of TreeNode) = Me.TreeView1.GetAllNodesAndChildnodes()
'''
''' For Each node As TreeNode In nodeList
'''     ' ...
''' Next node
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="sender">
''' The source <see cref="TreeView"/>.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' A <see cref="List(Of TreeNode)"/> containing all the parent nodes and all its child nodes.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
Public Shared Function GetAllNodesAndChildnodes(ByVal sender As TreeView) As List(Of TreeNode)

   Dim nodes As New List(Of TreeNode)
   Dim stack As New Stack(Of TreeNode)

   ' Bang all the top nodes into the queue.
   For Each top As TreeNode In sender.Nodes
       stack.Push(top)
   Next

   While (stack.Count > 0)
       Dim node As TreeNode = stack.Pop()
       If (node IsNot Nothing) Then
           ' Add the node to the list of nodes.
           nodes.Add(node)

           If (node.Nodes IsNot Nothing) And (node.Nodes.Count > 0) Then
               ' Enqueue the child nodes.
               For Each child As TreeNode In node.Nodes
                   stack.Push(child)
               Next child
           End If
       End If
   End While

   stack.Clear()
   stack = Nothing
   Return nodes

End Function

Ahora solo tenemos que crear una función para iterar los nodos obtenidos y así crear un "estado de guardado" (o save state), el cual consistitía en un diccionario que contendrá el código hash identificador de cada nodo, y un valor boolean indicando si el nodo está expandido o colapsado.

Código (vbnet) [Seleccionar] Expandir

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Saves the state of the source <see cref="TreeView"/> into a <see cref="Dictionary(Of Integer, Boolean)"/>
''' containing the hash code of each node and its expansion state.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim saveState As Dictionary(Of Integer, Boolean) = Me.TreeView1.SaveTreeState()
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="sender">
''' The source <see cref="TreeView"/>.
''' </param>
''' ---------------------------------------------------------------------------------------------------
''' <returns>
''' A <see cref="Dictionary(Of Integer, Boolean)"/> containing the hash code of each node and its expansion state.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
Public Shared Function SaveTreeState(ByVal sender As TreeView) As Dictionary(Of Integer, Boolean)

   Dim nodeList As List(Of TreeNode) = GetAllNodesAndChildnodes(sender)
   Dim nodeStates As New Dictionary(Of Integer, Boolean)()

   For Each node As TreeNode In nodeList
       nodeStates.Add(node.GetHashCode(), node.IsExpanded)
   Next

   Return nodeStates

End Function

Y por último la función para restaurar un estado de guardado:

Código (vbnet) [Seleccionar] Expandir

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Restores a state of the source <see cref="TreeView"/> previously saved using the <see cref="SaveTreeState"/> function.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim saveState As Dictionary(Of Integer, Boolean)
'''
''' Private Sub Button_SaveTreeState(sender As Object, e As EventArgs) Handles Button_SaveTreeState.Click
'''     saveState = Me.TreeView1.SaveTreeState()
''' End Sub
'''
''' Private Sub Button_RestoreTreeState(sender As Object, e As EventArgs) Handles Button_RestoreTreeState.Click
'''     Me.TreeView1.RestoreTreeState(saveState)
''' End Sub
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="sender">
''' The source <see cref="TreeView"/>.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <param name="saveState">
''' A <see cref="Dictionary(Of Integer, Boolean)"/> containing the hash code of each node and its expansion state.
''' </param>
''' ----------------------------------------------------------------------------------------------------
Public Shared Sub RestoreTreeState(ByVal sender As TreeView, ByVal saveState As Dictionary(Of Integer, Boolean))

   Dim nodeList As List(Of TreeNode) = GetAllNodesAndChildnodes(sender)

   For Each node As TreeNode In nodeList

       Dim hash As Integer = node.GetHashCode()

       If saveState.ContainsKey(hash) Then

           If saveState(hash) Then
               node.Expand()
           Else
               node.Collapse()
           End If

       End If

   Next

End Sub



Todas estas funcionalidades y muchísimas más las podrán encontrar en mi Framework de pago ElektroKit.

[Eleкtro]

¿Cómo determinar cual es la versión más reciente instalada de .NET Framework en la máquina actual?.

Aquí les dejo el código fuente completo:

Código (vbnet) [Seleccionar] Expandir

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Determines which is the most recent version of the .NET Framework runtimes installed on the current machine.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim frameworkVersion As Version = GetMostRecentInstalledFrameworkVersion()
''' Console.WriteLine(frameworkVersion.ToString())
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <remarks>
''' Credits to Microsoft: <see href="http://msdn.microsoft.com/en-us/library/hh925568(v=vs.110).aspx"/>
''' </remarks>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The resulting .NET Framework <see cref="Version"/>.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepperBoundary>
Private Shared Function GetMostRecentInstalledFrameworkVersion() As Version

   ' .NET 4.5, 4.5.1, 4.5.2, 4.6, 4.6.1
   Using ndpKey As RegistryKey =
       RegistryKey.OpenBaseKey(RegistryHive.LocalMachine, RegistryView.Registry32).
                   OpenSubKey("SOFTWARE\Microsoft\NET Framework Setup\NDP\v4\Full\", writable:=False)

       If (ndpKey IsNot Nothing) AndAlso (ndpKey.GetValue("Release") IsNot Nothing) Then
           Dim releaseVersion As Integer = CInt(ndpKey.GetValue("Release"))
           Select Case releaseVersion
               Case >= 394254
                   Return New Version(4, 6, 1)
               Case >= 393295
                   Return New Version(4, 6)
               Case >= 379893
                   Return New Version(4, 5, 2)
               Case >= 378675
                   Return New Version(4, 5, 1)
               Case >= 378389
                   Return New Version(4, 5)
           End Select
       End If
   End Using

   ' .NET 1.0, 2.0, 3.0, 3.5, 4.0
   Using ndpKey As RegistryKey =
       RegistryKey.OpenRemoteBaseKey(RegistryHive.LocalMachine, "").
                   OpenSubKey("SOFTWARE\Microsoft\NET Framework Setup\NDP\", writable:=False)

       For Each versionKeyName As String In ndpKey.GetSubKeyNames().OrderByDescending(Function(x As String) x)
           If versionKeyName.ToLower().StartsWith("v") Then
               Return New Version(versionKeyName.ToLower().TrimStart("v"c))
           End If
       Next versionKeyName
   End Using

   Return New Version()

End Function

Personálmente recomiendo decorar esta funcionalidad mediante una propiedad de sólo lectura, tal que así:

Código (vbnet) [Seleccionar] Expandir

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Gets a value that determines which is the most recent version of the .NET Framework runtimes installed
''' on the current machine.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <value>
''' A value that determines which is the most recent version of the .NET Framework runtimes installed
''' on the current machine.
''' </value>
''' ----------------------------------------------------------------------------------------------------
Public Shared ReadOnly Property MostRecentInstalledFrameworkVersion As Version
   <DebuggerStepThrough>
   Get
       Return GetMostRecentInstalledFrameworkVersion()
   End Get
End Property

Modo de empleo:

Código (vbnet) [Seleccionar] Expandir

Dim frameworkVersion As Version = GetMostRecentInstalledFrameworkVersion()
Console.WriteLine(frameworkVersion.ToString())

Notas: Faltaría implementar la versión de .NET 4.6.2. Aparte de eso no he podio testear en profundidad el resultado obtenido en un equipo que tenga instalado .NET 1.0, 2.0, 3.0, 3.5 o 4.0, si encuentran algún error diganmelo.



Códigos de error Win32.

Esto que voy a compartir a continuación es una enumeración con todos los errores Win32 de la API de Windows, en total son +13.000 lineas de código, así que os dejo un enlace externo:

• https://paste.ee/p/zr1gk

El propósito de gigantesca enumeración es proveer una manera sencilla, directa y eficiente de determinar que error nos devuelve en ocasiones una función de la API de Windows y cual es el significado de dicho código de error.

No confundir un código de error Win32 con un código de error H_RESULT, esto último define muchos errores Win32 pero con otros valores.

Recordad que la librería de clases de .NET Framework expone algunos miembros muy útiles para la evaluación de errores de funciones no administradas, Marshal.GetLastWin32Error(), Marshal.GetHRForLastWin32Error() y Marshal.ThrowExceptionForHR() así como el tipo excepción System.ComponentModel.Win32Exception que podemos invocar para informarle de un error Win32 específico al usuario.



¿Cómo prevenir el Flickering de un control Win32?.

Uno de los mayores problemas estéticos y también de lo más común al trabajar con los controles de la tecnología WindowsForms es el Flickering. El Flicker consiste en un desagradable parpadeo de la imagen en donde la imagen desaparece por un breve tiempo lapso de tiempo hasta que vuelve a aparecer, como un parpadeo. Es un problema visual que afecta a la estética del control, y suele producirse muy a menudo cuando el control necesita realizar operaciones de dibujo muy expensivas, o cuando estamos trabajando con transparencias.

Una descripción más detallada del flickering: https://en.wikipedia.org/wiki/Flicker_(screen)

¿Cómo se soluciona el Flickering?, pues lamentablemente no se puede solucionar completamente, pero si que podemos llegar a reducir el Flickering considerablemente y en el mejor de los casos hasta llegar a dejar de percibirlo del todo y poder decir que ya no hay Flickering en el control, ¿pero cómo se hace?, pues una solución cotidiana sería con un bufer doble de memoria, o double buffering.

Cuando el double buffering está activado, todas las operaciones de dibujado del control son renderizadas primero a un bufer de memoria en vez de ser renderizadas directamente a la superficie de dibujado en la pantalla. Cuando todas las operaciones de dibujado han sido completadas, el bufer de memoria es copiado directamente a la superficie de dibujado asociada a él.

Para tratar de solventar los problemas de Flickering cuando estamos desarrollando un control de usuario, he desarrollado una interfáz con nombre IBufferedControl, la cual implementariamos en nuestro control:

Código (vbnet) [Seleccionar] Expandir

' ***********************************************************************
' Author   : Elektro
' Modified : 20-March-2017
' ***********************************************************************

#Region " Public Members Summary "

#Region " Properties "

' CreateParams As CreateParams
' DoubleBuffered As Boolean
' PreventFlickering As Boolean

#End Region

#End Region

#Region " Option Statements "

Option Strict On
Option Explicit On
Option Infer Off

#End Region

#Region " Imports "

Imports System.ComponentModel
Imports System.Windows.Forms

#End Region

#Region " IBufferedControl "

Namespace Types

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Provides simple double buffering (anti flickering) functionality for a Windows Forms <see cref="Control"/>,
   ''' such for example a <see cref="TextBox"/>.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   Public Interface IBufferedControl

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets the required creation parameters when the control handle is created.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <value>
       ''' The creation parameters.
       ''' </value>
       ''' ----------------------------------------------------------------------------------------------------
       <Browsable(False)>
       <EditorBrowsable(EditorBrowsableState.Advanced)>
       ReadOnly Property CreateParams As CreateParams
       ' Implementation Exmple:
       '
       ' Protected Overrides ReadOnly Property CreateParams As CreateParams Implements IBufferedControl.CreateParams
       '     Get
       '         If (Me.preventFlickeringB) Then
       '             Dim cp As CreateParams = MyBase.CreateParams
       '             cp.ExStyle = (cp.ExStyle Or CInt(WindowStylesEx.Composited))
       '             Return cp
       '         Else
       '             Return MyBase.CreateParams
       '         End If
       '     End Get
       ' End Property

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets or sets a value indicating whether this control should redraw its surface using a secondary buffer
       ''' to reduce or prevent flicker.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <value>
       ''' <see langword="True"/> if the surface of the control should be drawn using double buffering;
       ''' otherwise, <see langword="False"/>.
       ''' </value>
       ''' ----------------------------------------------------------------------------------------------------
       <Browsable(True)>
       <EditorBrowsable(EditorBrowsableState.Always)>
       <DesignerSerializationVisibility(DesignerSerializationVisibility.Visible)>
       <Localizable(True)>
       <Category("Behavior")>
       <Description("Indicates whether this control should redraw its surface using a secondary buffer to reduce or prevent flicker.")>
       <DefaultValue(GetType(Boolean), "True")>
       Property DoubleBuffered As Boolean
       ' Implementation Exmple:
       '
       ' Public Overridable Shadows Property DoubleBuffered As Boolean Implements IBufferedControl.DoubleBuffered
       '     Get
       '         Return MyBase.DoubleBuffered
       '     End Get
       '     Set(ByVal value As Boolean)
       '         Me.SetStyle(ControlStyles.DoubleBuffer, value)
       '         MyBase.DoubleBuffered = value
       '     End Set
       ' End Property

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets or sets a value that indicates whether the control should avoid unwanted flickering effects.
       ''' <para></para>
       ''' If <see langword="True"/>, this will avoid any flickering effect on the control, however,
       ''' it will also have a negative impact by slowing down the responsiveness of the control about to 30% slower.
       ''' <para></para>
       ''' This negative impact doesn't affect to the performance of the application itself,
       ''' just to the performance of this control.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <value>
       ''' A value that indicates whether the control should avoid unwanted flickering effects.
       ''' </value>
       ''' ----------------------------------------------------------------------------------------------------
       <Browsable(True)>
       <EditorBrowsable(EditorBrowsableState.Always)>
       <DesignerSerializationVisibility(DesignerSerializationVisibility.Visible)>
       <Localizable(True)>
       <Category("Behavior")>
       <Description("Indicates whether the control should avoid unwanted flickering effects. If True, this will avoid any flickering effect on the control, however, it will also have a negative impact by slowing down the responsiveness of the control about to 30% slower.")>
       <DefaultValue(GetType(Boolean), "False")>
       Property PreventFlickering As Boolean
       ' Implementation Exmple:
       '
       ' Public Overridable Property PreventFlickering As Boolean Implements IBufferedControl.PreventFlickering
       '     Get
       '         Return Me.preventFlickeringB
       '     End Get
       '     Set(ByVal value As Boolean)
       '         Me.preventFlickeringB = value
       '     End Set
       ' End Property
       ' ''' ----------------------------------------------------------------------------------------------------
       ' ''' <summary>
       ' ''' ( Backing Field )
       ' ''' A value that indicates whether the control should avoid unwanted flickering effects.
       ' ''' </summary>
       ' ''' ----------------------------------------------------------------------------------------------------
       ' Private preventFlickeringB As Boolean

   End Interface

End Namespace

#End Region

Un ejemplo de implementación:

Código (vbnet) [Seleccionar] Expandir

<DisplayName("MyControl")>
<Description("A extended control.")>
<DesignTimeVisible(True)>
<DesignerCategory("UserControl")>
<ToolboxBitmap(GetType(UserControl))>
<ToolboxItemFilter("System.Windows.Forms", ToolboxItemFilterType.Require)>
<PermissionSet(SecurityAction.Demand, Name:="FullTrust")>
Public Class MyControl : Inherits UserControl : Implements IBufferedControl

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets the required creation parameters when the control handle is created.
   ''' <para></para>
   ''' The information returned by the <see cref="CreateParams"/> property is used to pass information about the
   ''' initial state and appearance of this control, at the time an instance of this class is being created.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <value>
   ''' The creation parameters.
   ''' </value>
   ''' ----------------------------------------------------------------------------------------------------
   <Browsable(False)>
   <EditorBrowsable(EditorBrowsableState.Advanced)>
   <Description("The required creation parameters when the control handle is created.")>
   Protected Overrides ReadOnly Property CreateParams As CreateParams Implements IBufferedControl.CreateParams
       Get
           If (Me.preventFlickeringB) Then
               Dim cp As CreateParams = MyBase.CreateParams
               cp.ExStyle = (cp.ExStyle Or CInt(WindowStylesEx.Composited))
               Return cp
           Else
               Return MyBase.CreateParams
           End If
       End Get
   End Property

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets or sets a value indicating whether this control should redraw its surface using a secondary buffer
   ''' to reduce or prevent flicker.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <value>
   ''' <see langword="True"/> if the surface of the control should be drawn using double buffering;
   ''' otherwise, <see langword="False"/>.
   ''' </value>
   ''' ----------------------------------------------------------------------------------------------------
   <Browsable(True)>
   <EditorBrowsable(EditorBrowsableState.Always)>
   <DesignerSerializationVisibility(DesignerSerializationVisibility.Visible)>
   <Localizable(True)>
   <Category("Behavior")>
   <Description("Indicates whether this control should redraw its surface using a secondary buffer to reduce or prevent flicker.")>
   <DefaultValue(GetType(Boolean), "False")>
   Public Overridable Shadows Property DoubleBuffered As Boolean Implements IBufferedControl.DoubleBuffered
       Get
           Return MyBase.DoubleBuffered
       End Get
       Set(ByVal value As Boolean)
           Me.SetStyle(ControlStyles.DoubleBuffer, value)
           MyBase.DoubleBuffered = value
       End Set
   End Property

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets or sets a value that indicates whether the control should avoid unwanted flickering effects.
   ''' <para></para>
   ''' If <see langword="True"/>, this will avoid any flickering effect on the control, however,
   ''' it will also have a negative impact by slowing down the responsiveness of the control about to 30% slower.
   ''' <para></para>
   ''' This negative impact doesn't affect to the performance of the application itself,
   ''' just to the performance of this control.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <value>
   ''' A value that indicates whether the control should avoid unwanted flickering effects.
   ''' </value>
   ''' ----------------------------------------------------------------------------------------------------
   <Browsable(True)>
   <EditorBrowsable(EditorBrowsableState.Always)>
   <DesignerSerializationVisibility(DesignerSerializationVisibility.Visible)>
   <Localizable(False)>
   <Category("Behavior")>
   <Description("Indicates whether the control should avoid unwanted flickering effects. If True, this will avoid any flickering effect on the control, however, it will also have a negative impact by slowing down the responsiveness of the control about to 30% slower.")>
   <DefaultValue(GetType(Boolean), "False")>
   Public Overridable Property PreventFlickering As Boolean Implements IBufferedControl.PreventFlickering
       Get
           Return Me.preventFlickeringB
       End Get
       Set(ByVal value As Boolean)
           Me.preventFlickeringB = value
       End Set
   End Property
   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' ( Backing Field )
   ''' A value that indicates whether the control should avoid unwanted flickering effects.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   Private preventFlickeringB As Boolean

   Public Sub New()
       MyBase.SuspendLayout()
       ' MyBase.DoubleBuffered = True
       ' Me.preventFlickeringB = True
       MyBase.ResumeLayout(performLayout:=False)
   End Sub

End Class



¿Cómo calcular la distancia (de 2 dimensiones) entre dos puntos?.

Código (vbnet) [Seleccionar] Expandir

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Calculates the distance between two points in two dimensions in the coordinate system.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <remarks>
''' Pythagorean theorem: <see href="http://en.wikipedia.org/wiki/Pythagorean_theorem"/>
''' </remarks>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim distance As Double = CalculateDistance2D(New PointF(1, 1), New PointF(2, 2))
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="pointA">
''' The first point.
''' </param>
'''
''' <param name="pointB">
''' The second point.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The resulting distance.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
Public Shared Function CalculateDistance2D(ByVal pointA As PointF, ByVal pointB As PointF) As Double

   ' Pythagoras theorem: c^2 = a^2 + b^2
   ' thus c = square root(a^2 + b^2)
   Dim a As Double = (pointB.X - pointA.X)
   Dim b As Double = (pointB.Y - pointA.Y)

   Return Math.Sqrt(a * a + b * b)

End Function



¿Cómo subscribirnos a eventos del sistema?.

Microsoft Windows expone una infraestructura llamada WMI (Windows Management Instrumentation) mediante la que provee una serie de classes que podemos utilizar para subscribbirnos a eventos del sistema o dicho coloquiálmente "monitorizar eventos", como por ejemplo cambios de hardware, cambios de aplicaciones instaladas o desinstaladas, cambios en el nivel de batería de un portatil, cambios en el registro de Windows, y un largo etcétera.

La lista de classes podemos encontrarla en MSDN: https://msdn.microsoft.com/en-us/library/aa394554(v=vs.85).aspx

Hay varios tipos de classes, un tipo de classes serían representativas, es decir para representar información de consultas realizadas a WMI, y otro tipo serían las classes de eventos. Una class de evento la utilizariamos para subscribirnos al tipo de evento que provee.

Para subscribirnos a una clase de evento, la librería de clases de .NET Framework espone la clase ManagementEventWatcher. Yo he desarrollado la siguiente class que hereda de la class ManagementEventWatcher, con la intención de añadir algunos constructores específicos para facilitar todavía más su uso y abstraer en mayor medida el nivel de complejidad.

Código (vbnet) [Seleccionar] Expandir

' ***********************************************************************
' Author   : Elektro
' Modified : 21-March-2017
' ***********************************************************************

#Region " Public Members Summary "

#Region " Constructors "

' New(String)
' New(String, Single)
' New(String, Timespan)
' New(String, String, Single)
' New(String, String, Timespan)
' New(String, String, String(), UInteger)
' New(String, String, String(), Timespan)

' New(SelectQuery)
' New(SelectQuery, Single)
' New(SelectQuery, Timespan)
' New(SelectQuery, UInteger)

#End Region

#Region " Events "

' EventArrived As EventArrivedEventHandler

#End Region

#Region " Methods "

' Start()
' Stop()
' Dispose()

#End Region

#End Region

#Region " Option Statements "

Option Strict On
Option Explicit On
Option Infer Off

#End Region

#Region " Imports "

Imports System.ComponentModel
Imports System.Management

#End Region

#Region " WMI Event Watcher "

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' A WMI event monitor that notifies about event arrivals for the subscribed event class.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   <DesignerCategory("code")>
   <ImmutableObject(False)>
   Public Class WMIEventWatcher : Inherits ManagementEventWatcher

#Region " Constructors "

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Prevents a default instance of the <see cref="WMIEventWatcher"/> class from being created.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerNonUserCode>
       Private Sub New()
       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Initializes a new instance of the <see cref="WMIEventWatcher"/> class.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="eventClassName">
       ''' The name of the WMI event class to subscribe for.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Sub New(ByVal eventClassName As String)

           Me.New(eventClassName, condition:=String.Empty, withinInterval:=1.0F)

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Initializes a new instance of the <see cref="WMIEventWatcher"/> class.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="eventClassName">
       ''' The name of the WMI event class to subscribe for.
       ''' </param>
       '''
       ''' <param name="withinInterval">
       ''' The interval, in seconds, that WMI will check for changes that occur to instances of the events of the
       ''' specified class in the <paramref name="eventClassName"/> parameter.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Sub New(ByVal eventClassName As String,
                      ByVal withinInterval As Single)

           Me.New(eventClassName, condition:=String.Empty, withinInterval:=withinInterval)

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Initializes a new instance of the <see cref="WMIEventWatcher"/> class.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="eventClassName">
       ''' The name of the WMI event class to subscribe for.
       ''' </param>
       '''
       ''' <param name="withinInterval">
       ''' The interval, in seconds, that WMI will check for changes that occur to instances of the events of the
       ''' specified class in the <paramref name="eventClassName"/> parameter.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Sub New(ByVal eventClassName As String,
                      ByVal withinInterval As TimeSpan)

           Me.New(eventClassName, condition:=String.Empty, withinInterval:=withinInterval)

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Initializes a new instance of the <see cref="WMIEventWatcher"/> class.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="eventClassName">
       ''' The name of the WMI event class to subscribe for.
       ''' </param>
       '''
       ''' <param name="condition">
       ''' The condition to be applied to events of the specified class in the
       ''' <paramref name="eventClassName"/> parameter.
       ''' </param>
       '''
       ''' <param name="withinInterval">
       ''' The interval, in seconds, that WMI will check for changes that occur to instances of the events of the
       ''' specified class in the <paramref name="eventClassName"/> parameter.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Sub New(ByVal eventClassName As String,
                      ByVal condition As String,
                      ByVal withinInterval As Single)

           Me.New(eventClassName, condition, TimeSpan.FromSeconds(withinInterval))

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Initializes a new instance of the <see cref="WMIEventWatcher"/> class.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="eventClassName">
       ''' The name of the WMI event class to subscribe for.
       ''' </param>
       '''
       ''' <param name="condition">
       ''' The condition to be applied to events of the specified class in the
       ''' <paramref name="eventClassName"/> parameter.
       ''' </param>
       '''
       ''' <param name="withinInterval">
       ''' The interval, in seconds, that WMI will check for changes that occur to instances of the events of the
       ''' specified class in the <paramref name="eventClassName"/> parameter.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Sub New(ByVal eventClassName As String,
                      ByVal condition As String,
                      ByVal withinInterval As TimeSpan)

           MyBase.Query = New WqlEventQuery(eventClassName:=eventClassName,
                                            condition:=condition,
                                            withinInterval:=withinInterval)

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Initializes a new instance of the <see cref="WMIEventWatcher"/> class.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="eventClassName">
       ''' The name of the WMI event class to subscribe for.
       ''' </param>
       '''
       ''' <param name="condition">
       ''' The condition to be applied to events of the specified class in the
       ''' <paramref name="eventClassName"/> parameter.
       ''' </param>
       '''
       ''' <param name="groupByPropertyList">
       ''' The properties in the event class by which the events should be grouped.
       ''' </param>
       '''
       ''' <param name="groupWithinInterval">
       ''' The interval, in seconds, of the specified interval at which WMI sends one aggregate event,
       ''' rather than many events.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Sub New(ByVal eventClassName As String,
                      ByVal condition As String,
                      ByVal groupByPropertyList As String(),
                      ByVal groupWithinInterval As UInteger)

           Me.New(eventClassName, condition, groupByPropertyList, TimeSpan.FromSeconds(groupWithinInterval))

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Initializes a new instance of the <see cref="WMIEventWatcher"/> class.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="eventClassName">
       ''' The name of the WMI event class to subscribe for.
       ''' </param>
       '''
       ''' <param name="condition">
       ''' The condition to be applied to events of the specified class in the
       ''' <paramref name="eventClassName"/> parameter.
       ''' </param>
       '''
       ''' <param name="groupByPropertyList">
       ''' The properties in the event class by which the events should be grouped.
       ''' </param>
       '''
       ''' <param name="groupWithinInterval">
       ''' The interval, in seconds, of the specified interval at which WMI sends one aggregate event,
       ''' rather than many events.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Sub New(ByVal eventClassName As String,
                      ByVal condition As String,
                      ByVal groupByPropertyList As String(),
                      ByVal groupWithinInterval As TimeSpan)

           MyBase.Query = New WqlEventQuery(eventClassName:=eventClassName,
                                            condition:=condition,
                                            groupWithinInterval:=groupWithinInterval,
                                            groupByPropertyList:=groupByPropertyList)

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Initializes a new instance of the <see cref="WMIEventWatcher"/> class.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="query">
       ''' The WMI select query of the event class to subscribe for.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Sub New(ByVal query As SelectQuery)

           Me.New(query.ClassName, condition:=query.Condition, withinInterval:=1.0F)

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Initializes a new instance of the <see cref="WMIEventWatcher"/> class.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="query">
       ''' The WMI select query of the event class to subscribe for.
       ''' </param>
       '''
       ''' <param name="withinInterval">
       ''' The interval, in seconds, that WMI will check for changes that occur to instances of the events of the
       ''' specified class in the <paramref name="query"/> parameter.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Sub New(ByVal query As SelectQuery,
                      ByVal withinInterval As Single)

           Me.New(query.ClassName, condition:=query.Condition, withinInterval:=TimeSpan.FromSeconds(withinInterval))

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Initializes a new instance of the <see cref="WMIEventWatcher"/> class.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="query">
       ''' The WMI select query of the event class to subscribe for.
       ''' </param>
       '''
       ''' <param name="withinInterval">
       ''' The interval, in seconds, that WMI will check for changes that occur to instances of the events of the
       ''' specified class in the <paramref name="query"/> parameter.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Sub New(ByVal query As SelectQuery,
                      ByVal withinInterval As TimeSpan)

           Me.New(query.ClassName, condition:=query.Condition, withinInterval:=withinInterval)

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Initializes a new instance of the <see cref="WMIEventWatcher"/> class.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="query">
       ''' The WMI select query of the event class to subscribe for and its selected properties.
       ''' </param>
       '''
       ''' <param name="groupWithinInterval">
       ''' The interval, in seconds, of the specified interval at which WMI sends one aggregate event,
       ''' rather than many events.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Sub New(ByVal query As SelectQuery,
                      ByVal groupWithinInterval As UInteger)

           Dim strArray As String() = New String(query.SelectedProperties.Count - 1) {}
           query.SelectedProperties.CopyTo(strArray, 0)

           MyBase.Query = New WqlEventQuery(eventClassName:=query.ClassName,
                                            condition:=query.Condition,
                                            groupWithinInterval:=TimeSpan.FromSeconds(groupWithinInterval),
                                            groupByPropertyList:=strArray)

       End Sub

#End Region

   End Class

#End Region

Ejemplo de uso para subscribirnos a la class Win32_VolumeChangeEvent, la cual nos informa de cambios de volumen, del montaje y desmontaje de particiones del sistema:

Código (vbnet) [Seleccionar] Expandir

Public NotInheritable Class Form1 : Inherits Form

   Private WithEvents eventWatcher As New WMIEventWatcher("Win32_VolumeChangeEvent", withinInterval:=0.5F)

   Private Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs) Handles Me.Load
       Me.eventWatcher.Scope = New ManagementScope("root\CIMV2", New ConnectionOptions() With {.EnablePrivileges = True})
       Me.eventWatcher.Start()
   End Sub

   Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As FormClosingEventArgs) Handles Me.FormClosing
       Me.eventWatcher.Dispose()
   End Sub

   Private Sub EventWatcher_EventArrived(ByVal sender As Object, ByVal e As EventArrivedEventArgs) _
   Handles eventWatcher.EventArrived
       Dim driveName As String = CStr(e.NewEvent.Properties("DriveName").Value)
       Dim eventType As Integer = CInt(e.NewEvent.Properties("EventType").Value)

       Console.WriteLine(String.Format("Drive Name: {0}", driveName))
       Console.WriteLine(String.Format("Event Type: {0}", eventType))
   End Sub

End Class

Ejemplo de uso para subscribirnos a la class Win32_LogicalDisk, mediante la cual con el uso de una condición en la consulta de WMI, nos reportará cambios de inserción y eyección en dispositivos de CD-ROM:

Código (vbnet) [Seleccionar] Expandir

Public Class Form1 : Inherits Form

   Private WithEvents eventWatcher As New WMIEventWatcher(
       "__InstanceModificationEvent",
       condition:="TargetInstance ISA 'Win32_LogicalDisk' and TargetInstance.DriveType = 5",
       withinInterval:=0.5F
   )

   Private Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs) Handles Me.Load
       Me.eventWatcher.Scope = New ManagementScope("root\CIMV2", New ConnectionOptions() With {.EnablePrivileges = True})
       Me.eventWatcher.Start()
   End Sub

   Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As FormClosingEventArgs) Handles Me.FormClosing
       Me.eventWatcher.Dispose()
   End Sub

   Private Sub EventWatcher_EventArrived(ByVal sender As Object, ByVal e As EventArrivedEventArgs) Handles eventWatcher.EventArrived

       Using mo As ManagementBaseObject = DirectCast(pd.Value, ManagementBaseObject)

           Dim name As String = Convert.ToString(mo.Properties("Name").Value)
           string label = Convert.ToString(mo.Properties("VolumeName").Value);

           Dim di As DriveInfo = (From item In DriveInfo.GetDrives()
                                  Where String.IsNullOrEmpty(item.Name)
                                 ).Single()

           If Not String.IsNullOrEmpty(di.VolumeLabel) Then

               Console.WriteLine(String.Format("CD has been inserted in drive {0}.", di.Name))
           Else

               Console.WriteLine(String.Format("CD has been ejected from drive {0}.", di.Name))

           End If

       End Using

   End Sub

End Class
Nota: No he podido testear el ejemplo del dispositivo CD-ROM.



Todas estas funcionalidades y muchísimas más las podrán encontrar en mi Framework de pago ElektroKit.

[Eleкtro]

¿Cómo manipular imágenes GIF animadas?

La librería de clases de .NET Framework no expone ningún tipo para representar de forma específica una imagen GIF. Tenemos el tipo Bitmap, Icon, e Image para representar de forma global cualquier tipo de imagen (incluyendo un GIF). Pero... ¿y si queremos representar de forma específica una imagen GIF con todos sus frames?, pues esta clase que he desarrollado sería un buen comienzo para llevarlo a cabo:

Código (vbnet) [Seleccionar] Expandir

' ***********************************************************************
' Author   : Elektro
' Modified : 02-April-2017
' ***********************************************************************

#Region " Public Members Summary "

#Region " Constructors "

' New(String)
' New(FileInfo)
' New(Image)

#End Region

#Region " Properties "

' Image As Image
' FrameCount As Integer
' Frames(Integer) As Bitmap
' ActiveFrame As Bitmap
' ActiveFrameIndex As Integer
' EndOfFrames As Boolean

#End Region

#Region " Functions "

' NextFrame() As Bitmap
' GetFrames() As List(Of Bitmap)

#End Region

#End Region

#Region " Option Statements "

Option Strict On
Option Explicit On
Option Infer Off

#End Region

#Region " Imports "

Imports System.Drawing
Imports System.Drawing.Imaging
Imports System.IO

#End Region

#Region " GIF "

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Represents a GIF image.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   Public Class GIF

#Region " Properties "

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets the GIF image.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <value>
       ''' The GIF image.
       ''' </value>
       ''' ----------------------------------------------------------------------------------------------------
       Public ReadOnly Property Image As Image

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets the frame count of the GIF image.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <value>
       ''' The frame count of the GIF image.
       ''' </value>
       ''' ----------------------------------------------------------------------------------------------------
       Public ReadOnly Property FrameCount As Integer

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets the frame at the specified index.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <value>
       ''' The frame index.
       ''' </value>
       ''' ----------------------------------------------------------------------------------------------------
       Default Public Overridable ReadOnly Property Frames(ByVal index As Integer) As Bitmap
           <DebuggerStepperBoundary>
           Get
               Using img As Image = DirectCast(Me.Image.Clone(), Image)
                   img.SelectActiveFrame(FrameDimension.Time, index)
                   Return New Bitmap(img) ' Deep copy of the frame (only the frame).
               End Using
           End Get
       End Property

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets the active frame.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <value>
       ''' The active frame.
       ''' </value>
       ''' ----------------------------------------------------------------------------------------------------
       Public Overridable ReadOnly Property ActiveFrame As Bitmap
           <DebuggerStepperBoundary>
           Get
               Return New Bitmap(Me.Image) ' Deep copy of the frame (only the frame).
           End Get
       End Property

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets the index in the frame count of the current active frame.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <value>
       ''' The index in the frame count of the current active frame.
       ''' </value>
       ''' ----------------------------------------------------------------------------------------------------
       Public Property ActiveFrameIndex As Integer
           <DebuggerStepThrough>
           Get
               Return Me.activeFrameIndexB
           End Get
           <DebuggerStepperBoundary>
           Set(ByVal value As Integer)
               If (value <> Me.activeFrameIndexB) Then
                   Me.Image.SelectActiveFrame(FrameDimension.Time, value)
                   Me.activeFrameIndexB = value
                   Me.eof = (value = Me.FrameCount)
               End If
           End Set
       End Property
       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' ( Backing Field )
       ''' The index in the frame count of the current active frame.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       Private activeFrameIndexB As Integer

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets a value indicating whether the frame count is at EOF,
       ''' this means there is no more frames to advance in the GIF image.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <value>
       ''' <see langword="True"/> if there is no more frames to advance in the GIF image; otherwise, <see langword="False"/>.
       ''' </value>
       ''' ----------------------------------------------------------------------------------------------------
       Public ReadOnly Property EndOfFrames As Boolean
           <DebuggerStepThrough>
           Get
               Return Me.eof
           End Get
       End Property
       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' ( Backing Field )
       ''' A value indicating whether the frame count is at EOF,
       ''' this means there is no more frames to advance in the GIF image.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       Private eof As Boolean

#End Region

#Region " Constructors "

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Prevents a default instance of the <see cref="GIF"/> class from being created.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerNonUserCode>
       Private Sub New()
       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Initializes a new instance of the <see cref="GIF"/> class.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="filepath">
       ''' The filepath.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Sub New(ByVal filepath As String)

           Me.New(Image.FromFile(filepath))

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Initializes a new instance of the <see cref="GIF"/> class.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="file">
       ''' The image file.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Sub New(ByVal file As FileInfo)

           Me.New(Image.FromFile(file.FullName))

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Initializes a new instance of the <see cref="GIF"/> class.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="img">
       ''' The image.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Sub New(ByVal img As Image)

           Me.Image = img
           Me.FrameCount = Me.Image.GetFrameCount(FrameDimension.Time)

       End Sub

#End Region

#Region " Public Methods "

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Advances one position in the frame count and returns the next frame.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <returns>
       ''' The next frame.
       ''' </returns>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Overridable Function NextFrame() As Bitmap

           If (Me.eof) Then
               Throw New IndexOutOfRangeException()

           Else
               Dim frame As Bitmap = Me.Frames(Me.activeFrameIndexB)
               Me.activeFrameIndexB += 1
               Me.eof = (Me.activeFrameIndexB >= Me.FrameCount)
               Return frame

           End If

       End Function

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets a <see cref="List(Of Bitmap)"/> containing all the frames in the image.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <returns>
       ''' A <see cref="List(Of Bitmap)"/> containing all the frames in the image.
       ''' </returns>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Overridable Function GetFrames() As List(Of Bitmap)

           Using img As Image = DirectCast(Me.Image.Clone(), Image)
               Return GetFramesFromImage(img)
           End Using

       End Function

#End Region

#Region " Private Methods "

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets a <see cref="List(Of Bitmap)"/> containing all the frames in the source GIF image.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="img">
       ''' The source <see cref="Image"/>.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <returns>
       ''' The resulting percentage difference value between the two specified images.
       ''' </returns>
       ''' ----------------------------------------------------------------------------------------------------
       Private Shared Function GetFramesFromImage(ByVal img As Image) As List(Of Bitmap)

           Dim imgs As New List(Of Bitmap)
           Dim frameCount As Integer = img.GetFrameCount(FrameDimension.Time)

           For i As Integer = 0 To (frameCount - 1)
               img.SelectActiveFrame(FrameDimension.Time, i)
               imgs.Add(New Bitmap(img)) ' Deep copy of the frame (only the frame).
           Next

           Return imgs

       End Function

#End Region

   End Class

#End Region


Ejemplos de uso:

Código (vbnet) [Seleccionar] Expandir

Dim pcb As PictureBox = Me.PictureBox1
Dim gif As New GIF("C:\File.gif")

Do Until gif.EndOfFrames ' Iterate frames until the end of frame count.

   ' Free previous Bitmap object.
   If (pcb.Image IsNot Nothing) Then
       pcb.Image.Dispose()
       pcb.Image = Nothing
   End If

   pcb.Image = gif.NextFrame()
   Thread.Sleep(60) ' Simulate a FPS thingy.
   Application.DoEvents()

   If (gif.EndOfFrames) Then
       ' Set active frame to 0 for infinite loop:
       gif.ActiveFrameIndex = 0
   End If

Loop

Nótese que el método GIF.GetFrames() devuelve una colección de Bitmaps con todos los frames de la imagen GIF. Las posibilidades son infinitas con esta colección, podemos añadir, editar o eliminar frames para crear un nuevo GIF, o simplemente mostrar la secuencia de frames...

¡Saludos!

[Eleкtro]

Determinar si dos colores son similares

Código (vbnet) [Seleccionar] Expandir

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Determines whether two colors are similar.
   ''' <para></para>
   ''' It compares the RGB channel differences to match inside the range of the specified tolerance values.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="color1">
   ''' The first color to compare.
   ''' </param>
   '''
   ''' <param name="color2">
   ''' The second color to compare.
   ''' </param>
   '''
   ''' <param name="toleranceR">
   ''' The tolerance of the Red color channel.
   ''' From 0 to 255.
   ''' </param>
   '''
   ''' <param name="toleranceG">
   ''' The tolerance of the Green color channel.
   ''' From 0 to 255.
   ''' </param>
   '''
   ''' <param name="toleranceB">
   ''' The tolerance of the Blue color channel.
   ''' From 0 to 255.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <returns>
   ''' <see langword="True"/> if the colors are similar,
   ''' this means the RGB differences matches inside the range of the specified tolerance value,
   ''' <see langword="False"/> otherwise.
   ''' </returns>
   ''' ----------------------------------------------------------------------------------------------------
   Public Shared Function IsColorSimilar(ByVal color1 As Color, ByVal color2 As Color,
                                         ByVal toleranceR As Byte, ByVal toleranceG As Byte, ByVal toleranceB As Byte) As Boolean

       Return Math.Abs(CInt(color1.R) - color2.R) <= toleranceR AndAlso
              Math.Abs(CInt(color1.G) - color2.G) <= toleranceG AndAlso
              Math.Abs(CInt(color1.B) - color2.B) <= toleranceB

   End Function

Modo de empleo:

Código (vbnet) [Seleccionar] Expandir

Dim areSimilar As Boolean = IsColorSimilar(Color.FromArgb(0, 0, 0), Color.FromArgb(0, 0, 1),
                                          toleranceR:=0, toleranceG:=0, toleranceB:=1)
' Result: True

Código (vbnet) [Seleccionar] Expandir

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Determines whether two colors are similar.
   ''' <para></para>
   ''' It compares the RGB channel difference to match inside the range of the specified tolerance value.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="color1">
   ''' The first color to compare.
   ''' </param>
   '''
   ''' <param name="color2">
   ''' The second color to compare.
   ''' </param>
   '''
   ''' <param name="tolerance">
   ''' The global tolerance of the RGB color channels.
   ''' From 0 to 255.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <returns>
   ''' <see langword="True"/> if the colors are similar,
   ''' this means the RGB differences matches inside the range of the specified tolerance value,
   ''' <see langword="False"/> otherwise.
   ''' </returns>
   ''' ----------------------------------------------------------------------------------------------------
   Public Shared Function IsColorSimilar(ByVal color1 As Color, ByVal color2 As Color, ByVal tolerance As Byte) As Boolean

       Return (Math.Abs(CInt(color1.R) - color2.R) +
               Math.Abs(CInt(color1.G) - color2.G) +
               Math.Abs(CInt(color1.B) - color2.B)) <= tolerance

   End Function

Modo de empleo :

Código (vbnet) [Seleccionar] Expandir

Dim result1 As Boolean = IsColorSimilar(Color.FromArgb(0, 0, 0), Color.FromArgb(0, 0, 1), tolerance:=1)
' Result: True
'  Logic: Blue channel difference = 1, which is equal than the specified tolerance value.

Dim result2 As Boolean = IsColorSimilar(Color.FromArgb(0, 0, 0), Color.FromArgb(0, 1, 1), tolerance:=1)
' Result: False
'  Logic: Red channel + Blue channel differences = 2, which is a bigger value than the specified tolerance value.



Voltear una imagen

Código (vbnet) [Seleccionar] Expandir

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Specifies a flip type operation to perform for an image.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
Public Enum FlipType As Integer

   ''' <summary>
   ''' Horizontal flip.
   ''' </summary>
   Horizontal = 1

   ''' <summary>
   ''' Vertical flip.
   ''' </summary>
   Vertical = 2

   ''' <summary>
   ''' Both a horizontal and vertical flip.
   ''' </summary>
   Both = 3

End Enum

public module ImageExtensions

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Flips an <see cref="Image"/>.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <param name="sender">
''' The source <see cref="Image"/>.
''' </param>
'''
''' <param name="fliptype">
''' The flip type operation to perform.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The resulting <see cref="Image"/>.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
<Extension>
<DebuggerStepThrough>
<EditorBrowsable(EditorBrowsableState.Always)>
Public Function Flip(ByVal sender As Image, ByVal fliptype As FlipType) As Image

   Dim flippedImage As New Bitmap(sender.Width, sender.Height, sender.PixelFormat)

   Using g As Graphics = Graphics.FromImage(flippedImage)

       Dim m As Matrix = Nothing
       Select Case fliptype
           Case FlipType.Horizontal
               m = New Matrix(-1, 0, 0, 1, 0, 0)
               m.Translate(flippedImage.Width, 0, MatrixOrder.Append)

           Case FlipType.Vertical
               m = New Matrix(1, 0, 0, -1, 0, 0)
               m.Translate(0, flippedImage.Height, MatrixOrder.Append)

           Case FlipType.Both
               m = New Matrix(-1, 0, 0, -1, 0, 0)
               m.Translate(flippedImage.Width, flippedImage.Height, MatrixOrder.Append)
       End Select

       ' Draw
       g.Transform = m
       g.DrawImage(sender, 0, 0)

       'clean up
       m.Dispose()
   End Using

   Return flippedImage

End Function

end module

Modo de empleo:

Código (vbnet) [Seleccionar] Expandir

dim img as image = image.fromfile("C:\file.png")
dim flipped as image=  imf.Flip(FlipType.Vertical)



Cifrado XOR

Código (vbnet) [Seleccionar] Expandir

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Encrypts or decrypts a string using XOR algorithm.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <param name="text">
''' The text to encrypt.
''' </param>
'''
''' <param name="key">
''' The key to use for encryption of decryption.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The encrypted string.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Function XorEncryptOrDecrypt(ByVal text As String, ByVal key As Integer) As String

   Dim sb As New StringBuilder(text.Length, text.Length)
   For Each c As Char In text
       ' Get the ASCII value of the character.
       Dim charValue As Integer = Convert.ToInt32(c)
       ' XOR the value.
       charValue = (charValue Xor key)
       ' Convert back to string.
       sb.Append(Char.ConvertFromUtf32(charValue))
   Next
   
   Return sb.ToString()

End Function

Modo de empleo:

Código (vbnet) [Seleccionar] Expandir

Dim str As String = "Hello World"
Dim encrypted As String = XorEncryptOrDecrypt(str, 1)       ' Result: "Idmmn!Vnsme"
Dim decrypted As String = XorEncryptOrDecrypt(encrypted, 1) ' Result: "Hello World"



Obtener un array con los bytes del archivo de la aplicación actual

Código (vbnet) [Seleccionar] Expandir

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Gets the bytes of the local file that points to the running assembly.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <value>
''' A <see cref="Byte()"/> array containing the bytes of the local file that points to the running assembly.
''' </value>
''' ----------------------------------------------------------------------------------------------------
Public Shared ReadOnly Property SelfBytes As Byte()
   <DebuggerStepThrough>
   Get
       Using fs As FileStream = File.OpenRead(System.Windows.Forms.Application.ExecutablePath)
           Dim exeBytes As Byte() = New Byte(CInt(fs.Length - 1)) {}
           fs.Read(exeBytes, 0, exeBytes.Length)
           Return exeBytes
       End Using
   End Get
End Property

Modo de empleo:

Código (vbnet) [Seleccionar] Expandir

Dim selfBytes As Byte() = SelfBytes()



Obtener recursos embedidos en un ensamblado .NET

Código (vbnet) [Seleccionar] Expandir

Partial Public NotInheritable Class ResourceUtil

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets an embedded resource in the specified <see cref="Assembly"/>.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="name">
   ''' The name of the resource.
   ''' </param>
   '''
   ''' <param name="ass">
   ''' The <see cref="Assembly"/> to look for the resource.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <returns>
   ''' A <see cref="Byte()"/> array containing the bytes of the embedded resource.
   ''' </returns>
   ''' ----------------------------------------------------------------------------------------------------
   Public Shared Function GetEmbeddedResource(ByVal name As String, ByVal ass As Assembly) As Byte()

       name = ResourceUtil.FormatResourceName(name, ass)

       Using resx As Stream = ass.GetManifestResourceStream(name)

           If (resx Is Nothing) Then
               Throw New Exception("Resource not found in the specified .NET assembly.")

           Else
               Dim content As Byte() = New Byte(CInt(resx.Length - 1)) {}
               resx.Read(content, 0, content.Length)
               Return content

           End If

       End Using

   End Function

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets an embedded resource in the calling assembly.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="name">
   ''' The name of the resource.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <returns>
   ''' A <see cref="Byte()"/> array containing the bytes of the embedded resource.
   ''' </returns>
   ''' ----------------------------------------------------------------------------------------------------
   Public Shared Function GetEmbeddedResource(ByVal name As String) As Byte()

       Return ResourceUtil.GetEmbeddedResource(name, Assembly.GetCallingAssembly())

   End Function

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets an embedded resource of type <see cref="String"/> in the specified <see cref="Assembly"/>.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="name">
   ''' The name of the resource.
   ''' </param>
   '''
   ''' <param name="ass">
   ''' The <see cref="Assembly"/> to look for the resource.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <returns>
   ''' The embedded resource as <see cref="String"/>.
   ''' </returns>
   ''' ----------------------------------------------------------------------------------------------------
   Public Shared Function GetEmbeddedResourceAsString(ByVal name As String, ByVal ass As Assembly, Optional ByVal enc As Encoding = Nothing) As String

       If (enc Is Nothing) Then
           enc = Encoding.Default
       End If

       name = ResourceUtil.FormatResourceName(name, ass)

       Using resx As Stream = ass.GetManifestResourceStream(name)

           If (resx Is Nothing) Then
               Throw New Exception("Resource not found in the specified .NET assembly.")
           Else
               Using reader As New StreamReader(resx, enc)
                   Return reader.ReadToEnd()
               End Using
           End If

       End Using

   End Function

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets an embedded resource of type <see cref="String"/> in the calling assembly.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="name">
   ''' The name of the resource.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <returns>
   ''' The embedded resource as <see cref="String"/>.
   ''' </returns>
   ''' ----------------------------------------------------------------------------------------------------
   Public Shared Function GetEmbeddedResourceAsString(ByVal name As String, Optional ByVal enc As Encoding = Nothing) As String

       Return ResourceUtil.GetEmbeddedResourceAsString(name, Assembly.GetCallingAssembly(), enc)

   End Function

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets an embedded resource of type <see cref="Image"/> in the specified <see cref="Assembly"/>.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="name">
   ''' The name of the resource.
   ''' </param>
   '''
   ''' <param name="ass">
   ''' The <see cref="Assembly"/> to look for the resource.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <returns>
   ''' The embedded resource as <see cref="Image"/>.
   ''' </returns>
   ''' ----------------------------------------------------------------------------------------------------
   Public Shared Function GetEmbeddedResourceAsImage(ByVal name As String, ByVal ass As Assembly) As Image

       name = ResourceUtil.FormatResourceName(name, ass)

       Using resx As Stream = ass.GetManifestResourceStream(name)

           If (resx Is Nothing) Then
               Throw New Exception("Resource not found in the specified .NET assembly.")
           Else
               Using ms As New MemoryStream()
                   resx.CopyTo(ms)
                   Return Image.FromStream(ms)
               End Using

           End If

       End Using

   End Function

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Gets an embedded resource of type <see cref="Image"/> in the calling assembly.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="name">
   ''' The name of the resource.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <returns>
   ''' The embedded resource as <see cref="Image"/>.
   ''' </returns>
   ''' ----------------------------------------------------------------------------------------------------
   Public Shared Function GetEmbeddedResourceAsImage(ByVal name As String) As Image

       Return ResourceUtil.GetEmbeddedResourceAsImage(name, Assembly.GetCallingAssembly())

   End Function

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Formats a resource name.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <param name="name">
   ''' The name of the resource.
   ''' </param>
   '''
   ''' <param name="ass">
   ''' The assembly that contains the resource.
   ''' </param>
   ''' ----------------------------------------------------------------------------------------------------
   ''' <returns>
   ''' The resulting formatted resource name.
   ''' </returns>
   ''' ----------------------------------------------------------------------------------------------------
   Private Shared Function FormatResourceName(ByVal name As String, ByVal ass As Assembly) As String

       Return String.Format("{0}.{1}", ass.GetName().Name, name.Replace(" ", "_").
                                                                Replace("\", ".").
                                                                Replace("/", "."))

   End Function

End Class

Ejemplo de uso para la aplicación actual:

Código (vbnet) [Seleccionar] Expandir

Dim data As Byte() = GetEmbeddedResource("file.txt")
Dim dataAsString As String = Encoding.Default.GetString(data)

Dim str As String = GetEmbeddedResourceAsString("file.txt", Encoding.Default)

Dim img As Image = GetEmbeddedResourceAsImage("file.png")

Ejemplo de uso con un ensamblado específico:

Código (vbnet) [Seleccionar] Expandir

Dim data As Byte() = GetEmbeddedResource("file.txt", Assembly.GetCallingAssembly())
Dim dataAsString As String = Encoding.Default.GetString(data)

Dim str As String = GetEmbeddedResourceAsString("file.txt", Assembly.GetCallingAssembly(), Encoding.Default)

Dim img As Image = GetEmbeddedResourceAsImage("file.png", Assembly.GetCallingAssembly())



Todas estas funcionalidades y muchísimas más las podrán encontrar en mi Framework ElektroKit.

[Eleкtro]

Pausar la ejecución de la consola hasta que se pulse cierta tecla...

Código (vbnet) [Seleccionar] Expandir

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Pause the console execution Indefinitely until any key is pressed.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Sub Pause()
    Console.ReadKey(intercept:=True)
End Sub

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Pause the console execution Indefinitely until the specified key is pressed.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <param name="key">
''' The key to wait for.
''' </param>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Sub Pause(ByVal key As Keys)

    Dim keyInfo As ConsoleKeyInfo

    Do Until (keyInfo.Key = key)
        keyInfo = Console.ReadKey(intercept:=True)
    Loop

End Sub

Modo de empleo:

Código (vbnet) [Seleccionar] Expandir

Console.WriteLine("Press any key to exit...")
Pause()
Environment.Exit(0)

Código (vbnet) [Seleccionar] Expandir

Dim key As Keys = Keys.Enter
Dim keyName As String = [Enum].GetName(GetType(Keys), key)

Console.WriteLine(String.Format("Press '{0}' key to continue...", keyName))
Pause(key)
Console.WriteLine("Well done.")

[Eleкtro]

Un puñado de funciones para extender las posibilidades de la función built-in System.IO.Path.GetTempFileName()

Modo de empleo:

Código (vbnet) [Seleccionar] Expandir

Dim tmpFile1 As FileInfo = GetTempFile()
Dim tmpFile2 As FileInfo = GetTempFile("txt")
Dim tmpFile3 As FileInfo = GetTempFile(SpecialFolder.LocalApplicationData)
Dim tmpFile4 As FileInfo = GetTempFile(SpecialFolder.LocalApplicationData, "txt")
Dim tmpFile5 As FileInfo = GetTempFile(New DirectoryInfo("C:\Folder\"))
Dim tmpFile6 As FileInfo = GetTempFile(New DirectoryInfo("C:\Folder\"), "txt")
Dim tmpFile7 As FileInfo = GetTempFile("C:\Folder\", "txt")

Código (vbnet) [Seleccionar] Expandir

Dim tmpFilePath1 As String = GetTempFileName()
Dim tmpFilePath2 As String = GetTempFileName("txt")
Dim tmpFilePath3 As String = GetTempFileName(SpecialFolder.LocalApplicationData)
Dim tmpFilePath4 As String = GetTempFileName(SpecialFolder.LocalApplicationData, "txt")
Dim tmpFilePath5 As String = GetTempFileName(New DirectoryInfo("C:\Folder\"))
Dim tmpFilePath6 As String = GetTempFileName(New DirectoryInfo("C:\Folder\"), "txt")
Dim tmpFilePath7 As String = GetTempFileName("C:\Folder\", "txt")

Código fuente:

Código (vbnet) [Seleccionar] Expandir


''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Creates a uniquely named, zero-byte temporary file on the system's default temporary folder
''' and returns the file.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim tmpFile As FileInfo = GetTempFile()
''' Console.WriteLine(tmpFile.FullName)
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The resulting <see cref="FileInfo"/>.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Function GetTempFile() As FileInfo

    Return New FileInfo(Path.GetTempFileName())

End Function

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Creates a uniquely named, zero-byte temporary file on the specified folder
''' and returns the file.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim tmpFile As FileInfo = GetTempFile(SpecialFolder.LocalApplicationData)
''' Console.WriteLine(tmpFile.FullName)
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="folder">
''' The folder where to create the temporary file.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The resulting <see cref="FileInfo"/>.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Function GetTempFile(ByVal folder As SpecialFolder) As FileInfo

    Return GetTempFile(Environment.GetFolderPath(folder), "tmp")

End Function

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Creates a uniquely named, zero-byte temporary file on the specified folder
''' and returns the file.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim tmpFile As FileInfo = GetTempFile(New DirectoryInfo("C:\Folder\"))
''' Console.WriteLine(tmpFile.FullName)
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="dir">
''' The folder where to create the temporary file.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The resulting <see cref="FileInfo"/>.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Function GetTempFile(ByVal dir As DirectoryInfo) As FileInfo

    Return GetTempFile(dir.FullName, "tmp")

End Function

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Creates a uniquely named, zero-byte temporary file on the system's default temporary folder with the specified file extension
''' and returns the file.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim tmpFile As FileInfo = GetTempFile("txt")
''' Console.WriteLine(tmpFile.FullName)
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="extension">
''' The file extension to assign to the temporary file.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The resulting <see cref="FileInfo"/>.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
''' <exception cref="ArgumentNullException">
''' extension
''' </exception>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Function GetTempFile(ByVal extension As String) As FileInfo

    Return GetTempFile(Environment.GetFolderPath(SpecialFolder.LocalApplicationData), extension)

End Function

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Creates a uniquely named, zero-byte temporary file on the specified folder with the specified file extension
''' and returns the file.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim tmpFile As FileInfo = GetTempFile(SpecialFolder.LocalApplicationData, "txt")
''' Console.WriteLine(tmpFile.FullName)
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="folder">
''' The folder where to create the temporary file.
''' </param>
'''
''' <param name="extension">
''' The file extension to assign to the temporary file.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The resulting <see cref="FileInfo"/>.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
''' <exception cref="ArgumentNullException">
''' extension
''' </exception>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Function GetTempFile(ByVal folder As SpecialFolder, ByVal extension As String) As FileInfo

    Return GetTempFile(Environment.GetFolderPath(folder), extension)

End Function

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Creates a uniquely named, zero-byte temporary file on the specified folder with the specified file extension
''' and returns the file.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim tmpFile As FileInfo = GetTempFile(New DirectoryInfo("C:\Folder\"), "txt")
''' Console.WriteLine(tmpFile.FullName)
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="dir">
''' The folder where to create the temporary file.
''' </param>
'''
''' <param name="extension">
''' The file extension to assign to the temporary file.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The resulting <see cref="FileInfo"/>.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
''' <exception cref="ArgumentNullException">
''' extension
''' </exception>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Function GetTempFile(ByVal dir As DirectoryInfo, ByVal extension As String) As FileInfo

    Return GetTempFile(dir.FullName, extension)

End Function

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Creates a uniquely named, zero-byte temporary file on the specified folder with the specified file extension
''' and returns the file.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim tmpFile As FileInfo = GetTempFile("C:\Folder\", "txt")
''' Console.WriteLine(tmpFile.FullName)
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="dirPath">
''' The full path of the folder where to create the temporary file.
''' </param>
'''
''' <param name="extension">
''' The file extension to assign to the temporary file.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The resulting <see cref="FileInfo"/>.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
''' <exception cref="ArgumentNullException">
''' dirPath or extension
''' </exception>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Function GetTempFile(ByVal dirPath As String, ByVal extension As String) As FileInfo

    If String.IsNullOrWhiteSpace(dirPath) Then
        Throw New ArgumentNullException("dirPath")

    ElseIf String.IsNullOrWhiteSpace(extension) Then
        Throw New ArgumentNullException("extension")

    Else
        Dim dir As New DirectoryInfo(dirPath)
        If Not (dir.Exists) Then
            Try
                dir.Create()
            Catch ex As Exception
                Throw
                Return Nothing
            End Try
        End If

        Dim tmpFile As FileInfo = Nothing
        Dim newFilePath As String
        Dim defaultFolderPath As String = Environment.GetFolderPath(SpecialFolder.LocalApplicationData)
        Dim defaultFileExtension As String = "tmp"
        Do
            If (tmpFile IsNot Nothing) AndAlso (tmpFile.Exists) Then
                tmpFile.Delete()
            End If
            tmpFile = New FileInfo(Path.GetTempFileName())

            If Not (dir.FullName.Equals(defaultFolderPath, StringComparison.OrdinalIgnoreCase)) Then
                newFilePath = Path.Combine(dir.FullName, tmpFile.Name)
            Else
                newFilePath = tmpFile.FullName
            End If

            If Not (extension.Equals(defaultFileExtension, StringComparison.OrdinalIgnoreCase)) Then
                newFilePath = Path.ChangeExtension(newFilePath, extension)
            End If

        Loop Until (newFilePath.Equals(tmpFile.FullName, StringComparison.OrdinalIgnoreCase)) OrElse Not File.Exists(newFilePath)

        tmpFile.MoveTo(newFilePath)
        tmpFile.Refresh()

        Return tmpFile

    End If

End Function

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Creates a uniquely named, zero-byte temporary file on the system's default temporary folder
''' and returns the file path.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim tmpFile As String = GetTempFileName()
''' Console.WriteLine(tmpFile)
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The full path of the temporary file.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Function GetTempFileName() As String

    Return Path.GetTempFileName()

End Function

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Creates a uniquely named, zero-byte temporary file on the specified folder
''' and returns the file path.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim tmpFile As String = GetTempFileName(SpecialFolder.LocalApplicationData)
''' Console.WriteLine(tmpFile)
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="folder">
''' The folder where to create the temporary file.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The full path of the temporary file.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Function GetTempFileName(ByVal folder As SpecialFolder) As String

    Return GetTempFile(Environment.GetFolderPath(folder), "tmp").FullName

End Function

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Creates a uniquely named, zero-byte temporary file on the specified folder
''' and returns the file path.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim tmpFile As String = GetTempFileName(New DirectoryInfo("C:\Folder\"))
''' Console.WriteLine(tmpFile)
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="dir">
''' The folder where to create the temporary file.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The full path of the temporary file.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Function GetTempFileName(ByVal dir As DirectoryInfo) As String

    Return GetTempFile(dir.FullName, "tmp").FullName

End Function

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Creates a uniquely named, zero-byte temporary file on the system's default temporary folder with the specified file extension
''' and returns the file path.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim tmpFile As String = GetTempFileName("txt")
''' Console.WriteLine(tmpFile)
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="extension">
''' The file extension to assign to the temporary file.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The full path of the temporary file.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
''' <exception cref="ArgumentNullException">
''' extension
''' </exception>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Function GetTempFileName(ByVal extension As String) As String

    Return GetTempFile(Environment.GetFolderPath(SpecialFolder.LocalApplicationData), extension).FullName

End Function

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Creates a uniquely named, zero-byte temporary file on the specified folder with the specified file extension
''' and returns the file path.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim tmpFile As String = GetTempFileName(SpecialFolder.LocalApplicationData, "txt")
''' Console.WriteLine(tmpFile)
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="folder">
''' The folder where to create the temporary file.
''' </param>
'''
''' <param name="extension">
''' The file extension to assign to the temporary file.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The full path of the temporary file.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
''' <exception cref="ArgumentNullException">
''' extension
''' </exception>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Function GetTempFileName(ByVal folder As SpecialFolder, ByVal extension As String) As String

    Return GetTempFile(Environment.GetFolderPath(folder), extension).FullName

End Function

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Creates a uniquely named, zero-byte temporary file on the specified folder with the specified file extension
''' and returns the file path.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim tmpFile As String = GetTempFileName(New DirectoryInfo("C:\Folder\"), "txt")
''' Console.WriteLine(tmpFile)
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="dir">
''' The folder where to create the temporary file.
''' </param>
'''
''' <param name="extension">
''' The file extension to assign to the temporary file.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The full path of the temporary file.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
''' <exception cref="ArgumentNullException">
''' extension
''' </exception>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Function GetTempFileName(ByVal dir As DirectoryInfo, ByVal extension As String) As String

    Return GetTempFile(dir.FullName, extension).FullName

End Function

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Creates a uniquely named, zero-byte temporary file on the specified folder with the specified file extension
''' and returns the file path.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <example> This is a code example.
''' <code>
''' Dim tmpFile As String = GetTempFileName("C:\Folder\", "txt")
''' Console.WriteLine(tmpFile)
''' </code>
''' </example>
''' ----------------------------------------------------------------------------------------------------
''' <param name="dirPath">
''' The full path of the folder where to create the temporary file.
''' </param>
'''
''' <param name="extension">
''' The file extension to assign to the temporary file.
''' </param>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The full path of the temporary file.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
''' <exception cref="ArgumentNullException">
''' dirPath or extension
''' </exception>
''' ----------------------------------------------------------------------------------------------------
<DebuggerStepThrough>
Public Shared Function GetTempFileName(ByVal dirPath As String, ByVal extension As String) As String

    Return GetTempFile(dirPath, extension).FullName

End Function


[Eleкtro]

Método Application.DoEvents() perfeccionado

Muchos programadores de VB.NET a veces se encuentran en un escenario de programación en el que deben realizar una operación asincrónica, pero en lugar de implementar el modo correcto de programación asincrónica suelen llamar al método Application.DoEvents() con la intención de esperar a que dicha operación asincrónica termine y evitar el bloqueo en el hilo de la interfáz gráfica. Esto se suele hacer decorando la llamada a dicho método usando un búcle, por ejemplo:

Código (vbnet) [Seleccionar] Expandir

Do While (condición)
    Application.DoEvents()
Loop

Sin embargo, hacer llamadas consecutivas a dicho método en un tiempo de intervalo demasiado corto (como en el búcle de arriba) causará un exceso muy importante de consumo de recursos en el equipo, puesto que basicamente lo que hace el método Application.DoEvents() es recibir, procesar, y despachar todos los mensajes pendientes en la cola, y no lo hace de forma selectiva, así que se procesan todos los mensajes de entrada/input, de dibujado/paint, los eventos, y etc, una y otra vez.

El método Application.DoEvents() tiene un propósito muy distinto del que realmente se le suele dar, y hay muchas formas de evitar tener que usar dicho método, pero no entraremos en esos temas ahora. Lo que explicaré será como poder mejorar el rendimiento y la responsabilidad de nuestra aplicación en un 90% al usar el método Application.DoEvents() cuando se le pretenda dar el uso que se ha explicado al principio.

Puesto que el método Application.DoEvents() se suele utilizar para aumentar la respuesta de la UI en una iteración intensiva, lo más apropiado para aumentar el rendimiento sería comprobar si existen mensajes de entrada (teclado o ratón) en la cola de mensajes del hilo de la UI antes de llamar a Application.DoEvents(). Y para ello existe una función Win32 a la que podemos recurrir presicamente para obtener un valor que nos diga si hay mensajes que se deban procesar o no los hay. La función se llama GetInputState, y en fin, todo esto que acabo de explicar quedaría implementado así:

Código (vbnet) [Seleccionar] Expandir

''' <summary>
''' Determines whether there are mouse-button or keyboard messages in the calling thread's message queue.
''' </summary>
''' <remarks>
''' <see href="https://msdn.microsoft.com/en-us/library/windows/desktop/ms644935(v=vs.85).aspx"/>
''' </remarks>
''' <returns>
''' If the queue contains one or more new mouse-button or keyboard messages, the return value is <see langword="True"/>.
''' <para></para>
''' If there are no new mouse-button or keyboard messages in the queue, the return value is <see langword="False"/>.
''' </returns>
<SuppressUnmanagedCodeSecurity>
<DllImport("user32.dll", SetLastError:=False)>
Private Shared Function GetInputState() As <MarshalAs(UnmanagedType.Bool)> Boolean
End Function

''' <summary>
''' Processes all Windows messages currently in the message queue of the application.
''' <para></para>
''' This method greatly boosts the performance of any application in difference to <see cref="Application.DoEvents()"/> method.
''' <para></para>
''' When calling <see cref="Application.DoEvents()"/> to make the UI responsive, it generally decreases application performance;
''' <para></para>
''' however, using this method, we make sure there is at least one input event (keyboard or mouse) that needs to be processed before internally calling <see cref="Application.DoEvents()"/>.
''' </summary>
Public Shared Sub DoEvents()
   If GetInputState() Then
       Global.System.Windows.Forms.Application.DoEvents()
   End If
End Sub

Modo de empleo:

Código (vbnet) [Seleccionar] Expandir

Do While True
    DoEvents()
Loop

[Eleкtro]

¿Cómo obtener la clave de producto instalada en Windows, o instalar un archivo de licencia, o una clave de producto de Windows, y como desinstalar la clave o eliminarla del registro de Windows?.

He desarrollado la siguiente clase para poder efectuar algunas operacioens básicas de licencia y activación en Windows, como instalar un archivo de licencia, obtener la clave de producto instalada en Windows, instalar una nueva  clave de producto de Windows, desinstalarla o eliminarla del registro de Windows (tal como hace la herramienta slmgr.vbs /cpky de Microsoft).

Lo he probado en Windows 10 x64, sin problemas. En teoría debería funcionar desde Windows 7 para adelante, y versiones Windows Server desde la 2008 R2 para adelante.

Todo el código fuente está documentado y además los miembros incluyen ejemplos de uso documentados, no creo que haga falta explicar mucho más.

Código (vbnet) [Seleccionar] Expandir

' ***********************************************************************
' Author   : Elektro
' Modified : 01-June-2017
' ***********************************************************************

#Region " Public Members Summary "

#Region " Properties "

' ProductId As String
' ProductKey As String

#End Region

#Region " Methods "

' InstallLicense(String)
' InstallLicense(FileInfo)

' InstallProductKey(String)

' UninstallProductKey()

' RemoveProductKeyFromRegistry()

' RefreshLicenseStatus()

#End Region

#End Region

#Region " Option Statements "

Option Strict On
Option Explicit On
Option Infer Off

#End Region

#Region " Imports "

Imports Microsoft.Win32

Imports System.IO
Imports System.Management
Imports System.Runtime.InteropServices

' Imports Elektro.Core.Types

#End Region

#Region " Licensing Util "

' Namespace Tools.Shell

   ''' ----------------------------------------------------------------------------------------------------
   ''' <summary>
   ''' Contains Windows licensing related utilities.
   ''' </summary>
   ''' ----------------------------------------------------------------------------------------------------
   Public NotInheritable Class Licensing ' : Inherits AestheticObject

#Region " Constructors "

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Prevents a default instance of the <see cref="Licensing"/> class from being created.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerNonUserCode>
       Private Sub New()
       End Sub

#End Region

#Region " Properties "

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets the Windows product identifier of the current operating system.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <example> This is a code example.
       ''' <code>
       ''' Dim productId As String = ProductId()
       ''' Console.WriteLine(productId)
       ''' </code>
       ''' </example>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <value>
       ''' The Windows product identifier.
       ''' </value>
       ''' ----------------------------------------------------------------------------------------------------
       Public Shared ReadOnly Property ProductId As String
           <DebuggerStepThrough>
           Get
               Return Licensing.GetWindowsProductId()
           End Get
       End Property

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets the Windows product key of the current operating system.
       ''' <para></para>
       ''' Note that the value could be <see langword="Nothing"/> in case of the product key was
       ''' completely removed from the Windows Registry (eg. using tools like <c>slmgr.vbs /cpky</c>).
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <remarks>
       ''' Credits to: <see href="https://github.com/mrpeardotnet/WinProdKeyFinder"/>
       ''' </remarks>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <example> This is a code example.
       ''' <code>
       ''' Dim productKey As String = ProductKey()
       ''' Console.WriteLine(productKey)
       ''' </code>
       ''' </example>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <value>
       ''' The Windows product key, or <see langword="Nothing"/> in case of the product key was
       ''' completely removed from the Windows Registry (eg. using tools like <c>slmgr.vbs /cpky</c>).
       ''' </value>
       ''' ----------------------------------------------------------------------------------------------------
       Public Shared ReadOnly Property ProductKey As String
           <DebuggerStepThrough>
           Get
               Return Licensing.GetWindowsProductKey()
           End Get
       End Property

#End Region

#Region " Public Methods "

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Installs a Windows license on the current operating system.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <remarks>
       ''' <see href="https://msdn.microsoft.com/en-us/library/cc534589(v=vs.85).aspx"/>
       ''' </remarks>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <example> This is a code example.
       ''' <code>
       ''' Dim licFilepath As String = "C:\License.lic"
       ''' InstallLicense(licFilepath)
       ''' </code>
       ''' </example>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="licFilepath">
       ''' The license file path.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Shared Sub InstallLicense(ByVal licFilepath As String)

           Licensing.InstallLicense(New FileInfo(licFilepath))

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Installs a Windows license on the current operating system.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <remarks>
       ''' <see href="https://msdn.microsoft.com/en-us/library/cc534589(v=vs.85).aspx"/>
       ''' </remarks>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <example> This is a code example.
       ''' <code>
       ''' Dim licFile As New FileInfo("C:\License.lic")
       ''' InstallLicense(licFile)
       ''' </code>
       ''' </example>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="licFile">
       ''' The license file.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <exception cref="PlatformNotSupportedException">
       ''' Windows 7 or newer is required to use this feature.
       ''' </exception>
       '''
       ''' <exception cref="FileNotFoundException">
       ''' License file not found.
       ''' </exception>
       '''
       ''' <exception cref="Exception">
       ''' The Software Licensing Service determined that the license is invalid.
       ''' or
       ''' Unknown error occurred during the license installation attempt.
       ''' </exception>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Shared Sub InstallLicense(ByVal licFile As FileInfo)

           If Not (IsWin7OrGreater) Then
              Throw New PlatformNotSupportedException("Windows 7 or newer is required to use this feature.")
           End If

           If Not licFile.Exists Then
               Throw New FileNotFoundException("License file not found.", licFile.FullName)
           End If

           Dim licData As String = File.ReadAllText(licFile.FullName)

           Using query As New ManagementObjectSearcher("SELECT Version FROM SoftwareLicensingService")

               For Each product As ManagementObject In query.Get()

                   Dim result As UInteger
                   Try
                       result = CUInt(product.InvokeMethod("InstallLicense", {licData}))

                   Catch ex As COMException When (ex.HResult = -1073418209)
                       Throw New Exception("The Software Licensing Service determined that the license is invalid.", ex)

                   Catch ex As COMException
                       Marshal.ThrowExceptionForHR(ex.HResult)

                   Catch ex As Exception
                       Throw

                   End Try

                   If (result <> 0UI) Then
                       Throw New Exception("Unknown error occurred during the license installation attempt.")
                   End If

               Next product

           End Using

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Installs a Windows product key on the current operating system.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <remarks>
       ''' <see href="https://msdn.microsoft.com/en-us/library/cc534590(v=vs.85).aspx"/>
       ''' </remarks>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <example> This is a code example.
       ''' <code>
       ''' Dim productKey As String = "YTMG3-N6DKC-DKB77-7M9GH-8HVX7"
       ''' InstallProductKey(productKey)
       ''' </code>
       ''' </example>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <param name="productKey">
       ''' The product key.
       ''' </param>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <exception cref="PlatformNotSupportedException">
       ''' Windows 7 or newer is required to use this feature.
       ''' </exception>
       '''
       ''' <exception cref="ArgumentNullException">
       ''' productKey
       ''' </exception>
       '''
       ''' <exception cref="Exception">
       ''' The Software Licensing Service determined that the product key is invalid.
       ''' or
       ''' Unknown error occurred during the product key installation attempt.
       ''' </exception>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Shared Sub InstallProductKey(ByVal productKey As String)

           If Not (IsWin7OrGreater) Then
              Throw New PlatformNotSupportedException("Windows 7 or newer is required to use this feature.")
           End If

           If String.IsNullOrWhiteSpace(productKey) Then
               Throw New ArgumentNullException("productKey")
           End If

           Using query As New ManagementObjectSearcher("SELECT Version FROM SoftwareLicensingService")

               For Each product As ManagementObject In query.Get()

                   Dim result As UInteger
                   Try
                       result = CUInt(product.InvokeMethod("InstallProductKey", {productKey}))
                       ' Installing a product key could change Windows licensing state.
                       ' Since the service determines if it can shut down and when is the next start time
                       ' based on the licensing state we should reconsume the licenses here.
                       product.InvokeMethod("RefreshLicenseStatus", Nothing)

                   Catch ex As COMException When (ex.HResult = -1073418160)
                       Throw New Exception("The Software Licensing Service determined that the product key is invalid.", ex)

                   Catch ex As COMException
                       Marshal.ThrowExceptionForHR(ex.HResult)

                   Catch ex As Exception
                       Throw

                   End Try

                   If (result <> 0UI) Then
                       Throw New Exception("Unknown error occurred during the product key installation attempt.")
                   End If

               Next product

           End Using

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Uninstall the Windows product key of the current operating system.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <remarks>
       ''' <see href="https://msdn.microsoft.com/en-us/library/cc534599(v=vs.85).aspx"/>
       ''' </remarks>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <exception cref="PlatformNotSupportedException">
       ''' Windows 7 or newer is required to use this feature.
       ''' </exception>
       '''
       ''' <exception cref="Exception">
       ''' Unknown error occurred during the product key uninstallation attempt.
       ''' </exception>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Shared Sub UninstallProductKey()

           If Not (IsWin7OrGreater) Then
              Throw New PlatformNotSupportedException("Windows 7 or newer is required to use this feature.")
           End If

           Using query As New ManagementObjectSearcher("SELECT Version FROM SoftwareLicensingProduct")

               For Each product As ManagementObject In query.Get()

                   Dim result As UInteger
                   Try
                       result = CUInt(product.InvokeMethod("UninstallProductKey", Nothing))
                       ' Uninstalling a product key could change Windows licensing state.
                       ' Since the service determines if it can shut down and when is the next start time
                       ' based on the licensing state we should reconsume the licenses here.
                       product.InvokeMethod("RefreshLicenseStatus", Nothing)

                   Catch ex As COMException
                       Marshal.ThrowExceptionForHR(ex.HResult)

                   Catch ex As Exception
                       Throw

                   End Try

                   If (result <> 0UI) Then
                       Throw New Exception("Unknown error occurred during the product key removal attempt.")
                   End If

               Next product

           End Using

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Removes the Windows product key from registry (to prevent unauthorized diffusion)
       ''' of the current operating system.
       ''' <para></para>
       ''' It does not uninstall the product key.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <remarks>
       ''' <see href="https://msdn.microsoft.com/en-us/library/cc534586(v=vs.85).aspx"/>
       ''' </remarks>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <exception cref="PlatformNotSupportedException">
       ''' Windows 7 or newer is required to use this feature.
       ''' </exception>
       '''
       ''' <exception cref="Exception">
       ''' Unknown error occurred during the product key removal attempt.
       ''' </exception>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Shared Sub RemoveProductKeyFromRegistry()

           If Not (IsWin7OrGreater) Then
              Throw New PlatformNotSupportedException("Windows 7 or newer is required to use this feature.")
           End If

           Using query As New ManagementObjectSearcher("SELECT Version FROM SoftwareLicensingService")

               For Each product As ManagementObject In query.Get()

                   Dim result As UInteger
                   Try
                       result = CUInt(product.InvokeMethod("ClearProductKeyFromRegistry", Nothing))

                   Catch ex As COMException
                       Marshal.ThrowExceptionForHR(ex.HResult)

                   Catch ex As Exception
                       Throw

                   End Try

                   If (result <> 0UI) Then
                       Throw New Exception("Unknown error occurred during the product key removal attempt.")
                   End If

               Next product

           End Using

       End Sub

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Updates the licensing status of the machine so that applications have access to current licensing information.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <remarks>
       ''' <see href="https://msdn.microsoft.com/en-us/library/cc534592(v=vs.85).aspx"/>
       ''' </remarks>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <exception cref="PlatformNotSupportedException">
       ''' Windows 7 or newer is required to use this feature.
       ''' </exception>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepThrough>
       Public Shared Sub RefreshLicenseStatus()

           If Not (IsWin7OrGreater) Then
              Throw New PlatformNotSupportedException("Windows 7 or newer is required to use this feature.")
           End If

           Using query As New ManagementObjectSearcher("SELECT Version FROM SoftwareLicensingService")

               For Each product As ManagementObject In query.Get()
                   product.InvokeMethod("RefreshLicenseStatus", Nothing)
               Next product

           End Using

       End Sub

#End Region

#Region " Private Members "

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets a value that determines whether the current operating system is <c>Windows 7</c>, or greater.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <example> This is a code example.
       ''' <code>
       ''' If Not IsWin7OrGreater Then
       '''     Throw New PlatformNotSupportedException("This application cannot run under the current Windows version.")
       ''' End If
       ''' </code>
       ''' </example>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <value>
       ''' A value that determines whether the current operating system is <c>Windows 7</c>, or greater.
       ''' </value>
       ''' ----------------------------------------------------------------------------------------------------
       Private Shared ReadOnly Property IsWin7OrGreater() As Boolean
           <DebuggerStepThrough>
           Get
               Return (Environment.OSVersion.Platform = PlatformID.Win32NT) AndAlso
                      (Environment.OSVersion.Version.CompareTo(New Version(6, 1)) >= 0)
           End Get
       End Property

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets a value that determines whether the current operating system is <c>Windows 8</c>, or greater.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <example> This is a code example.
       ''' <code>
       ''' If Not IsWin8OrGreater Then
       '''     Throw New PlatformNotSupportedException("This application cannot run under the current Windows version.")
       ''' End If
       ''' </code>
       ''' </example>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <value>
       ''' A value that determines whether the current operating system is <c>Windows 8</c>, or greater.
       ''' </value>
       ''' ----------------------------------------------------------------------------------------------------
       Private Shared ReadOnly Property IsWin8OrGreater() As Boolean
           <DebuggerStepThrough>
           Get
               Return (Environment.OSVersion.Platform = PlatformID.Win32NT) AndAlso
                      (Environment.OSVersion.Version.CompareTo(New Version(6, 2)) >= 0)
           End Get
       End Property

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets the Windows product key.
       ''' <para></para>
       ''' Note that the return value could be <see langword="Nothing"/> in case of the product key was
       ''' completely removed from the Windows Registry (eg. using tools like <c>slmgr.vbs /cpky</c>).
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <remarks>
       ''' <see href="https://msdn.microsoft.com/en-us/library/windows/desktop/aa394239(v=vs.85).aspx"/>
       ''' </remarks>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <returns>
       ''' The Windows product key, or <see langword="Nothing"/> in case of the product key was
       ''' completely removed from the Windows Registry (eg. using tools like <c>slmgr.vbs /cpky</c>).
       ''' </returns>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepperBoundary>
       Private Shared Function GetWindowsProductId() As String

           Dim result As String = Nothing

           Using query As New ManagementObjectSearcher("SELECT SerialNumber FROM Win32_OperatingSystem")

               For Each product As ManagementObject In query.Get()
                   result = CStr(product.Properties("SerialNumber").Value)
               Next product

           End Using

           Return result

       End Function

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Gets the Windows product key.
       ''' <para></para>
       ''' Note that the return value could be <see langword="Nothing"/> in case of the product key was
       ''' completely removed from the Windows Registry (eg. using tools like <c>slmgr.vbs /cpky</c>).
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <remarks>
       ''' Credits to: <see href="https://github.com/mrpeardotnet/WinProdKeyFinder"/>
       ''' </remarks>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <returns>
       ''' The Windows product key, or <see langword="Nothing"/> in case of the product key was
       ''' completely removed from the Windows Registry (eg. using tools like <c>slmgr.vbs /cpky</c>).
       ''' </returns>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepperBoundary>
       Private Shared Function GetWindowsProductKey() As String

           Dim regKey As RegistryKey
           Dim regValue As Byte()
           Dim productKey As String

           If Environment.Is64BitOperatingSystem Then
               regKey = RegistryKey.OpenBaseKey(RegistryHive.LocalMachine, RegistryView.Registry64)
           Else
               regKey = RegistryKey.OpenBaseKey(RegistryHive.LocalMachine, RegistryView.Registry32)
           End If

           Using regKey
               regValue = DirectCast(regKey.OpenSubKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion").
                                            GetValue("DigitalProductId", New Byte() {}, RegistryValueOptions.None),
                                            Byte())
           End Using

           productKey = Licensing.DecodeProductKey(regValue)
           Return productKey

       End Function

       ''' ----------------------------------------------------------------------------------------------------
       ''' <summary>
       ''' Decode and return the Windows Product Key that is encoded in the specified Windows Product Identifier.
       ''' </summary>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <remarks>
       ''' Credits to: <see href="https://github.com/mrpeardotnet/WinProdKeyFinder"/>
       ''' </remarks>
       ''' ----------------------------------------------------------------------------------------------------
       ''' <returns>
       ''' The Windows product key, or <see langword="Nothing"/> in case of the product key was
       ''' completely removed from the Windows Registry (eg. using tools like <c>slmgr.vbs /cpky</c>).
       ''' </returns>
       ''' ----------------------------------------------------------------------------------------------------
       <DebuggerStepperBoundary>
       Private Shared Function DecodeProductKey(ByVal windowsProductId As Byte()) As String

           If (IsWin8OrGreater) Then ' Decode key from Windows 8 to Windows 10

               Dim key As String = String.Empty
               Dim keyOffset As Integer = 52
               Dim isWin8 As Byte = CByte((windowsProductId(66) \ 6) And 1)
               windowsProductId(66) = CByte((windowsProductId(66) And &HF7) Or (isWin8 And 2) * 4)
               Dim digits As String = "BCDFGHJKMPQRTVWXY2346789"
               Dim last As Integer = 0

               For i As Integer = 24 To 0 Step -1
                   Dim current As Integer = 0
                   For j As Integer = 14 To 0 Step -1
                       current = current * 256
                       current = windowsProductId(j + keyOffset) + current
                       windowsProductId(j + keyOffset) = CByte(current \ 24)
                       current = current Mod 24
                       last = current
                   Next
                   key = digits(current) + key
               Next
               If (key = "BBBBBBBBBBBBBBBBBBBBBBBBB") Then
                   Return Nothing
               End If

               Dim keypart1 As String = key.Substring(1, last)
               Dim keypart2 As String = key.Substring(last + 1, key.Length - (last + 1))
               key = keypart1 & "N" & keypart2

               For i As Integer = 5 To (key.Length - 1) Step 6
                   key = key.Insert(i, "-")
               Next i

               Return key

           Else ' Decode key from Windows XP to Windows 7
               Dim keyStartIndex As Integer = 52
               Dim keyEndIndex As Integer = keyStartIndex + 15
               Dim decodeLength As Integer = 29
               Dim decodeStringLength As Integer = 15
               Dim decodedChars As Char() = New Char(decodeLength - 1) {}
               Dim hexPid As New ArrayList()
               Dim digits As Char() = {
                       "B"c, "C"c, "D"c, "F"c, "G"c, "H"c,
                       "J"c, "K"c, "M"c, "P"c, "Q"c, "R"c,
                       "T"c, "V"c, "W"c, "X"c, "Y"c, "2"c,
                       "3"c, "4"c, "6"c, "7"c, "8"c, "9"c
               }

               For i As Integer = keyStartIndex To keyEndIndex
                   hexPid.Add(windowsProductId(i))
               Next i

               For i As Integer = (decodeLength - 1) To 0 Step -1
                   ' Every sixth char is a separator.
                   If (i + 1) Mod 6 = 0 Then
                       decodedChars(i) = "-"c

                   Else
                       ' Do the actual decoding.
                       Dim digitMapIndex As Integer = 0
                       For j As Integer = (decodeStringLength - 1) To 0 Step -1
                           Dim byteValue As Integer = (digitMapIndex << 8) Or CByte(hexPid(j))
                           hexPid(j) = CByte(byteValue \ 24)
                           digitMapIndex = byteValue Mod 24
                           decodedChars(i) = digits(digitMapIndex)
                       Next

                   End If

               Next i

               Return New String(decodedChars)

           End If

       End Function

#End Region

   End Class

' End Namespace

#End Region


[Eleкtro]

¿Cómo bloquear la ejecución del administrador de tareas de Windows?

Este código lo he desarrollado para darle solución al siguiente problema: bloquear la ejecución del administrador de tareas de Windows (taskmgr.exe)

Además de eso, el código también bloquea la ejecución del hijack/sustituto del admiinstrador de tareas... suponiendo que el usuario haya definido tal hijack en el registro de Windows, claro está.

La metodología que he usado es la más sencilla (y por ende también la más eludible): abrir el stream del archivo para mantenerlo en uso y prohibir la compartición del archivo.
De esta manera, y mientras tengamos abierto el stream en nuestra aplicación, evitaremos una ejecución a demanda del administrador de tareas, incluyendo el intento de ejecución desde el diálogo de Logon de Windows.

Por supuesto el efecto no es permanente, tan solo perdurará hasta que nuestra aplicación finalice su ejecución o hasta que por el motivo que sea decidamos liberar el stream manualmente.

He usado esta metodología basicamente por que la intención de esto no es el desarrollo de malware (y para ser sincero no he querido complicarme más la vida puesto que el diseño de Malware y la ing. inversa no es mi fuerte), sino una simple utilidad a la que darle un uso ético, como por ejemplo podría ser poner impedimentos para intentar evitar que el usuario pueda matar nuestro proceso mientras estamos realizando una operación crítica e irreversible que podria dañar el sistema operativo si se detiene de forma anómala.

Código (vbnet) [Seleccionar] Expandir

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Prevents any attempt for the current user from reading and running the 'taskmgr.exe' file
''' and any defined hijack in the system (if any)
''' <para></para>
''' Note that the file blocking is not permanent.
''' <para></para>
''' This function will return a <see cref="FileStream"/> Array that contains the 'taskmgr.exe' file stream(s)
''' opened with <see cref="FileAccess.Read"/> access and <see cref="FileShare.None"/> sharing.
''' <para></para>
''' So in order to unblock the access to the file(s), just dispose the opened stream(s) or terminate the calling aplication.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' A <see cref="FileStream"/> Array that contains the 'taskmgr.exe' file stream(s)
''' opened with <see cref="FileAccess.Read"/> access and <see cref="FileShare.None"/> sharing.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
Public Shared Function BlockWindowsTaskManager() As FileStream()

   ' Build a list with the legit tskmgr.exe file(s).
   Dim tkmgrFiles As New List(Of FileInfo) From { ' C:\Windows\System32\taskmgr.exe
       New FileInfo(Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.System), "taskmgr.exe"))
   }
   If (Environment.Is64BitOperatingSystem) AndAlso (Environment.Is64BitProcess) Then ' C:\Windows\SysWOW64\taskmgr.exe
       tkmgrFiles.Add(New FileInfo(Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.SystemX86), "taskmgr.exe")))
   End If

   ' Add to the list the taskmgr.exe hijacked file, if any.
   Dim hijackValue As String = GetTaskManagerHijack()
   If Not String.IsNullOrWhiteSpace(hijackValue) Then
       tkmgrFiles.Add(New FileInfo(hijackValue))
   End If

   ' Build a list where to add the open file streams.
   Dim tkmgrStreams As New List(Of FileStream)

   tkmgrFiles.ForEach(
       Sub(ByVal file As FileInfo)
           ' Ensure that any instance of the taskmgr processes are running; otherwise, we must terminate them.
           Dim processName As String = Path.GetFileNameWithoutExtension(file.Name)
           For Each p As Process In Process.GetProcessesByName(processName)
               Using p
                   Try
                       If Not (p.HasExited) Then
                           p.Kill()
                           ' Wait a reasonable time interval if stuck/hanged process.
                           p.WaitForExit(CInt(TimeSpan.FromSeconds(10).TotalMilliseconds))
                       End If
                   Catch ex As Exception ' Failed to terminate the process
                       ' Since we can still block an open file (if it was open with read sharing) but
                       ' we can't terminate the current running/unblocked instance,
                       ' so we conclude the overall operation failed and rollback previous blocks then finish here.
                       tkmgrStreams.ForEach(Sub(sr As Stream) sr.Dispose())
                       Throw
                   End Try
               End Using ' p
           Next p

           If (file.Exists()) Then
               Dim fs As FileStream
               Try
                   fs = file.Open(FileMode.Open, FileAccess.Read, FileShare.None)
                   tkmgrStreams.Add(fs)

                   ' Catch ex As IOException When (ex.HResult = -2147024864) ' File its being used by this or another process.
                   ' This exception can occur if calling this function twice without disposing the returned stream(s) before the second call.

               Catch ex As Exception ' File can't be opened for whatever reason.
                   ' Since we can't open/block all the required files,
                   ' we conclude the overall operation failed and rollback previous blocks then finish here.
                   tkmgrStreams.ForEach(Sub(sr As Stream) sr.Dispose())
                   Throw

               End Try
           End If

       End Sub)

   Return tkmgrStreams.ToArray()

End Function

+

Código (vbnet) [Seleccionar] Expandir

''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Determines whether the legit 'taskmgr.exe' file has a hijack defined in the Windows registry,
''' then returns the registry value that points to the hijack file path.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
''' <returns>
''' The resulting hijack registry value,
''' or <see langword="Nothing"/> (null) if a 'taskmgr.exe' hijack doesn't exist.
''' </returns>
''' ----------------------------------------------------------------------------------------------------
Public Shared Function GetTaskManagerHijack() As String

   Dim hijackSubkey As String = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\taskmgr.exe"

   Using regKey As RegistryKey = RegistryKey.OpenBaseKey(RegistryHive.LocalMachine, RegistryView.Default)

       Return DirectCast(regKey.OpenSubKey(hijackSubkey, RegistryRights.ReadKey)?.
                                GetValue("Debugger", Nothing, RegistryValueOptions.None), String)

   End Using

End Function

Ejemplo de uso:

Código (vbnet) [Seleccionar] Expandir

Dim tskmgrFiles As FileStream() = BlockWindowsTaskManager()
For Each fs As FileStream In tskmgrFiles
   Debug.WriteLine(fs.Name)
   ' fs.Close() ' Call this to unblock file access.
Next fs

Resultado de ejecución en mi equipo de 64-Bits con Windows 10 instalado donde tengo asignado un hijack para correr el administrador de tareas de Windows 7 en lugar del de Windows 10:

C:\Windows\system32\taskmgr.exe
C:\Windows\SysWOW64\taskmgr.exe
C:\Windows\system32\taskmgr7.exe

Hasta donde yo he probado, funciona.

Nótese que para optimizar los resultados el executable que llame a la función BlockWindowsTaskManager() debe ser de la misma arquitectura que el sistema operativo donde éste sea ejecutado, pues si Windows es de 64-Bit y nuestro executable es de 32, entonces Windows automáticamente hará redirección WOW64, o dicho de otra forma si estamos en Win64 y llamamos a la función BlockWindowsTaskManager() desde un WinExe32 entonces tan solo podremos bloquear 1 taskmgr.exe de los 2 taskmgr.exe legítimos en Windows x64. Y lo mismo sucederá con el hijack puesto que un executable de 32 bits no puede acceder al visor de registro de 64 bits.

Saludos!