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

[Eleкtro]

Ejemplo de como encontrar e invocar un método usando Reflection, si solo tenemos un String que contiene el nombre del método, y como pasarle un parámetro nulo al invocar.

Código (vbnet) [Seleccionar] Expandir

Imports System.Reflection
Imports System.Globalization

Public Class Form1

    Private Shadows Sub Load() Handles MyBase.Load

        Dim MethodName As String = "Test"

        Dim Method As MethodInfo =
            Me.GetType().GetMethod(MethodName, BindingFlags.IgnoreCase Or BindingFlags.Instance Or
                                               BindingFlags.Public Or BindingFlags.NonPublic)

        If Method IsNot Nothing Then
            Method.Invoke(Me, BindingFlags.IgnoreCase Or BindingFlags.Instance Or
                              BindingFlags.Public Or BindingFlags.NonPublic,
                          Nothing,
                          New Object() {"Hello World!", Type.Missing}, CultureInfo.InvariantCulture)

        Else
            MsgBox("Method not found.")

        End If

    End Sub

    Private Sub Test(ByVal StringValue As String, Optional ByVal IntValue As Integer = 1)
        MessageBox.Show(StringValue & IntValue)
    End Sub

End Class



Un DateDifference personalizado:

Código (vbnet) [Seleccionar] Expandir

    ' Date Difference
    ' ( By Elektro )
    '
    ' Usage Examples :
    '
    ' MsgBox(DateDifference(DateTime.Parse("01/03/2013 00:00:00"),
    '                       DateTime.Parse("09/04/2014 01:01:01"),
    '                       "{0} Year(s), {1} Month(s), {2} Week(s), {3} Day(s), {4} Hour(s), {5} Minute(s) and {6} Second(s)"))

    ''' <summary>
    ''' Shows the difference between two dates with custom string format.
    ''' </summary>
    ''' <param name="Date1">Indicates the first date to compare.</param>
    ''' <param name="Date2">Indicates the second date to compare.</param>
    ''' <param name="StringFormat">
    ''' Indicates the string format to display the difference, where:
    ''' {0} = Years, {1} = Months, {2} = Weeks, {3} = Days, {4} = Hours, {5} = Minutes and {6} = Seconds</param>
    ''' <returns>System.String.</returns>
    Private Function DateDifference(ByVal Date1 As DateTime,
                                    ByVal Date2 As DateTime,
                                    ByVal StringFormat As String) As String

        Dim Time As TimeSpan
        Dim YearDiff As Integer, MonthDiff As Integer, WeekDiff As Integer

        Do Until Date1 > Date2

            Date1 = Date1.AddMonths(1)
            MonthDiff += 1

            If MonthDiff = 12 Then
                YearDiff += 1
                MonthDiff = 0
            End If

        Loop

        MonthDiff -= 1
        Date1 = Date1.AddMonths(-1)
        Time = (Date2 - Date1)
        WeekDiff = (Time.Days \ 7)
        Time = (Time - TimeSpan.FromDays(WeekDiff * 7))

        Return String.Format(StringFormat, YearDiff, MonthDiff, WeekDiff, Time.Days, Time.Hours, Time.Minutes, Time.Seconds)

    End Function

[Eleкtro]

Un helper class para el método SendInput de la WinAPI

Synthesizes keystrokes, mouse motions, and button clicks.

PD: El método 'sendkeys' no es 100% perfecto con caracteres especiales como la 'Ñ', pero tampoco lo voy a elaborar más por el momento,ya que es un coñazo por los distintos layouts del teclado.

Código (vbnet) [Seleccionar] Expandir

' ***********************************************************************
' Author   : Elektro
' Modified : 02-21-2014
' ***********************************************************************
' <copyright file="SendInputs.vb" company="Elektro Studios">
'     Copyright (c) Elektro Studios. All rights reserved.
' </copyright>
' ***********************************************************************

#Region " Usage Examples "

'Private Sub Test() Handles Button1.Click

' AppActivate(Process.GetProcessesByName("notepad").First.Id)

' Dim c As Char = Convert.ToChar(Keys.Oemtilde) ' Ñ
' Dim Result As Integer = SendInputs.SendKey(Convert.ToChar(c.ToString.ToLower))
' MessageBox.Show(String.Format("Successfull events: {0}", CStr(Result)))

' SendInputs.SendKey(Keys.Enter)
' SendInputs.SendKey(Convert.ToChar(Keys.Back))
' SendInputs.SendKeys("Hello World", True)
' SendInputs.SendKey(Convert.ToChar(Keys.D0))
' SendInputs.SendKeys(Keys.Insert, BlockInput:=True)

' SendInputs.MouseClick(SendInputs.MouseButton.RightPress, False)
' SendInputs.MouseMove(5, -5)
' SendInputs.MousePosition(New Point(100, 500))

'End Sub

#End Region

#Region " Imports "

Imports System.Runtime.InteropServices
Imports System.ComponentModel

#End Region

''' <summary>
''' Synthesizes keystrokes, mouse motions, and button clicks.
''' </summary>
Public Class SendInputs

#Region " P/Invoke "

   Friend Class NativeMethods

#Region " Methods "

       ''' <summary>
       ''' Blocks keyboard and mouse input events from reaching applications.
       ''' For more info see here:
       ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms646290%28v=vs.85%29.aspx
       ''' </summary>
       ''' <param name="fBlockIt">
       ''' The function's purpose.
       ''' If this parameter is 'TRUE', keyboard and mouse input events are blocked.
       ''' If this parameter is 'FALSE', keyboard and mouse events are unblocked.
       ''' </param>
       ''' <returns>
       ''' If the function succeeds, the return value is nonzero.
       ''' If input is already blocked, the return value is zero.
       ''' </returns>
       ''' <remarks>
       ''' Note that only the thread that blocked input can successfully unblock input.
       ''' </remarks>
       <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall,
       SetLastError:=True)>
       Friend Shared Function BlockInput(
              ByVal fBlockIt As Boolean
       ) As Integer
       End Function

       ''' <summary>
       ''' Synthesizes keystrokes, mouse motions, and button clicks.
       ''' For more info see here:
       ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms646310%28v=vs.85%29.aspx
       ''' </summary>
       ''' <param name="nInputs">
       ''' Indicates the number of structures in the pInputs array.
       ''' </param>
       ''' <param name="pInputs">
       ''' Indicates an Array of 'INPUT' structures.
       ''' Each structure represents an event to be inserted into the keyboard or mouse input stream.
       ''' </param>
       ''' <param name="cbSize">
       ''' The size, in bytes, of an 'INPUT' structure.
       ''' If 'cbSize' is not the size of an 'INPUT' structure, the function fails.
       ''' </param>
       ''' <returns>
       ''' The function returns the number of events that it successfully
       ''' inserted into the keyboard or mouse input stream.
       ''' If the function returns zero, the input was already blocked by another thread.
       ''' </returns>
       <DllImport("user32.dll", SetLastError:=True)>
       Friend Shared Function SendInput(
              ByVal nInputs As Integer,
              <MarshalAs(UnmanagedType.LPArray), [In]> ByVal pInputs As INPUT(),
              ByVal cbSize As Integer
       ) As Integer
       End Function

#End Region

#Region " Enumerations "

       ''' <summary>
       ''' VirtualKey codes.
       ''' </summary>
       Friend Enum VirtualKeys As Short

           ''' <summary>
           ''' The Shift key.
           ''' VK_SHIFT
           ''' </summary>
           SHIFT = &H10S

           ''' <summary>
           ''' The DEL key.
           ''' VK_DELETE
           ''' </summary>
           DELETE = 46S

           ''' <summary>
           ''' The ENTER key.
           ''' VK_RETURN
           ''' </summary>
           [RETURN] = 13S

       End Enum

       ''' <summary>
       ''' The type of the input event.
       ''' For more info see here:
       ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms646270%28v=vs.85%29.aspx
       ''' </summary>
       <Description("Enumeration used for 'type' parameter of 'INPUT' structure")>
       Friend Enum InputType As Integer

           ''' <summary>
           ''' The event is a mouse event.
           ''' Use the mi structure of the union.
           ''' </summary>
           Mouse = 0

           ''' <summary>
           ''' The event is a keyboard event.
           ''' Use the ki structure of the union.
           ''' </summary>
           Keyboard = 1

           ''' <summary>
           ''' The event is a hardware event.
           ''' Use the hi structure of the union.
           ''' </summary>
           Hardware = 2

       End Enum

       ''' <summary>
       ''' Specifies various aspects of a keystroke.
       ''' This member can be certain combinations of the following values.
       ''' For more info see here:
       ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms646271%28v=vs.85%29.aspx
       ''' </summary>
       <Description("Enumeration used for 'dwFlags' parameter of 'KeyboardInput' structure")>
       <Flags>
       Friend Enum KeyboardInput_Flags As Integer

           ''' <summary>
           ''' If specified, the scan code was preceded by a prefix byte that has the value '0xE0' (224).
           ''' </summary>
           ExtendedKey = &H1

           ''' <summary>
           ''' If specified, the key is being pressed.
           ''' </summary>
           KeyDown = &H0

           ''' <summary>
           ''' If specified, the key is being released.
           ''' If not specified, the key is being pressed.
           ''' </summary>
           KeyUp = &H2

           ''' <summary>
           ''' If specified, 'wScan' identifies the key and 'wVk' is ignored.
           ''' </summary>
           ScanCode = &H8

           ''' <summary>
           ''' If specified, the system synthesizes a 'VK_PACKET' keystroke.
           ''' The 'wVk' parameter must be '0'.
           ''' This flag can only be combined with the 'KEYEVENTF_KEYUP' flag.
           ''' </summary>
           Unicode = &H4

       End Enum

       ''' <summary>
       ''' A set of bit flags that specify various aspects of mouse motion and button clicks.
       ''' The bits in this member can be any reasonable combination of the following values.
       ''' For more info see here:
       ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms646273%28v=vs.85%29.aspx
       ''' </summary>
       <Description("Enumeration used for 'dwFlags' parameter of 'MouseInput' structure")>
       <Flags>
       Friend Enum MouseInput_Flags As Integer

           ''' <summary>
           ''' The 'dx' and 'dy' members contain normalized absolute coordinates.
           ''' If the flag is not set, 'dx' and 'dy' contain relative data
           ''' (the change in position since the last reported position).
           ''' This flag can be set, or not set,
           ''' regardless of what kind of mouse or other pointing device, if any, is connected to the system.
           ''' </summary>
           Absolute = &H8000I

           ''' <summary>
           ''' Movement occurred.
           ''' </summary>
           Move = &H1I

           ''' <summary>
           ''' The 'WM_MOUSEMOVE' messages will not be coalesced.
           ''' The default behavior is to coalesce 'WM_MOUSEMOVE' messages.
           ''' </summary>
           Move_NoCoalesce = &H2000I

           ''' <summary>
           ''' The left button was pressed.
           ''' </summary>
           LeftDown = &H2I

           ''' <summary>
           ''' The left button was released.
           ''' </summary>
           LeftUp = &H4I

           ''' <summary>
           ''' The right button was pressed.
           ''' </summary>
           RightDown = &H8I

           ''' <summary>
           ''' The right button was released.
           ''' </summary>
           RightUp = &H10I

           ''' <summary>
           ''' The middle button was pressed.
           ''' </summary>
           MiddleDown = &H20I

           ''' <summary>
           ''' The middle button was released.
           ''' </summary>
           MiddleUp = &H40I

           ''' <summary>
           ''' Maps coordinates to the entire desktop.
           ''' Must be used in combination with 'Absolute'.
           ''' </summary>
           VirtualDesk = &H4000I

           ''' <summary>
           ''' The wheel was moved, if the mouse has a wheel.
           ''' The amount of movement is specified in 'mouseData'.
           ''' </summary>
           Wheel = &H800I

           ''' <summary>
           ''' The wheel was moved horizontally, if the mouse has a wheel.
           ''' The amount of movement is specified in 'mouseData'.
           ''' </summary>
           HWheel = &H1000I

           ''' <summary>
           ''' An X button was pressed.
           ''' </summary>
           XDown = &H80I

           ''' <summary>
           ''' An X button was released.
           ''' </summary>
           XUp = &H100I

       End Enum

#End Region

#Region " Structures "

       ''' <summary>
       ''' Used by 'SendInput' function
       ''' to store information for synthesizing input events such as keystrokes, mouse movement, and mouse clicks.
       ''' For more info see here:
       ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms646270%28v=vs.85%29.aspx
       ''' </summary>
       <Description("Structure used for 'INPUT' parameter of 'SendInput' API method")>
       <StructLayout(LayoutKind.Explicit)>
       Friend Structure Input

           ' ******
           '  NOTE
           ' ******
           ' Field offset for 32 bit machine: 4
           ' Field offset for 64 bit machine: 8

           ''' <summary>
           ''' The type of the input event.
           ''' </summary>
           <FieldOffset(0)>
           Public type As InputType

           ''' <summary>
           ''' The information about a simulated mouse event.
           ''' </summary>
           <FieldOffset(8)>
           Public mi As MouseInput

           ''' <summary>
           ''' The information about a simulated keyboard event.
           ''' </summary>
           <FieldOffset(8)>
           Public ki As KeyboardInput

           ''' <summary>
           ''' The information about a simulated hardware event.
           ''' </summary>
           <FieldOffset(8)>
           Public hi As HardwareInput

       End Structure

       ''' <summary>
       ''' Contains information about a simulated mouse event.
       ''' For more info see here:
       ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms646273%28v=vs.85%29.aspx
       ''' </summary>
       <Description("Structure used for 'mi' parameter of 'INPUT' structure")>
       Friend Structure MouseInput

           ''' <summary>
           ''' The absolute position of the mouse,
           ''' or the amount of motion since the last mouse event was generated,
           ''' depending on the value of the dwFlags member.
           ''' Absolute data is specified as the 'x' coordinate of the mouse;
           ''' relative data is specified as the number of pixels moved.
           ''' </summary>
           Public dx As Integer

           ''' <summary>
           ''' The absolute position of the mouse,
           ''' or the amount of motion since the last mouse event was generated,
           ''' depending on the value of the dwFlags member.
           ''' Absolute data is specified as the 'y' coordinate of the mouse;
           ''' relative data is specified as the number of pixels moved.
           ''' </summary>
           Public dy As Integer

           ''' <summary>
           ''' If 'dwFlags' contains 'MOUSEEVENTF_WHEEL',
           ''' then 'mouseData' specifies the amount of wheel movement.
           ''' A positive value indicates that the wheel was rotated forward, away from the user;
           ''' a negative value indicates that the wheel was rotated backward, toward the user.
           ''' One wheel click is defined as 'WHEEL_DELTA', which is '120'.
           '''
           ''' If 'dwFlags' does not contain 'MOUSEEVENTF_WHEEL', 'MOUSEEVENTF_XDOWN', or 'MOUSEEVENTF_XUP',
           ''' then mouseData should be '0'.
           ''' </summary>
           Public mouseData As Integer

           ''' <summary>
           ''' A set of bit flags that specify various aspects of mouse motion and button clicks.
           ''' The bits in this member can be any reasonable combination of the following values.
           ''' The bit flags that specify mouse button status are set to indicate changes in status,
           ''' not ongoing conditions.
           ''' For example, if the left mouse button is pressed and held down,
           ''' 'MOUSEEVENTF_LEFTDOWN' is set when the left button is first pressed,
           ''' but not for subsequent motions.
           ''' Similarly, 'MOUSEEVENTF_LEFTUP' is set only when the button is first released.
           '''
           ''' You cannot specify both the 'MOUSEEVENTF_WHEE'L flag
           ''' and either 'MOUSEEVENTF_XDOWN' or 'MOUSEEVENTF_XUP' flags simultaneously in the 'dwFlags' parameter,
           ''' because they both require use of the 'mouseData' field.
           ''' </summary>
           Public dwFlags As MouseInput_Flags

           ''' <summary>
           ''' The time stamp for the event, in milliseconds.
           ''' If this parameter is '0', the system will provide its own time stamp.
           ''' </summary>
           Public time As Integer

           ''' <summary>
           ''' An additional value associated with the mouse event.
           ''' An application calls 'GetMessageExtraInfo' to obtain this extra information.
           ''' </summary>
           Public dwExtraInfo As IntPtr

       End Structure

       ''' <summary>
       ''' Contains information about a simulated keyboard event.
       ''' For more info see here:
       ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms646271%28v=vs.85%29.aspx
       ''' </summary>
       <Description("Structure used for 'ki' parameter of 'INPUT' structure")>
       Friend Structure KeyboardInput

           ''' <summary>
           ''' A virtual-key code.
           ''' The code must be a value in the range '1' to '254'.
           ''' If the 'dwFlags' member specifies 'KEYEVENTF_UNICODE', wVk must be '0'.
           ''' </summary>
           Public wVk As Short

           ''' <summary>
           ''' A hardware scan code for the key.
           ''' If 'dwFlags' specifies 'KEYEVENTF_UNICODE',
           ''' 'wScan' specifies a Unicode character which is to be sent to the foreground application.
           ''' </summary>
           Public wScan As Short

           ''' <summary>
           ''' Specifies various aspects of a keystroke.
           ''' </summary>
           Public dwFlags As KeyboardInput_Flags

           ''' <summary>
           ''' The time stamp for the event, in milliseconds.
           ''' If this parameter is '0', the system will provide its own time stamp.
           ''' </summary>
           Public time As Integer

           ''' <summary>
           ''' An additional value associated with the keystroke.
           ''' Use the 'GetMessageExtraInfo' function to obtain this information.
           ''' </summary>
           Public dwExtraInfo As IntPtr

       End Structure

       ''' <summary>
       ''' Contains information about a simulated message generated by an input device other than a keyboard or mouse.
       ''' For more info see here:
       ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms646269%28v=vs.85%29.aspx
       ''' </summary>
       <Description("Structure used for 'hi' parameter of 'INPUT' structure")>
       Friend Structure HardwareInput

           ''' <summary>
           ''' The message generated by the input hardware.
           ''' </summary>
           Public uMsg As Integer

           ''' <summary>
           ''' The low-order word of the lParam parameter for uMsg.
           ''' </summary>
           Public wParamL As Short

           ''' <summary>
           ''' The high-order word of the lParam parameter for uMsg.
           ''' </summary>
           Public wParamH As Short

       End Structure

#End Region

   End Class

#End Region

#Region " Enumerations "

   ''' <summary>
   ''' Indicates a mouse button.
   ''' </summary>
   <Description("Enumeration used for 'MouseAction' parameter of 'MouseClick' function.")>
   Public Enum MouseButton As Integer

       ''' <summary>
       ''' Hold the left button.
       ''' </summary>
       LeftDown = &H2I

       ''' <summary>
       ''' Release the left button.
       ''' </summary>
       LeftUp = &H4I

       ''' <summary>
       ''' Hold the right button.
       ''' </summary>
       RightDown = &H8I

       ''' <summary>
       ''' Release the right button.
       ''' </summary>
       RightUp = &H10I

       ''' <summary>
       ''' Hold the middle button.
       ''' </summary>
       MiddleDown = &H20I

       ''' <summary>
       ''' Release the middle button.
       ''' </summary>
       MiddleUp = &H40I

       ''' <summary>
       ''' Press the left button.
       ''' ( Hold + Release )
       ''' </summary>
       LeftPress = LeftDown + LeftUp

       ''' <summary>
       ''' Press the Right button.
       ''' ( Hold + Release )
       ''' </summary>
       RightPress = RightDown + RightUp

       ''' <summary>
       ''' Press the Middle button.
       ''' ( Hold + Release )
       ''' </summary>
       MiddlePress = MiddleDown + MiddleUp

   End Enum

#End Region

#Region " Public Methods "

   ''' <summary>
   ''' Sends a keystroke.
   ''' </summary>
   ''' <param name="key">
   ''' Indicates the keystroke to simulate.
   ''' </param>
   ''' <param name="BlockInput">
   ''' If set to <c>true</c>, the keyboard and mouse are blocked until the keystroke is sent.
   ''' </param>
   ''' <returns>
   ''' The function returns the number of events that it successfully inserted into the keyboard input stream.
   ''' If the function returns zero, the input was already blocked by another thread.
   ''' </returns>
   Public Shared Function SendKey(ByVal key As Char,
                                  Optional BlockInput As Boolean = False) As Integer

       ' Block Keyboard and mouse.
       If BlockInput Then NativeMethods.BlockInput(True)

       ' The inputs structures to send.
       Dim Inputs As New List(Of NativeMethods.INPUT)

       ' The current input to add into the Inputs list.
       Dim CurrentInput As New NativeMethods.INPUT

       ' Determines whether a character is an alphabetic letter.
       Dim IsAlphabetic As Boolean = Not (key.ToString.ToUpper = key.ToString.ToLower)

       ' Determines whether a character is an uppercase alphabetic letter.
       Dim IsUpperCase As Boolean =
           (key.ToString = key.ToString.ToUpper) AndAlso Not (key.ToString.ToUpper = key.ToString.ToLower)

       ' Determines whether the CapsLock key is pressed down.
       Dim CapsLockON As Boolean = My.Computer.Keyboard.CapsLock

       ' Set the passed key to upper-case.
       If IsAlphabetic AndAlso Not IsUpperCase Then
           key = Convert.ToChar(key.ToString.ToUpper)
       End If

       ' If character is alphabetic and is UpperCase and CapsLock is pressed down,
       ' OrElse character is alphabetic and is not UpperCase and CapsLock is not pressed down,
       ' OrElse character is not alphabetic.
       If (IsAlphabetic AndAlso IsUpperCase AndAlso CapsLockON) _
       OrElse (IsAlphabetic AndAlso Not IsUpperCase AndAlso Not CapsLockON) _
       OrElse (Not IsAlphabetic) Then

           ' Hold the character key.
           With CurrentInput
               .type = NativeMethods.InputType.Keyboard
               .ki.wVk = Convert.ToInt16(CChar(key))
               .ki.dwFlags = NativeMethods.KeyboardInput_Flags.KeyDown
           End With : Inputs.Add(CurrentInput)

           ' Release the character key.
           With CurrentInput
               .type = NativeMethods.InputType.Keyboard
               .ki.wVk = Convert.ToInt16(CChar(key))
               .ki.dwFlags = NativeMethods.KeyboardInput_Flags.KeyUp
           End With : Inputs.Add(CurrentInput)

           ' If character is alphabetic and is UpperCase and CapsLock is not pressed down,
           ' OrElse character is alphabetic and is not UpperCase and CapsLock is pressed down.
       ElseIf (IsAlphabetic AndAlso IsUpperCase AndAlso Not CapsLockON) _
       OrElse (IsAlphabetic AndAlso Not IsUpperCase AndAlso CapsLockON) Then

           ' Hold the Shift key.
           With CurrentInput
               .type = NativeMethods.InputType.Keyboard
               .ki.wVk = NativeMethods.VirtualKeys.SHIFT
               .ki.dwFlags = NativeMethods.KeyboardInput_Flags.KeyDown
           End With : Inputs.Add(CurrentInput)

           ' Hold the character key.
           With CurrentInput
               .type = NativeMethods.InputType.Keyboard
               .ki.wVk = Convert.ToInt16(CChar(key))
               .ki.dwFlags = NativeMethods.KeyboardInput_Flags.KeyDown
           End With : Inputs.Add(CurrentInput)

           ' Release the character key.
           With CurrentInput
               .type = NativeMethods.InputType.Keyboard
               .ki.wVk = Convert.ToInt16(CChar(key))
               .ki.dwFlags = NativeMethods.KeyboardInput_Flags.KeyUp
           End With : Inputs.Add(CurrentInput)

           ' Release the Shift key.
           With CurrentInput
               .type = NativeMethods.InputType.Keyboard
               .ki.wVk = NativeMethods.VirtualKeys.SHIFT
               .ki.dwFlags = NativeMethods.KeyboardInput_Flags.KeyUp
           End With : Inputs.Add(CurrentInput)

       End If ' UpperCase And My.Computer.Keyboard.CapsLock is...

       ' Send the input key.
       Return NativeMethods.SendInput(Inputs.Count, Inputs.ToArray,
                                      Marshal.SizeOf(GetType(NativeMethods.Input)))

       ' Unblock Keyboard and mouse.
       If BlockInput Then NativeMethods.BlockInput(False)

   End Function

   ''' <summary>
   ''' Sends a keystroke.
   ''' </summary>
   ''' <param name="key">
   ''' Indicates the keystroke to simulate.
   ''' </param>
   ''' <param name="BlockInput">
   ''' If set to <c>true</c>, the keyboard and mouse are blocked until the keystroke is sent.
   ''' </param>
   ''' <returns>
   ''' The function returns the number of events that it successfully inserted into the keyboard input stream.
   ''' If the function returns zero, the input was already blocked by another thread.
   ''' </returns>
   Public Shared Function SendKey(ByVal key As Keys,
                                  Optional BlockInput As Boolean = False) As Integer

       Return SendKey(Convert.ToChar(key), BlockInput)

   End Function

   ''' <summary>
   ''' Sends a string.
   ''' </summary>
   ''' <param name="String">
   ''' Indicates the string to send.
   ''' </param>
   ''' <param name="BlockInput">
   ''' If set to <c>true</c>, the keyboard and mouse are blocked until the keystroke is sent.
   ''' </param>
   ''' <returns>
   ''' The function returns the number of events that it successfully inserted into the keyboard input stream.
   ''' If the function returns zero, the input was already blocked by another thread.
   ''' </returns>
   Public Shared Function SendKeys(ByVal [String] As String,
                                   Optional BlockInput As Boolean = False) As Integer

       Dim SuccessCount As Integer = 0

       ' Block Keyboard and mouse.
       If BlockInput Then NativeMethods.BlockInput(True)

       For Each c As Char In [String]
           SuccessCount += SendKey(c, BlockInput:=False)
       Next c

       ' Unblock Keyboard and mouse.
       If BlockInput Then NativeMethods.BlockInput(False)

       Return SuccessCount

   End Function

   ''' <summary>
   ''' Slices the mouse position.
   ''' </summary>
   ''' <param name="Offset">
   ''' Indicates the offset, in coordinates.
   ''' </param>
   ''' <param name="BlockInput">
   ''' If set to <c>true</c>, the keyboard and mouse are blocked until the mouse movement is sent.
   ''' </param>
   ''' <returns>
   ''' The function returns the number of events that it successfully inserted into the mouse input stream.
   ''' If the function returns zero, the input was already blocked by another thread.
   ''' </returns>
   Public Shared Function MouseMove(ByVal Offset As Point,
                                    Optional BlockInput As Boolean = False) As Integer

       ' Block Keyboard and mouse.
       If BlockInput Then NativeMethods.BlockInput(True)

       ' The inputs structures to send.
       Dim Inputs As New List(Of NativeMethods.Input)

       ' The current input to add into the Inputs list.
       Dim CurrentInput As New NativeMethods.Input

       ' Add a mouse movement.
       With CurrentInput
           .type = NativeMethods.InputType.Mouse
           .mi.dx = Offset.X
           .mi.dy = Offset.Y
           .mi.dwFlags = NativeMethods.MouseInput_Flags.Move
       End With : Inputs.Add(CurrentInput)

       ' Send the mouse movement.
       Return NativeMethods.SendInput(Inputs.Count, Inputs.ToArray,
                                      Marshal.SizeOf(GetType(NativeMethods.Input)))

       ' Unblock Keyboard and mouse.
       If BlockInput Then NativeMethods.BlockInput(False)

   End Function

   ''' <summary>
   ''' Slices the mouse position.
   ''' </summary>
   ''' <param name="X">
   ''' Indicates the 'X' offset.
   ''' </param>
   ''' <param name="Y">
   ''' Indicates the 'Y' offset.
   ''' </param>
   ''' <param name="BlockInput">
   ''' If set to <c>true</c>, the keyboard and mouse are blocked until the mouse movement is sent.
   ''' </param>
   ''' <returns>
   ''' The function returns the number of events that it successfully inserted into the mouse input stream.
   ''' If the function returns zero, the input was already blocked by another thread.
   ''' </returns>
   Public Shared Function MouseMove(ByVal X As Integer, ByVal Y As Integer,
                                    Optional BlockInput As Boolean = False) As Integer

       Return MouseMove(New Point(X, Y), BlockInput)

   End Function

   ''' <summary>
   ''' Moves the mouse hotspot to an absolute position, in coordinates.
   ''' </summary>
   ''' <param name="Position">
   ''' Indicates the absolute position.
   ''' </param>
   ''' <param name="BlockInput">
   ''' If set to <c>true</c>, the keyboard and mouse are blocked until the mouse movement is sent.
   ''' </param>
   ''' <returns>
   ''' The function returns the number of events that it successfully inserted into the mouse input stream.
   ''' If the function returns zero, the input was already blocked by another thread.
   ''' </returns>
   Public Shared Function MousePosition(ByVal Position As Point,
                                        Optional BlockInput As Boolean = False) As Integer

       ' Block Keyboard and mouse.
       If BlockInput Then NativeMethods.BlockInput(True)

       ' The inputs structures to send.
       Dim Inputs As New List(Of NativeMethods.Input)

       ' The current input to add into the Inputs list.
       Dim CurrentInput As New NativeMethods.Input

       ' Transform the coordinates.
       Position.X = CInt(Position.X * 65535 / (Screen.PrimaryScreen.Bounds.Width - 1))
       Position.Y = CInt(Position.Y * 65535 / (Screen.PrimaryScreen.Bounds.Height - 1))

       ' Add an absolute mouse movement.
       With CurrentInput
           .type = NativeMethods.InputType.Mouse
           .mi.dx = Position.X
           .mi.dy = Position.Y
           .mi.dwFlags = NativeMethods.MouseInput_Flags.Absolute Or NativeMethods.MouseInput_Flags.Move
           .mi.time = 0
       End With : Inputs.Add(CurrentInput)

       ' Send the absolute mouse movement.
       Return NativeMethods.SendInput(Inputs.Count, Inputs.ToArray,
                                      Marshal.SizeOf(GetType(NativeMethods.Input)))

       ' Unblock Keyboard and mouse.
       If BlockInput Then NativeMethods.BlockInput(False)

   End Function

   ''' <summary>
   ''' Moves the mouse hotspot to an absolute position, in coordinates.
   ''' </summary>
   ''' <param name="X">
   ''' Indicates the absolute 'X' coordinate.
   ''' </param>
   ''' <param name="Y">
   ''' Indicates the absolute 'Y' coordinate.
   ''' </param>
   ''' <param name="BlockInput">
   ''' If set to <c>true</c>, the keyboard and mouse are blocked until the mouse movement is sent.
   ''' </param>
   ''' <returns>
   ''' The function returns the number of events that it successfully inserted into the mouse input stream.
   ''' If the function returns zero, the input was already blocked by another thread.
   ''' </returns>
   Public Shared Function MousePosition(ByVal X As Integer, ByVal Y As Integer,
                                        Optional BlockInput As Boolean = False) As Integer

       Return MousePosition(New Point(X, Y), BlockInput)

   End Function

   ''' <summary>
   ''' Simulates a mouse click.
   ''' </summary>
   ''' <param name="MouseAction">
   ''' Indicates the mouse action to perform.
   ''' </param>
   ''' <param name="BlockInput">
   ''' If set to <c>true</c>, the keyboard and mouse are blocked until the mouse movement is sent.
   ''' </param>
   ''' <returns>
   ''' The function returns the number of events that it successfully inserted into the mouse input stream.
   ''' If the function returns zero, the input was already blocked by another thread.
   ''' </returns>
   Public Shared Function MouseClick(ByVal MouseAction As MouseButton,
                                     Optional BlockInput As Boolean = False) As Integer

       ' Block Keyboard and mouse.
       If BlockInput Then NativeMethods.BlockInput(True)

       ' The inputs structures to send.
       Dim Inputs As New List(Of NativeMethods.Input)

       ' The current input to add into the Inputs list.
       Dim CurrentInput As New NativeMethods.Input

       ' The mouse actions to perform.
       Dim MouseActions As New List(Of MouseButton)

       Select Case MouseAction

           Case MouseButton.LeftPress ' Left button, hold and release.
               MouseActions.Add(MouseButton.LeftDown)
               MouseActions.Add(MouseButton.LeftUp)

           Case MouseButton.RightPress ' Right button, hold and release.
               MouseActions.Add(MouseButton.RightDown)
               MouseActions.Add(MouseButton.RightUp)

           Case MouseButton.MiddlePress ' Middle button, hold and release.
               MouseActions.Add(MouseButton.MiddleDown)
               MouseActions.Add(MouseButton.MiddleUp)

           Case Else ' Other
               MouseActions.Add(MouseAction)

       End Select ' MouseAction

       For Each Action As MouseButton In MouseActions

           ' Add the mouse click.
           With CurrentInput
               .type = NativeMethods.InputType.Mouse
               '.mi.dx = Offset.X
               '.mi.dy = Offset.Y
               .mi.dwFlags = Action
           End With : Inputs.Add(CurrentInput)

       Next Action

       ' Send the mouse click.
       Return NativeMethods.SendInput(Inputs.Count, Inputs.ToArray,
                                      Marshal.SizeOf(GetType(NativeMethods.Input)))

       ' Unblock Keyboard and mouse.
       If BlockInput Then NativeMethods.BlockInput(False)

   End Function

#End Region

End Class

[Eleкtro]

String Is Numeric Of DataType?

La típica función para comprobar si un String es numérico, reinventada para cumplir dos tareas en una, comprueba si un string es un valor numérico de un tipo específico.

Código (vbnet) [Seleccionar] Expandir

   ' String Is Numeric Of Type?
   ' ( By Elektro )
   '
   ' Usage Examples:
   ' MsgBox(StringIsNumeric(Of Long)("50.1")) ' Result: False (it's a Double).
   ' MsgBox(StringIsNumeric(Of Integer)("9999999999")) ' Result: False (it's a Long).
   ' MsgBox(StringIsNumeric(Of Integer)(CStr(Integer.MaxValue))) ' Result: True.
   '
   ''' <summary>
   ''' Determines whether an String is a valid numeric value of the specified type.
   ''' </summary>
   ''' <typeparam name="T">Indicates the numeric DataType</typeparam>
   ''' <param name="Value">Indicates the string value.</param>
   ''' <returns>
   ''' <c>true</c> if string is a valid numeric value of the specified type, <c>false</c> otherwise.
   ''' </returns>
   ''' <exception cref="Exception"></exception>
   Private Function StringIsNumeric(Of T)(ByVal Value As String) As Boolean

       Const MethodName As String = "TryParse"
       Dim DataType As Type = GetType(T)
       Dim Result As Object = Nothing

       Dim Method As System.Reflection.MethodInfo =
       DataType.GetMethod(MethodName,
                          System.Reflection.BindingFlags.Public Or System.Reflection.BindingFlags.Static,
                          Type.DefaultBinder,
                          New Type() {GetType(String), DataType.MakeByRefType()},
                          New System.Reflection.ParameterModifier() {Nothing})

       If Method IsNot Nothing Then
           Return Method.Invoke(Nothing,
                                System.Reflection.BindingFlags.Public Or System.Reflection.BindingFlags.Static,
                                Type.DefaultBinder,
                                New Object() {Value, Result},
                                System.Globalization.CultureInfo.InvariantCulture)

       Else
           Throw New Exception(String.Format("Static method '{0}' not found in '{1}' Type.",
                                             MethodName, DataType.Name))
           Return False

       End If

   End Function

[Eleкtro]

Código (vbnet) [Seleccionar] Expandir

   ' String Is Alphabetic?
   ' ( By Elektro )
   '
   ''' <summary>
   ''' Determines whether a String is alphabetic.
   ''' </summary>
   ''' <param name="str">Indicates the string.</param>
   ''' <returns><c>true</c> if string only contains alphabetic characters, <c>false</c> otherwise.</returns>
   Private Function StringIsAlphabetic(ByVal str As String) As Boolean

       Return Not Convert.ToBoolean((From c As Char In str Where Not "abcdefghijklmnopqrstuvwxyz".Contains(c)).Count)

   End Function

Código (vbnet) [Seleccionar] Expandir

  ' Get Biggest Letter Of String
   ' ( By Elektro )
   '
   ' Usage Examples
   ' MsgBox(GetBiggestLetter("qwerty012345"))
   '
   ''' <summary>
   ''' Gets the biggest letter in a String.
   ''' </summary>
   ''' <param name="str">Indicates the string.</param>
   ''' <returns>System.Char.</returns>
   Private Function GetBiggestLetter(ByVal str As String) As Char

       Return (From c As Char In str.ToLower
               Where "abcdefghijklmnopqrstuvwxyz".Contains(c)
               Order By c Descending).FirstOrDefault

   End Function

Código (vbnet) [Seleccionar] Expandir

   ' Get Lowest Letter Of String
   ' ( By Elektro )
   '
   ' Usage Examples
   ' MsgBox(GetLowestLetter("qwerty012345"))
   '
   ''' <summary>
   ''' Gets the lowest letter in a String.
   ''' </summary>
   ''' <param name="str">Indicates the string.</param>
   ''' <returns>System.Char.</returns>
   Private Function GetLowestLetter(ByVal str As String) As Char

       Return (From c As Char In str.ToLower
               Where "abcdefghijklmnopqrstuvwxyz".Contains(c)
               Order By c Ascending).FirstOrDefault

   End Function

Código (vbnet) [Seleccionar] Expandir

   ' Get Biggest Number Of String
   ' ( By Elektro )
   '
   ' Usage Examples
   ' MsgBox(GetBiggestNumber("qwerty012345"))
   '
   ''' <summary>
   ''' Gets the biggest number in a String.
   ''' </summary>
   ''' <param name="str">Indicates the string.</param>
   ''' <returns>System.Int32.</returns>
   Private Function GetBiggestNumber(ByVal str As String) As Integer

       Return Convert.ToInt32((From c As Char In str
                               Where Integer.TryParse(c, New Integer)
                               Order By c Descending).FirstOrDefault, 10)

   End Function

Código (vbnet) [Seleccionar] Expandir

   ' Get Lowest Number Of String
   ' ( By Elektro )
   '
   ' Usage Examples
   ' MsgBox(GetLowestNumber("qwerty012345"))
   '
   ''' <summary>
   ''' Gets the lowest number in a String.
   ''' </summary>
   ''' <param name="str">Indicates the string.</param>
   ''' <returns>System.Int32.</returns>
   Private Function GetLowestNumber(ByVal str As String) As Integer

       Return Convert.ToInt32((From c As Char In str
                               Where Integer.TryParse(c, New Integer)
                               Order By c Ascending).FirstOrDefault, 10)

   End Function

[Eleкtro]

Una mini-Class para Blinkear un control (efecto de parpadeo), o el texto de un control:

[youtube=640,360]http://www.youtube.com/watch?v=QmY-EJxhDjs[/youtube]

Código (vbnet) [Seleccionar] Expandir

' ***********************************************************************
' Author   : Elektro
' Modified : 02-25-2014
' ***********************************************************************
' <copyright file="Blinker.vb" company="Elektro Studios">
'     Copyright (c) Elektro Studios. All rights reserved.
' </copyright>
' ***********************************************************************

#Region " Usage Examples "

'Friend WithEvents LabelBlinker As Blinker

'Private Shadows Sub Shown(sender As Object, e As EventArgs) Handles MyBase.Shown

'    LabelBlinker = New Blinker(Textbox1)

'    LabelBlinker.Blink(Interval:=500)
'    LabelBlinker.BlinkText(Interval:=500, CustomText:="Custom Text!")

'    LabelBlinker.Unblink(Visible:=True)
'    LabelBlinker.UnblinkText(RestoreText:=False)

'End Sub

#End Region

''' <summary>
''' Blinks a Control.
''' </summary>
Friend NotInheritable Class Blinker

#Region " Objects "

   ''' <summary>
   ''' The control to blink.
   ''' </summary>
   Private ctrl As Control = Nothing

   ''' <summary>
   ''' A Timer to blink a control.
   ''' </summary>
   Private WithEvents BlinkTimer As New Timer

   ''' <summary>
   ''' A Timer to blink the text of a control.
   ''' </summary>
   Private WithEvents BlinkTextTimer As New Timer

   ''' <summary>
   ''' A custom text to restore after blinking the control.
   ''' </summary>
   Private TextToRestore As String = String.Empty

#End Region

#Region " Constructors "

   ''' <summary>
   ''' Initializes a new instance of the <see cref="Blinker" /> class.
   ''' </summary>
   ''' <param name="ctrl">Indicates the control to blink.</param>
   Public Sub New(ByVal ctrl As Control)

       ' Assign the control to blink.
       Me.ctrl = ctrl

   End Sub

#End Region

#Region " Public Methods "

   ''' <summary>
   ''' Blinks the Control.
   ''' </summary>
   ''' <param name="Interval">Indicates the blink interval, in ms.</param>
   Public Sub Blink(Optional ByVal Interval As Integer = 500)

       With BlinkTimer
           .Interval = Interval
           .Enabled = True
       End With

   End Sub

   ''' <summary>
   ''' Stop blinking the Control.
   ''' </summary>
   ''' <param name="Visible">Indicates the visibility of the control.</param>
   Public Sub Unblink(Optional ByVal Visible As Boolean = True)

       With BlinkTimer
           .Enabled = False
       End With

       ctrl.Visible = Visible

   End Sub

   ''' <summary>
   ''' Blinks the text content of the Control.
   ''' </summary>
   ''' <param name="Interval">Indicates the blink interval.</param>
   ''' <param name="CustomText">Indicates a custom text to blink.</param>
   Public Sub BlinkText(Optional ByVal Interval As Integer = 500,
                        Optional ByVal CustomText As String = Nothing)

       With BlinkTextTimer
           .Tag = If(String.IsNullOrEmpty(CustomText), Me.ctrl.Text, CustomText)
           .Interval = Interval
           .Enabled = True
       End With

   End Sub

   ''' <summary>
   ''' Stop blinking the text content of the Control.
   ''' </summary>
   ''' <param name="RestoreText">If set to <c>true</c>, the control text is resetted to the initial state before started blinking.</param>
   Public Sub UnblinkText(Optional ByVal RestoreText As Boolean = False)

       With BlinkTextTimer
           .Enabled = False
       End With

       If RestoreText Then
           Me.ctrl.Text = TextToRestore
       End If

   End Sub

#End Region

#Region " Event Handlers"

   ''' <summary>
   ''' Handles the Tick event of the BlinkTimer control.
   ''' </summary>
   ''' <param name="sender">The source of the event.</param>
   ''' <param name="e">The <see cref="EventArgs" /> instance containing the event data.</param>
   Private Sub BlinkTimer_Tick(ByVal sender As Object, ByVal e As EventArgs) Handles BlinkTimer.Tick

       Me.ctrl.Visible = Not Me.ctrl.Visible

   End Sub

   ''' <summary>
   ''' Handles the Tick event of the BlinkTextTimer control.
   ''' </summary>
   ''' <param name="sender">The source of the event.</param>
   ''' <param name="e">The <see cref="EventArgs" /> instance containing the event data.</param>
   Private Sub BlinkTextTimer_Tick(ByVal sender As Object, ByVal e As EventArgs) Handles BlinkTextTimer.Tick

       If String.IsNullOrEmpty(Me.ctrl.Text) Then
           Me.ctrl.Text = CStr(sender.tag)

       Else
           Me.ctrl.Text = String.Empty

       End If

   End Sub

#End Region

End Class

[Eleкtro]

Este snippet sirve para rotar la posición de las palabras que contiene un String.

Código (vbnet) [Seleccionar] Expandir

    ' Rotate String
    ' ( By Elektro )
    '
    ' Usage Examples:
    ' MsgBox(RotateString("a b c d e f", RotationDirectorion.Left, 2)) ' Result "c d e f a b"
    ' MsgBox(RotateString("Hello_World_!", RotationDirectorion.Right, 1, "_"c)) ' Result: "!_Hello_World"

    ''' <summary>
    ''' Indicates the rotation direction of an String.
    ''' </summary>
    Public Enum RotationDirectorion

        ''' <summary>
        ''' Rotates to the left.
        ''' </summary>
        Left

        ''' <summary>
        ''' Rotates to the right.
        ''' </summary>
        Right

    End Enum

    ''' <summary>
    ''' Rotates the words in a String.
    ''' </summary>
    ''' <param name="String">Indicates the string to rotate.</param>
    ''' <param name="Direction">Indicates the rotation direction.</param>
    ''' <param name="Rotation">Indicates the rotation count.</param>
    ''' <param name="Delimiter">
    ''' Indicates the delimiter that is used to split the words of the string.
    ''' Default is 'Space' character.
    ''' </param>
    ''' <returns>System.String.</returns>
    ''' <exception cref="Exception">Rotation count is out of range.</exception>
    Private Function RotateString(ByVal [String] As String,
                                  ByVal Direction As RotationDirectorion,
                                  ByVal Rotation As Integer,
                                  Optional ByVal Delimiter As Char = " "c
                                  ) As String

        Dim Parts As String() = [String].Split(Delimiter)

        If String.IsNullOrEmpty([String]) OrElse Not [String].Contains(CStr(Delimiter)) Then
            Throw New Exception(String.Format("Delimiter '{0}' not found in the String.", CStr(Delimiter)))
        End If

        If Rotation = 0 OrElse Rotation >= Parts.Length Then
            Throw New Exception("Rotation count is out of range.")
        End If

        Select Case Direction

            Case RotationDirectorion.Left
                Return String.Format("{0}{1}",
                                     String.Join(Delimiter,
                                                 From s As String In Parts Skip Rotation) & CStr(Delimiter),
                                     String.Join(Delimiter,
                                                 From s As String In Parts Take Rotation))

            Case RotationDirectorion.Right
                Return String.Format("{0}{1}",
                                     String.Join(Delimiter,
                                                 From s As String In Parts Skip (Parts.Length - Rotation)) & CStr(Delimiter),
                                     String.Join(Delimiter,
                                                 From s As String In Parts Take (Parts.Length - Rotation)))

            Case Else
                Return String.Empty

        End Select ' Direction

    End Function


[Eleкtro]

Una Class para utilizar el cifrado cromático de texto, es decir, esto:




Aquí pueden descargar la Class (no soy el autor de este laborioso código, solo lo adapté un poco añadiéndole algún método más, y elaboré un poco mejor la documentación):
http://pastebin.com/92JEWwxV

El source original: https://github.com/varocarbas/snippets_chromaticEncryption_VB

Ejemplo de uso:

Código (vbnet) [Seleccionar] Expandir

Public Class Form1

   ''' <summary>
   ''' Instance of a Class containing most of the methods involving image-related actions,
   ''' common to both encryption and decryption.
   ''' </summary>
   Dim curentIO As New IO

   Private Sub Test() Handles MyBase.Load


       ' Encrypt text into image:
       Dim Encrypt As New Encrypting(Color.Red, "Hello World!", curentIO, 0)
       Dim EncryptedImage As Bitmap = Nothing

       Select Case Encrypt.errors

           Case False
               ' Encrypts the text and returns the encrypted Bitmap.
               EncryptedImage = curentIO.Encrypt(500, 500, Encrypt)

               ' Or encrypts the text and save it directlly in a image file.
               Encrypt = curentIO.SaveImageFile("C:\File.png", 500, 500, Encrypt)

           Case True
               MessageBox.Show(Encrypt.errorMessage, "There was an error while encrypting the text.")

       End Select


       ' Decrypt image into text:
       Dim Decrypt As New Decrypting(Color.Red, EncryptedImage, curentIO, 0)
       ' Dim Decrypt As New Decrypting(Color.Red, Bitmap.FromFile("C:\File.png"), curentIO, 0)

       If Not Decrypt.errors Then
           MsgBox(Decrypt.decryptedString)
       Else
           MessageBox.Show(Decrypt.errorMessage, "Either the input parameters or the image are wrong.")
       End If


   End Sub

End Class

[Eleкtro]

Convierte los caracteres diacríticos de un String.

Código (vbnet) [Seleccionar] Expandir

    ' Convert Diacritics
    '
    ' Usage Examples:
    ' MsgBox(RemoveDiacritics("áéíóú àèìòù äëïöü ñÑ çÇ", UnicodeNormalization:=System.Text.NormalizationForm.FormKD))
    ' Result: 'aeiou aeiou aeiou nN cC'
    '
    ''' <summary>
    ''' Converts the diacritic characters in a String to an equivalent normalized English characters.
    ''' </summary>
    ''' <param name="String">
    ''' Indicates the string that contains diacritic characters.
    ''' </param>
    ''' <param name="UnicodeNormalization">
    ''' Defines the type of Unicode character normalization to perform.
    ''' (Default is 'NormalizationForm.FormKD')
    ''' </param>
    ''' <returns>System.String.</returns>
    Public Function ConvertDiacritics(ByVal [String] As String,
                                      Optional ByVal UnicodeNormalization As System.Text.NormalizationForm =
                                                                             System.Text.NormalizationForm.FormKD) As String

        Dim Characters As String = String.Empty

        For Each c As Char In [String].Normalize(UnicodeNormalization)

            Select Case Globalization.CharUnicodeInfo.GetUnicodeCategory(c)

                Case Globalization.UnicodeCategory.NonSpacingMark,
                     Globalization.UnicodeCategory.SpacingCombiningMark,
                     Globalization.UnicodeCategory.EnclosingMark

                    ' Do nothing.
                    Exit Select

                Case Else
                    Characters &= CStr(c)

            End Select

        Next c

        Return Characters

    End Function

[Eleкtro]

FileType Detective

Comprueba el tipo de un archivo específico examinando su cabecera.

(Tipo 'MediaInfo')

Código (vbnet) [Seleccionar] Expandir

' ***********************************************************************
' Author   : Original: http://filetypedetective.codeplex.com/
'            Source translated, revised and extended by Elektro.
'
' Modified : 03-06-2014
' ***********************************************************************
' <copyright file="FileTypeDetective.vb" company="Elektro Studios">
'     Copyright (c) Elektro Studios. All rights reserved.
' </copyright>
' ***********************************************************************

#Region " Info "

' file headers are taken from here:
'http://www.garykessler.net/library/file_sigs.html

' mime types are taken from here:
' http://www.webmaster-toolkit.com/mime-types.shtml

#End Region

#Region " Usage Examples "

'Imports FileTypeDetective

'Public Class Form1

'    Private Sub Test() Handles MyBase.Load

'        MessageBox.Show(Detective.isType("C:\File.reg", FileType.REG)) ' NOTE: The regfile should be Unicode, not ANSI.
'        MessageBox.Show(Detective.GetFileType("C:\File.reg").mime)

'    End Sub

'End Class

#End Region

#Region " Imports "

Imports System.IO
Imports FileTypeDetective.FileType

#End Region

#Region " FileType Detective "

''' <summary>
''' Little data structure to hold information about file types.
''' Holds information about binary header at the start of the file
''' </summary>
Public Class FileType

    ' MS Office files
    Public Shared ReadOnly WORD As New FileType(
        New Nullable(Of Byte)() {&HEC, &HA5, &HC1, &H0}, 512I, "doc", "application/msword")

    Public Shared ReadOnly EXCEL As New FileType(
        New Nullable(Of Byte)() {&H9, &H8, &H10, &H0, &H0, &H6, &H5, &H0}, 512I, "xls", "application/excel")

    Public Shared ReadOnly PPT As New FileType(
        New Nullable(Of Byte)() {&HFD, &HFF, &HFF, &HFF, Nothing, &H0, &H0, &H0}, 512I, "ppt", "application/mspowerpoint")

    ' common documents
    Public Shared ReadOnly RTF As New FileType(
        New Nullable(Of Byte)() {&H7B, &H5C, &H72, &H74, &H66, &H31}, "rtf", "application/rtf")

    Public Shared ReadOnly PDF As New FileType(
        New Nullable(Of Byte)() {&H25, &H50, &H44, &H46}, "pdf", "application/pdf")

    Public Shared ReadOnly REG As New FileType(
        New Nullable(Of Byte)() {&HFF, &HFE}, "reg", "text/plain")

    ' grafics
    Public Shared ReadOnly JPEG As New FileType(
        New Nullable(Of Byte)() {&HFF, &HD8, &HFF}, "jpg", "image/jpeg")

    Public Shared ReadOnly PNG As New FileType(
        New Nullable(Of Byte)() {&H89, &H50, &H4E, &H47, &HD, &HA, &H1A, &HA}, "png", "image/png")

    Public Shared ReadOnly GIF As New FileType(
        New Nullable(Of Byte)() {&H47, &H49, &H46, &H38, Nothing, &H61}, "gif", "image/gif")

    ' Compressed
    Public Shared ReadOnly ZIP As New FileType(
        New Nullable(Of Byte)() {&H50, &H4B, &H3, &H4}, "zip", "application/x-compressed")

    Public Shared ReadOnly RAR As New FileType(
        New Nullable(Of Byte)() {&H52, &H61, &H72, &H21}, "rar", "application/x-compressed")

    ' all the file types to be put into one list
    Friend Shared ReadOnly types As New List(Of FileType)() From { _
        PDF,
        WORD,
        EXCEL,
        JPEG,
        ZIP,
        RAR,
        RTF,
        PNG,
        PPT,
        GIF,
        REG
    }

    ' number of bytes we read from a file
    Friend Const MaxHeaderSize As Integer = 560
    ' some file formats have headers offset to 512 bytes

    ' most of the times we only need first 8 bytes, but sometimes extend for 16
    Private m_header As Nullable(Of Byte)()
    Public Property header() As Nullable(Of Byte)()
        Get
            Return m_header
        End Get
        Private Set(value As Nullable(Of Byte)())
            m_header = value
        End Set
    End Property

    Private m_headerOffset As Integer
    Public Property headerOffset() As Integer
        Get
            Return m_headerOffset
        End Get
        Private Set(value As Integer)
            m_headerOffset = value
        End Set
    End Property

    Private m_extension As String
    Public Property extension() As String
        Get
            Return m_extension
        End Get
        Private Set(value As String)
            m_extension = value
        End Set
    End Property

    Private m_mime As String
    Public Property mime() As String
        Get
            Return m_mime
        End Get
        Private Set(value As String)
            m_mime = value
        End Set
    End Property

#Region " Constructors "

    ''' <summary>
    ''' Initializes a new instance of the <see cref="FileType"/> class.
    ''' Default construction with the header offset being set to zero by default
    ''' </summary>
    ''' <param name="header">Byte array with header.</param>
    ''' <param name="extension">String with extension.</param>
    ''' <param name="mime">The description of MIME.</param>
    Public Sub New(header As Nullable(Of Byte)(), extension As String, mime As String)
        Me.header = header
        Me.extension = extension
        Me.mime = mime
        Me.headerOffset = 0
    End Sub

    ''' <summary>
    ''' Initializes a new instance of the <see cref="FileType"/> struct.
    ''' Takes the details of offset for the header
    ''' </summary>
    ''' <param name="header">Byte array with header.</param>
    ''' <param name="offset">The header offset - how far into the file we need to read the header</param>
    ''' <param name="extension">String with extension.</param>
    ''' <param name="mime">The description of MIME.</param>
    Public Sub New(header As Nullable(Of Byte)(), offset As Integer, extension As String, mime As String)
        Me.header = Nothing
        Me.header = header
        Me.headerOffset = offset
        Me.extension = extension
        Me.mime = mime
    End Sub

#End Region

    Public Overrides Function Equals(other As Object) As Boolean

        If Not MyBase.Equals(other) Then
            Return False
        End If

        If Not (TypeOf other Is FileType) Then
            Return False
        End If

        Dim otherType As FileType = DirectCast(other, FileType)

        If Not Me.header Is otherType.header Then
            Return False
        End If

        If Me.headerOffset <> otherType.headerOffset Then
            Return False
        End If

        If Me.extension <> otherType.extension Then
            Return False
        End If

        If Me.mime <> otherType.mime Then
            Return False
        End If

        Return True

    End Function

    Public Overrides Function ToString() As String
        Return extension
    End Function

End Class

''' <summary>
''' Helper class to identify file type by the file header, not file extension.
''' </summary>
Public NotInheritable Class FileTypeDetective

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

#Region "Main Methods"

    ''' <summary>
    ''' Gets the list of FileTypes based on list of extensions in Comma-Separated-Values string
    ''' </summary>
    ''' <param name="CSV">The CSV String with extensions</param>
    ''' <returns>List of FileTypes</returns>
    Private Shared Function GetFileTypesByExtensions(CSV As String) As List(Of FileType)
        Dim extensions As [String]() = CSV.ToUpper().Replace(" ", "").Split(","c)

        Dim result As New List(Of FileType)()

        For Each type As FileType In types
            If extensions.Contains(type.extension.ToUpper()) Then
                result.Add(type)
            End If
        Next
        Return result
    End Function

    ''' <summary>
    ''' Reads the file header - first (16) bytes from the file
    ''' </summary>
    ''' <param name="file">The file to work with</param>
    ''' <returns>Array of bytes</returns>
    Private Shared Function ReadFileHeader(file As FileInfo, MaxHeaderSize As Integer) As [Byte]()
        Dim header As [Byte]() = New Byte(MaxHeaderSize - 1) {}
        Try
            ' read file
            Using fsSource As New FileStream(file.FullName, FileMode.Open, FileAccess.Read)
                ' read first symbols from file into array of bytes.
                fsSource.Read(header, 0, MaxHeaderSize)
                ' close the file stream
            End Using
        Catch e As Exception
            ' file could not be found/read
            Throw New ApplicationException("Could not read file : " & e.Message)
        End Try

        Return header
    End Function

    ''' <summary>
    ''' Read header of a file and depending on the information in the header
    ''' return object FileType.
    ''' Return null in case when the file type is not identified.
    ''' Throws Application exception if the file can not be read or does not exist
    ''' </summary>
    ''' <param name="file">The FileInfo object.</param>
    ''' <returns>FileType or null not identified</returns>
    Public Shared Function GetFileType(file As FileInfo) As FileType
        ' read first n-bytes from the file
        Dim fileHeader As [Byte]() = ReadFileHeader(file, MaxHeaderSize)

        ' compare the file header to the stored file headers
        For Each type As FileType In types
            Dim matchingCount As Integer = 0
            For i As Integer = 0 To type.header.Length - 1
                ' if file offset is not set to zero, we need to take this into account when comparing.
                ' if byte in type.header is set to null, means this byte is variable, ignore it
                If type.header(i) IsNot Nothing AndAlso type.header(i) <> fileHeader(i + type.headerOffset) Then
                    ' if one of the bytes does not match, move on to the next type
                    matchingCount = 0
                    Exit For
                Else
                    matchingCount += 1
                End If
            Next
            If matchingCount = type.header.Length Then
                ' if all the bytes match, return the type
                Return type
            End If
        Next
        ' if none of the types match, return null
        Return Nothing
    End Function

    ''' <summary>
    ''' Read header of a file and depending on the information in the header
    ''' return object FileType.
    ''' Return null in case when the file type is not identified.
    ''' Throws Application exception if the file can not be read or does not exist
    ''' </summary>
    ''' <param name="file">The FileInfo object.</param>
    ''' <returns>FileType or null not identified</returns>
    Public Shared Function GetFileType(file As String) As FileType
        Return GetFileType(New FileInfo(file))
    End Function

    ''' <summary>
    ''' Determines whether provided file belongs to one of the provided list of files
    ''' </summary>
    ''' <param name="file">The file.</param>
    ''' <param name="requiredTypes">The required types.</param>
    ''' <returns>
    '''   <c>true</c> if file of the one of the provided types; otherwise, <c>false</c>.
    ''' </returns>
    Public Shared Function isFileOfTypes(file As FileInfo, requiredTypes As List(Of FileType)) As Boolean

        Dim currentType As FileType = GetFileType(file)

        If currentType Is Nothing Then
            Return False
        End If

        Return requiredTypes.Contains(currentType)

    End Function

    ''' <summary>
    ''' Determines whether provided file belongs to one of the provided list of files,
    ''' where list of files provided by string with Comma-Separated-Values of extensions
    ''' </summary>
    ''' <param name="file">The file.</param>
    ''' <returns>
    '''   <c>true</c> if file of the one of the provided types; otherwise, <c>false</c>.
    ''' </returns>
    Public Shared Function isFileOfTypes(file As FileInfo, CSV As String) As Boolean

        Dim providedTypes As List(Of FileType) = GetFileTypesByExtensions(CSV)

        Return isFileOfTypes(file, providedTypes)

    End Function

#End Region

#Region "isType functions"

    ''' <summary>
    ''' Determines whether the specified file is of provided type
    ''' </summary>
    ''' <param name="file">The file.</param>
    ''' <param name="type">The FileType</param>
    ''' <returns>
    '''   <c>true</c> if the specified file is type; otherwise, <c>false</c>.
    ''' </returns>
    Public Shared Function isType(file As FileInfo, type As FileType) As Boolean

        Dim actualType As FileType = GetFileType(file)

        If actualType Is Nothing Then
            Return False
        End If

        Return (actualType.Equals(type))

    End Function

    ''' <summary>
    ''' Determines whether the specified file is of provided type
    ''' </summary>
    ''' <param name="file">The file.</param>
    ''' <param name="type">The FileType</param>
    ''' <returns>
    '''   <c>true</c> if the specified file is type; otherwise, <c>false</c>.
    ''' </returns>
    Public Shared Function isType(file As String, type As FileType) As Boolean

        Return isType(New FileInfo(file), type)

    End Function

#End Region

End Class

#End Region

[Eleкtro]

Algunos métodos de uso genérico sobre las cuentas de usuario.

Código (vbnet) [Seleccionar] Expandir

    ' Get UserNames
    ' ( By Elektro )
    '
    ' Instructions:
    ' 1. Add a reference to 'System.DirectoryServices.AccountManagement'.
    ' 2. Imports System.DirectoryServices.AccountManagement
    '
    ' Example Usages:
    ' Dim UserNames As String() = GetUserNames()
    '
    ''' <summary>
    ''' Get the username accounts of the current machine.
    ''' </summary>
    ''' <returns>System.String[][].</returns>
    Public Function GetUserNames() As String()

        Dim pContext As New PrincipalContext(ContextType.Machine)
        Dim pUser As New UserPrincipal(pContext)
        Dim pSearcher As New PrincipalSearcher(pUser)
        Dim UserNames As String() = (From u As Principal In pSearcher.FindAll Select u.Name).ToArray

        pContext.Dispose()
        pSearcher.Dispose()
        pUser.Dispose()

        Return UserNames

    End Function

Código (vbnet) [Seleccionar] Expandir

    ' Get Users
    ' ( By Elektro )
    '
    ' Instructions:
    ' 1. Add a reference to 'System.DirectoryServices.AccountManagement'.
    ' 2. Imports System.DirectoryServices.AccountManagement
    '
    ' Example Usages:
    ' Dim Users As Principal() = GetUsers()
    ' For Each User As Principal In Users()
    '     MsgBox(User.Name)
    ' Next
    '
    ''' <summary>
    ''' Get the users of the current machine.
    ''' </summary>
    ''' <returns>Principal[][].</returns>
    Public Function GetUsers() As Principal()

        Dim pContext As New PrincipalContext(ContextType.Machine)
        Dim pUser As New UserPrincipal(pContext)
        Dim pSearcher As New PrincipalSearcher(pUser)
        Dim Users As Principal() = (From User As Principal In pSearcher.FindAll).ToArray

        Return Users

    End Function

Código (vbnet) [Seleccionar] Expandir

   ' Delete User Account
    ' ( By Elektro )
    '
    ' Instructions:
    ' 1. Add a reference to 'System.DirectoryServices.AccountManagement'.
    ' 2. Imports System.DirectoryServices.AccountManagement
    '
    ' Example Usages:
    ' DeleteUserAccount("Username")
    ' DeleteUserAccount(New Security.Principal.SecurityIdentifier("S-1-5-21-250596608-219436059-1115792336-500"))
    '
    ''' <summary>
    ''' Deletes an existing user account in the current machine.
    ''' </summary>
    ''' <param name="UserName">Indicates the account Username.</param>
    ''' <returns><c>true</c> if deletion success, <c>false</c> otherwise.</returns>
    Public Function DeleteUserAccount(ByVal UserName As String) As Boolean

        Dim pContext As New PrincipalContext(ContextType.Machine)
        Dim pUser As New UserPrincipal(pContext)
        Dim pSearcher As New PrincipalSearcher(pUser)

        Dim User As Principal =
            (From u As Principal In pSearcher.FindAll
            Where u.Name.Equals(UserName, StringComparison.OrdinalIgnoreCase)).FirstOrDefault

        If User Is Nothing Then
            Throw New Exception(String.Format("User with name '{0}' not found.", UserName))
        End If

        Try
            User.Delete()
            Return True

        Catch ex As InvalidOperationException
            Throw New Exception(ex.Message)

        Finally
            pContext.Dispose()
            pSearcher.Dispose()
            pUser.Dispose()

        End Try

        Return False ' Failed.

    End Function

Código (vbnet) [Seleccionar] Expandir

    ''' <summary>
    ''' Deletes an existing user account in the current machine.
    ''' </summary>
    ''' <param name="UserSID">Indicates the account security identifier (SID).</param>
    ''' <returns><c>true</c> if deletion success, <c>false</c> otherwise.</returns>
    Public Function DeleteUserAccount(ByVal UserSID As Security.Principal.SecurityIdentifier) As Boolean

        Dim pContext As New PrincipalContext(ContextType.Machine)
        Dim pUser As New UserPrincipal(pContext)
        Dim pSearcher As New PrincipalSearcher(pUser)

        Dim User As Principal =
            (From u As Principal In pSearcher.FindAll
            Where u.Sid = UserSID).FirstOrDefault

        If User Is Nothing Then
            Throw New Exception(String.Format("User with SID '{0}' not found.", UserSID.Value))
        End If

        Try
            User.Delete()
            Return True

        Catch ex As InvalidOperationException
            Throw New Exception(ex.Message)

        Finally
            pContext.Dispose()
            pSearcher.Dispose()
            pUser.Dispose()

        End Try

        Return False ' Failed.

    End Function

Código (vbnet) [Seleccionar] Expandir

    ' User Is Admin?
    ' ( By Elektro )
    '
    ' Instructions:
    ' 1. Add a reference to 'System.DirectoryServices.AccountManagement'.
    ' 2. Imports System.DirectoryServices.AccountManagement
    '
    ' Example Usages:
    ' MsgBox(UserIsAdmin("Administrador"))
    ' MsgBox(UserIsAdmin(New Security.Principal.SecurityIdentifier("S-1-5-21-250596608-219436059-1115792336-500")))
    '
    ''' <summary>
    ''' Determines whether an User is an Administrator.
    ''' </summary>
    ''' <param name="UserName">Indicates the account Username.</param>
    ''' <returns><c>true</c> if user is an Administrator, <c>false</c> otherwise.</returns>
    Public Function UserIsAdmin(ByVal UserName As String) As Boolean

        Dim AdminGroupSID As New SecurityIdentifier("S-1-5-32-544")

        Dim pContext As New PrincipalContext(ContextType.Machine)
        Dim pUser As New UserPrincipal(pContext)
        Dim pSearcher As New PrincipalSearcher(pUser)

        Dim User As Principal =
            (From u As Principal In pSearcher.FindAll
            Where u.Name.Equals(UserName, StringComparison.OrdinalIgnoreCase)).FirstOrDefault

        If User Is Nothing Then
            Throw New Exception(String.Format("User with name '{0}' not found.", UserName))
        End If

        Dim IsAdmin As Boolean =
            (From Group As GroupPrincipal In User.GetGroups
             Where Group.Sid = AdminGroupSID).Any

        pContext.Dispose()
        pSearcher.Dispose()
        pUser.Dispose()

        Return IsAdmin

    End Function

Código (vbnet) [Seleccionar] Expandir

    ''' <summary>
    ''' Determines whether an User is an Administrator.
    ''' </summary>
    ''' <param name="UserSID">Indicates the SID of the user account.</param>
    ''' <returns><c>true</c> if user is an Administrator, <c>false</c> otherwise.</returns>
    Public Function UserIsAdmin(ByVal UserSID As Security.Principal.SecurityIdentifier) As Boolean

        Dim AdminGroupSID As New SecurityIdentifier("S-1-5-32-544")

        Dim pContext As New PrincipalContext(ContextType.Machine)
        Dim pUser As New UserPrincipal(pContext)
        Dim pSearcher As New PrincipalSearcher(pUser)

        Dim User As Principal =
            (From u As Principal In pSearcher.FindAll
            Where u.Sid = UserSID).FirstOrDefault

        If User Is Nothing Then
            Throw New Exception(String.Format("User with SID '{0}' not found.", UserSID.Value))
        End If

        Dim IsAdmin As Boolean =
            (From Group As GroupPrincipal In User.GetGroups
             Where Group.Sid = AdminGroupSID).Any

        pContext.Dispose()
        pSearcher.Dispose()
        pUser.Dispose()

        Return IsAdmin

    End Function

Código (vbnet) [Seleccionar] Expandir

   ' Set UserName
    ' ( By Elektro )
    '
    ' Instructions:
    ' 1. Add a reference to 'System.DirectoryServices.AccountManagement'.
    ' 2. Imports System.DirectoryServices.AccountManagement
    '
    ' Example Usages:
    ' SetUserName("Username", "New Name")
    ' SetUserName(New Security.Principal.SecurityIdentifier("S-1-5-21-250596608-219436059-1115792336-500"), "New Name")
    '
    ''' <summary>
    ''' Sets the UserName of an existing User account.
    ''' </summary>
    ''' <param name="OldUserName">Indicates an existing username account.</param>
    ''' <param name="NewUserName">Indicates the new name for the user account.</param>
    ''' <returns><c>true</c> if change success, <c>false</c> otherwise.</returns>
    Public Function SetUserName(ByVal OldUserName As String,
                                ByVal NewUserName As String) As Boolean

        Dim pContext As New PrincipalContext(ContextType.Machine)
        Dim pUser As New UserPrincipal(pContext)
        Dim pSearcher As New PrincipalSearcher(pUser)

        Dim User As Principal =
            (From u As Principal In pSearcher.FindAll
            Where u.Name.Equals(OldUserName, StringComparison.OrdinalIgnoreCase)).FirstOrDefault

        If User Is Nothing Then
            Throw New Exception(String.Format("User with name '{0}' not found.", OldUserName))
        End If

        Try
            User.Name = NewUserName
            User.Save()
            Return True

        Catch ex As InvalidOperationException
            Throw New Exception(ex.Message)

        Finally
            pContext.Dispose()
            pSearcher.Dispose()
            pUser.Dispose()

        End Try

        Return False ' Failed.

    End Function

Código (vbnet) [Seleccionar] Expandir

    ''' <summary>
    ''' Sets the UserName of an existing User account.
    ''' </summary>
    ''' <param name="UserSID">Indicates the SID of the user account.</param>
    ''' <param name="NewUserName">Indicates the new name for the user account.</param>
    ''' <returns><c>true</c> if change success, <c>false</c> otherwise.</returns>
    Public Function SetUserName(ByVal UserSID As Security.Principal.SecurityIdentifier,
                                ByVal NewUserName As String) As Boolean

        Dim pContext As New PrincipalContext(ContextType.Machine)
        Dim pUser As New UserPrincipal(pContext)
        Dim pSearcher As New PrincipalSearcher(pUser)

        Dim User As Principal =
            (From u As Principal In pSearcher.FindAll
            Where u.Sid = UserSID).FirstOrDefault

        If User Is Nothing Then
            Throw New Exception(String.Format("User with SID '{0}' not found.", UserSID.Value))
        End If

        Try
            User.Name = NewUserName
            User.Save()
            Return True

        Catch ex As InvalidOperationException
            Throw New Exception(ex.Message)

        Finally
            pContext.Dispose()
            pSearcher.Dispose()
            pUser.Dispose()

        End Try

        Return False ' Failed.

    End Function


Código (vbnet) [Seleccionar] Expandir

   ' Set Account DisplayName
    ' ( By Elektro )
    '
    ' Instructions:
    ' 1. Add a reference to 'System.DirectoryServices.AccountManagement'.
    ' 2. Imports System.DirectoryServices.AccountManagement
    '
    ' Example Usages:
    ' SetAccountDisplayName("Username", "New Name")
    ' SetAccountDisplayName(New Security.Principal.SecurityIdentifier("S-1-5-21-250596608-219436059-1115792336-500"), "New Name")
    '
    ''' <summary>
    ''' Sets the display name of an existing User account.
    ''' </summary>
    ''' <param name="OldDisplayName">Indicates an existing display name user account.</param>
    ''' <param name="NewDisplayName">Indicates the new display name for the user account.</param>
    ''' <returns><c>true</c> if change success, <c>false</c> otherwise.</returns>
    Public Function SetAccountDisplayName(ByVal OldDisplayName As String,
                                          ByVal NewDisplayName As String) As Boolean

        Dim pContext As New PrincipalContext(ContextType.Machine)
        Dim pUser As New UserPrincipal(pContext)
        Dim pSearcher As New PrincipalSearcher(pUser)

        Dim User As Principal =
            (From u As Principal In pSearcher.FindAll
            Where u.Name.Equals(OldDisplayName, StringComparison.OrdinalIgnoreCase)).FirstOrDefault

        If User Is Nothing Then
            Throw New Exception(String.Format("User with display name '{0}' not found.", OldDisplayName))
        End If

        Try
            User.DisplayName = NewDisplayName
            User.Save()
            Return True

        Catch ex As InvalidOperationException
            Throw New Exception(ex.Message)

        Finally
            pContext.Dispose()
            pSearcher.Dispose()
            pUser.Dispose()

        End Try

        Return False ' Failed.

    End Function

Código (vbnet) [Seleccionar] Expandir

    ''' <summary>
    ''' Sets the display name of an existing User account.
    ''' </summary>
    ''' <param name="UserSID">Indicates the SID of the user account.</param>
    ''' <param name="NewDisplayName">Indicates the new display name for the user account.</param>
    ''' <returns><c>true</c> if change success, <c>false</c> otherwise.</returns>
    Public Function SetAccountDisplayName(ByVal UserSID As Security.Principal.SecurityIdentifier,
                                          ByVal NewDisplayName As String) As Boolean

        Dim pContext As New PrincipalContext(ContextType.Machine)
        Dim pUser As New UserPrincipal(pContext)
        Dim pSearcher As New PrincipalSearcher(pUser)

        Dim User As Principal =
            (From u As Principal In pSearcher.FindAll
            Where u.Sid = UserSID).FirstOrDefault

        If User Is Nothing Then
            Throw New Exception(String.Format("User with SID '{0}' not found.", UserSID.Value))
        End If

        Try
            User.DisplayName = NewDisplayName
            User.Save()
            Return True

        Catch ex As InvalidOperationException
            Throw New Exception(ex.Message)

        Finally
            pContext.Dispose()
            pSearcher.Dispose()
            pUser.Dispose()

        End Try

        Return False ' Failed.

    End Function