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

[Eleкtro]

Un RichTextBox optimizado para usarse como alternativa de Label , es un Label con posibilidad de añadir texto en distintos colores y en distintas fuentes.

Código (vbnet) [Seleccionar] Expandir

'  /*               *\
' |#* RichTextLabel *#|
'  \*               */
'
' // By Elektro H@cker
'
'   Description:
'   ............
' · A RichTextbox used as a Label to set text using various colors.
'
'   Methods:
'   ........
' · AppendText (Overload)

' Examples:
' RichTextLabel1.AppendText("My ", Color.White, , New Font("Arial", 12, FontStyle.Bold))
' RichTextLabel1.AppendText("RichText-", Color.White, , New Font("Arial", 12, FontStyle.Bold))
' RichTextLabel1.AppendText("Label", Color.YellowGreen, Color.Black, New Font("Lucida console", 16, FontStyle.Italic))

Imports System.ComponentModel

Public Class RichTextLabel : Inherits RichTextBox

   Public Sub New()
       MyBase.Enabled = False
       MyBase.Size = New Point(200, 20)
   End Sub

#Region " Overrided Properties "

   ''' <summary>
   ''' Turn the control backcolor to transparent.
   ''' </summary>
   Protected Overrides ReadOnly Property CreateParams() As CreateParams
       Get
           Dim cp As CreateParams = MyBase.CreateParams
           cp.ExStyle = (cp.ExStyle Or 32)
           Return cp
       End Get
   End Property

#End Region

#Region " Shadowed Properties "

   ' AcceptsTab
   ' Just hidden from the designer and editor.
   <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
   Public Shadows Property AcceptsTab() As Boolean
       Get
           Return MyBase.AcceptsTab
       End Get
       Set(value As Boolean)
           MyBase.AcceptsTab = False
       End Set
   End Property

   ' AutoWordSelection
   ' Just hidden from the designer and editor.
   <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
   Public Shadows Property AutoWordSelection() As Boolean
       Get
           Return MyBase.AutoWordSelection
       End Get
       Set(value As Boolean)
           MyBase.AutoWordSelection = False
       End Set
   End Property

   ' BackColor
   ' Not hidden, but little hardcoded 'cause the createparams transparency.
   <Browsable(True), EditorBrowsable(EditorBrowsableState.Always)>
   Public Shadows Property BackColor() As Color
       Get
           Return MyBase.BackColor
       End Get
       Set(value As Color)
           MyBase.SelectionStart = 0
           MyBase.SelectionLength = MyBase.TextLength
           MyBase.SelectionBackColor = value
           MyBase.BackColor = value
       End Set
   End Property

   ' BorderStyle
   ' Just hidden from the designer and editor.
   <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
   Public Shadows Property BorderStyle() As BorderStyle
       Get
           Return MyBase.BorderStyle
       End Get
       Set(value As BorderStyle)
           MyBase.BorderStyle = BorderStyle.None
       End Set
   End Property

   ' Cursor
   ' Hidden from the designer and editor,
   ' because while the control is disabled the cursor always be the default even if changed.
   <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
   Public Shadows Property Cursor() As Cursor
       Get
           Return MyBase.Cursor
       End Get
       Set(value As Cursor)
           MyBase.Cursor = Cursors.Default
       End Set
   End Property

   ' Enabled
   ' Hidden from the but not from the editor,
   ' because to prevent exceptions when doing loops over a control collection to disable/enable controls.
   <Browsable(False), EditorBrowsable(EditorBrowsableState.Always)>
   Public Shadows Property Enabled() As Boolean
       Get
           Return MyBase.Enabled
       End Get
       Set(value As Boolean)
           MyBase.Enabled = False
       End Set
   End Property

   ' HideSelection
   ' Just hidden from the designer and editor.
   <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
   Public Shadows Property HideSelection() As Boolean
       Get
           Return MyBase.HideSelection
       End Get
       Set(value As Boolean)
           MyBase.HideSelection = True
       End Set
   End Property

   ' MaxLength
   ' Just hidden from the designer and editor.
   <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
   Public Shadows Property MaxLength() As Integer
       Get
           Return MyBase.MaxLength
       End Get
       Set(value As Integer)
           MyBase.MaxLength = 2147483646
       End Set
   End Property

   ' ReadOnly
   ' Just hidden from the designer and editor.
   <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
   Public Shadows Property [ReadOnly]() As Boolean
       Get
           Return MyBase.ReadOnly
       End Get
       Set(value As Boolean)
           MyBase.ReadOnly = True
       End Set
   End Property

   ' ScrollBars
   ' Just hidden from the designer and editor.
   <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
   Public Shadows Property ScrollBars() As RichTextBoxScrollBars
       Get
           Return MyBase.ScrollBars
       End Get
       Set(value As RichTextBoxScrollBars)
           MyBase.ScrollBars = RichTextBoxScrollBars.None
       End Set
   End Property

   ' ShowSelectionMargin
   ' Just hidden from the designer and editor.
   <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
   Public Shadows Property ShowSelectionMargin() As Boolean
       Get
           Return MyBase.ShowSelectionMargin
       End Get
       Set(value As Boolean)
           MyBase.ShowSelectionMargin = False
       End Set
   End Property

   ' TabStop
   ' Just hidden from the designer and editor.
   <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
   Public Shadows Property TabStop() As Boolean
       Get
           Return MyBase.TabStop
       End Get
       Set(value As Boolean)
           MyBase.TabStop = False
       End Set
   End Property

#End Region

#Region " Funcs & Procs "

   ''' <summary>
   ''' Append text to the current text.
   ''' </summary>
   ''' <param name="text">The text to append</param>
   ''' <param name="forecolor">The font color</param>
   ''' <param name="backcolor">The Background color</param>
   ''' <param name="font">The font of the appended text</param>
   Public Overloads Sub AppendText(ByVal text As String, _
                         ByVal forecolor As Color, _
                         Optional ByVal backcolor As Color = Nothing, _
                         Optional ByVal font As Font = Nothing)

       Dim index As Int32 = MyBase.TextLength
       MyBase.AppendText(text)
       MyBase.SelectionStart = index
       MyBase.SelectionLength = MyBase.TextLength - index
       MyBase.SelectionColor = forecolor

       If Not backcolor = Nothing _
       Then MyBase.SelectionBackColor = backcolor _
       Else MyBase.SelectionBackColor = DefaultBackColor

       If font IsNot Nothing Then MyBase.SelectionFont = font

       ' Reset selection
       MyBase.SelectionStart = MyBase.TextLength
       MyBase.SelectionLength = 0

   End Sub

#End Region

End Class

[Eleкtro]

Una Class que hice para manejar las API's del Caret.

[youtube=640,360]http://www.youtube.com/watch?v=7ZKRnT7qll4&feature=youtu.be[/youtube]

Código (vbnet) [Seleccionar] Expandir

#Region " Caret "

' [ Caret Class ]
'
' // By Elektro H@cker
'
' Examples:
' Dim bmp As New Bitmap("C:\Image.jpg")
' Caret.Create(TextBox1, 7)
' Caret.Create(TextBox1, bmp, 20)
' Caret.BlinkTime(500)
' Caret.Hide(TextBox1)
' Caret.Show(TextBox1)
' Caret.Destroy()

Public Class Caret

#Region " API's "

   Private Declare Function CreateCaret Lib "user32" (ByVal hwnd As IntPtr, ByVal hBitmap As IntPtr, ByVal nWidth As Int64, ByVal nHeight As Int64) As Int64
   Private Declare Function HideCaret Lib "user32" (ByVal hwnd As IntPtr) As Int64
   Private Declare Function ShowCaret Lib "user32" (ByVal hwnd As IntPtr) As Int64
   Private Declare Function SetCaretBlinkTime Lib "user32" (ByVal wMSeconds As Int64) As Int64
   Private Declare Function SetCaretPos Lib "user32" (ByVal x As Int64, ByVal y As Int64) As Int64
   Private Declare Function DestroyCaret Lib "user32" () As Int64

#End Region

#Region " Funcs & Procs "

   ''' <summary>
   ''' Create a new caret.
   ''' </summary>
   ''' <param name="ctrl">The name of the control.</param>
   ''' <param name="Width">The Width of the caret cursor.</param>
   ''' <param name="Height">The name of the caret cursor.</param>
   Public Shared Sub Create(ByVal ctrl As Control, _
                            ByVal Width As Int32, _
                            Optional ByVal Height As Int32 = 0)

       If Height = 0 Then
           CreateCaret(ctrl.Handle, IntPtr.Zero, Width, (ctrl.Font.Size * 2))
       Else
           CreateCaret(ctrl.Handle, IntPtr.Zero, Width, Height)
       End If

       Show(ctrl)

   End Sub

   ''' <summary>
   ''' Create a new caret with Bitmap image.
   ''' </summary>
   ''' <param name="ctrl">The name of the control.</param>
   ''' <param name="bmp">The Bitmap image to use.</param>
   ''' <param name="Width">The Width of the caret cursor.</param>
   ''' <param name="Height">The name of the caret cursor.</param>
   Public Shared Sub Create(ByVal ctrl As Control, _
                            ByVal bmp As Bitmap, _
                            ByVal Width As Int32, _
                            Optional ByVal Height As Int32 = 0)


       If Height = 0 Then
           bmp = Resize_Bitmap(bmp, Width, (ctrl.Font.Size * 2))
           CreateCaret(ctrl.Handle, bmp.GetHbitmap, Width, (ctrl.Font.Size * 2))
       Else
           bmp = Resize_Bitmap(bmp, Width, Height)
           CreateCaret(ctrl.Handle, bmp.GetHbitmap, Width, Height)
       End If

       Show(ctrl)

   End Sub

   ''' <summary>
   ''' Hide the caret.
   ''' </summary>
   ''' <param name="ctrl">The name of the control.</param>
   Public Shared Sub Hide(ByVal ctrl As Control)
       HideCaret(ctrl.Handle)
   End Sub

   ''' <summary>
   ''' Show the caret.
   ''' </summary>
   ''' <param name="ctrl">The name of the control.</param>
   Public Shared Sub Show(ByVal ctrl As Control)
       ShowCaret(ctrl.Handle)
   End Sub

   ''' <summary>
   ''' Set the blinking time of the caret.
   ''' </summary>
   ''' <param name="ms">Blink interval in Milliseconds.</param>
   Public Shared Sub BlinkTime(ByVal ms As Int64)
       SetCaretBlinkTime(ms)
   End Sub

   ''' <summary>
   ''' Set the position of the caret.
   ''' </summary>
   ''' <param name="x">X coordinate.</param>
   ''' <param name="y">Y coordinate.</param>
   Public Shared Sub Position(ByVal X As Int32, ByVal Y As Int32)
       SetCaretPos(X, Y)
   End Sub

   ''' <summary>
   ''' Destroy the caret.
   ''' </summary>
   Public Shared Sub Destroy()
       DestroyCaret()
   End Sub

   ' Resizes a Bitmap Image
   Private Shared Function Resize_Bitmap(ByVal bmp As Bitmap, ByVal Width As Int32, ByVal Height As Int32) As Bitmap
       Dim Bitmap_Source As New Bitmap(bmp)
       Dim Bitmap_Dest As New Bitmap(CInt(Width), CInt(Height))
       Dim Graphic As Graphics = Graphics.FromImage(Bitmap_Dest)
       Graphic.DrawImage(Bitmap_Source, 0, 0, Bitmap_Dest.Width + 1, Bitmap_Dest.Height + 1)
       Return Bitmap_Dest
   End Function

#End Region

End Class

#End Region

[Eleкtro]

Validar una fecha:

Código (vbnet) [Seleccionar] Expandir

#Region " Validate Date "

   ' [ Validate Date Function ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   '
   ' MsgBox(Validate_Date("29-02-2013")) ' Result: False
   ' MsgBox(Validate_Date("29-02-2016")) ' Result: True
   ' MsgBox(Validate_Date("01/01/2014")) ' Result: True

   Private Function Validate_Date(ByVal [Date] As String) As Boolean
       Return Date.TryParse([Date], New Date)
   End Function

#End Region

PD: @Novlucker, sé que es muy cortito, pero útil para quien no sepa!

[Eleкtro]

Integración para deshacer/rehacer (Undo/Redo) para estos controles:

Código [Seleccionar] Expandir

   TextBox
   ComboBox
   DateTimePicker
   NumericUpDown
   MaskedTextBox
   ListBox (single and multi-select)
   CheckBox
   RadioButton
   MonthCalendar


INSTRUCCIONES:
1. copiar las siguientes classes en el proyecto:

Código (vbnet) [Seleccionar] Expandir

'******************************************************************************************************************
' Undo/Redo framework (c) Copyright 2009 Etienne Nijboer
'******************************************************************************************************************

Public Enum UndoRedoCommandType
   ctNone
   ctUndo
   ctRedo
End Enum

Public Class UndoRedoManager

#Region "UndoRedoMonitor auto register types"

   Private Shared RegisteredUndoRedoMonitorTypes As List(Of Type) = Nothing

   ' ScanAssembly
   ' The first created UndoRedoMonitor will scan the assembly for BaseUndoRedoMonitors and
   ' store these types in the monitor type list.
   '
   Private Shared Sub ScanAssembly()
       If RegisteredUndoRedoMonitorTypes Is Nothing Then
           RegisteredUndoRedoMonitorTypes = New List(Of Type)
           Dim AssemblyTypes() As Type = Reflection.Assembly.GetExecutingAssembly().GetTypes()
           Dim BaseUndoRedoMonitorType As Type = GetType(BaseUndoRedoMonitor)
           For Each typeItem As Type In AssemblyTypes
               If typeItem.BaseType Is BaseUndoRedoMonitorType Then
                   RegisteredUndoRedoMonitorTypes.Add(typeItem)
               End If
           Next
       End If
   End Sub

#End Region

   Private Control As Control = Nothing
   Private UndoRedoMonitors As List(Of BaseUndoRedoMonitor)
   Private ExcludeControls As List(Of Control)

   ' InitializeUndoRedoMonitors
   ' When a new UndoRedoManager instance is created, a new instance of each registered monitor
   ' is created and used only within the scope of this UndoRedoManager, preventing temporary data
   ' moved to another UndoRedoManager. This is because Each form, or group control like a panel
   ' to make seperate undo/redo groups on a single form, can have it's own UndoRedoManager. It is
   ' of course also possible to use one global UndoRedoManager for multiple forms. This lets you
   ' control how data is seperated or combined, depending on the relation between te undo/redo commands.
   Private Sub InitializeUndoRedoMonitors()
       ScanAssembly()
       UndoRedoMonitors = New List(Of BaseUndoRedoMonitor)
       For Each typeItem In RegisteredUndoRedoMonitorTypes
           UndoRedoMonitors.Add(Activator.CreateInstance(typeItem, Me))
       Next
   End Sub

   Public Sub New()
       InitializeUndoRedoMonitors()
   End Sub

   Public Sub New(ByVal AControl As Control)
       Me.New(AControl, New List(Of Control))
   End Sub

   Public Sub New(ByVal AControl As Control, ByVal AExcludeControls As List(Of Control))
       Me.New()
       ExcludeControls = AExcludeControls
       MonitorControl(AControl)
   End Sub

   Public Sub New(ByVal AControl As Control, ByVal ParamArray AExcludeControls() As Control)
       Me.New(AControl, AExcludeControls.ToList)
   End Sub

   ' MonitorControl
   ' If a given control is not in the list of controls to exclude from undo/redo actions,
   ' an attempt is made to attach it to a matching UndoRedoMonitor. If no direct match is
   ' found, a same attempt is made for each control contained within the control recursively.
   Private Sub MonitorControl(ByVal AControl As Control)
       If Not ExcludeControls.Contains(AControl) Then
           If Not BindMonitor(AControl) Then
               For Each ctl As Control In AControl.Controls
                   MonitorControl(ctl)
               Next
           End If
       End If
   End Sub

   ' BindMonitor
   ' An attempt is made to bind the control to a each registered monitor. When a match is  
   ' found the search ends and the function will return true, false otherwise meaning there
   ' is no specific UndoRedoMonitor for this control.
   Private Function BindMonitor(ByVal AControl As Control) As Boolean
       Dim index As Integer = UndoRedoMonitors.Count - 1, result As Boolean = False
       While index >= 0 And Not result
           result = UndoRedoMonitors(index).Monitor(AControl)
           index -= 1
       End While
       Return result
   End Function

   Public Sub Monitor(ByVal AControl As Control)
       MonitorControl(AControl)
   End Sub

   Private undoStack As Stack(Of BaseUndoRedoCommand) = New Stack(Of BaseUndoRedoCommand)
   Private redoStack As Stack(Of BaseUndoRedoCommand) = New Stack(Of BaseUndoRedoCommand)
   Private _undoRedoCommand As UndoRedoCommandType = UndoRedoCommandType.ctNone
   Private _canUndo As Boolean = False
   Private _canRedo As Boolean = False

   Public Event CanUndoChanged(ByVal Sender As Object, ByVal CanUndo As Boolean)
   Public Event CanRedoChanged(ByVal Sender As Object, ByVal CanRedo As Boolean)
   Public Event UndoRedoStacksChanged(ByVal Sender As Object)

   Private Sub UpdateCanUndoRedo()
       Dim isCanUndoChanged As Boolean = Not (undoStack.Count > 0) = _canUndo, _
           isCanRedoChanged As Boolean = Not (redoStack.Count > 0) = _canRedo
       _canUndo = undoStack.Count > 0
       _canRedo = redoStack.Count > 0
       If isCanUndoChanged Then
           RaiseEvent CanUndoChanged(Me, _canUndo)
       End If
       If isCanRedoChanged Then
           RaiseEvent CanRedoChanged(Me, _canRedo)
       End If
       RaiseEvent UndoRedoStacksChanged(Me)
   End Sub

   Public ReadOnly Property isUndoing() As Boolean
       Get
           Return _undoRedoCommand = UndoRedoCommandType.ctUndo
       End Get
   End Property
   Public ReadOnly Property isRedoing() As Boolean
       Get
           Return _undoRedoCommand = UndoRedoCommandType.ctRedo
       End Get
   End Property
   Public ReadOnly Property isPerformingUndoRedo() As Boolean
       Get
           Return _undoRedoCommand <> UndoRedoCommandType.ctNone
       End Get
   End Property

   Public ReadOnly Property CanUndo() As Boolean
       Get
           Return _canUndo
       End Get
   End Property

   Public ReadOnly Property CanRedo() As Boolean
       Get
           Return _canRedo
       End Get
   End Property

   Public Sub AddUndoCommand(ByVal UndoRedoCommand As BaseUndoRedoCommand)
       If Not isUndoing Then
           undoStack.Push(UndoRedoCommand)
           If Not isRedoing Then
               redoStack.Clear()
               UpdateCanUndoRedo()
           End If
       End If
   End Sub

   Public Sub AddRedoCommand(ByVal UndoRedoCommand As BaseUndoRedoCommand)
       If Not isRedoing Then
           redoStack.Push(UndoRedoCommand)
           If Not isUndoing Then
               UpdateCanUndoRedo()
           End If
       End If
   End Sub

   Public Sub AddCommand(ByVal UndoRedoCommandType As UndoRedoCommandType, ByVal UndoRedoCommand As BaseUndoRedoCommand)
       Select Case UndoRedoCommandType
           Case UndoRedoCommandType.ctUndo
               AddUndoCommand(UndoRedoCommand)
           Case UndoRedoCommandType.ctRedo
               AddRedoCommand(UndoRedoCommand)
           Case Else
               Throw New Exception("An undo or redo command could not be accepted.")
       End Select
   End Sub

   Public Sub Undo()
       If CanUndo Then
           'Try                
           _undoRedoCommand = UndoRedoCommandType.ctUndo
           undoStack.Pop.Undo()
           'Catch e As Exception
           'Finally
           UpdateCanUndoRedo()
           _undoRedoCommand = UndoRedoCommandType.ctNone
           'End Try
       End If
   End Sub

   Public Sub Redo()
       If CanRedo Then
           _undoRedoCommand = UndoRedoCommandType.ctRedo
           redoStack.Pop.Redo()
           UpdateCanUndoRedo()
           _undoRedoCommand = UndoRedoCommandType.ctNone
       End If
   End Sub

   Protected Overrides Sub Finalize()
       MyBase.Finalize()
   End Sub


#Region "debug info"

   Public Shared Function ArrayToString(ByVal ObjectArray() As Object) As String
       Dim sb As New System.Text.StringBuilder
       For Each item As Object In ObjectArray
           sb.AppendLine(item.ToString)
       Next
       Return sb.ToString
   End Function


   Public Function GetUndoStack() As String
       Return ArrayToString(undoStack.ToArray)
   End Function

   Public Function GetRedoStack() As String
       Return ArrayToString(redoStack.ToArray)
   End Function

   Public Function GetRegisteredUndoRedoMonitorTypes() As String
       Return ArrayToString(RegisteredUndoRedoMonitorTypes.ToArray)
   End Function

#End Region

End Class


Código (vbnet) [Seleccionar] Expandir

'******************************************************************************************************************
' Undo/Redo framework (c) Copyright 2009 Etienne Nijboer
'******************************************************************************************************************

Public MustInherit Class BaseUndoRedoMonitor

   Public Sub New(ByVal AUndoRedoManager As UndoRedoManager)
       _UndoRedoManager = AUndoRedoManager
   End Sub

   Private _UndoRedoManager As UndoRedoManager
   Public Property UndoRedoManager() As UndoRedoManager
       Get
           Return _UndoRedoManager
       End Get
       Set(ByVal value As UndoRedoManager)
           _UndoRedoManager = value
       End Set
   End Property

   Public ReadOnly Property isUndoing() As Boolean
       Get
           Return UndoRedoManager.isUndoing
       End Get
   End Property
   Public ReadOnly Property isRedoing() As Boolean
       Get
           Return UndoRedoManager.isRedoing
       End Get
   End Property

   Public ReadOnly Property isPerformingUndoRedo() As Boolean
       Get
           Return UndoRedoManager.isPerformingUndoRedo
       End Get
   End Property

   Public Sub AddCommand(ByVal UndoRedoCommandType As UndoRedoCommandType, ByVal UndoRedoCommand As BaseUndoRedoCommand)
       UndoRedoManager.AddCommand(UndoRedoCommandType, UndoRedoCommand)
   End Sub

   Public MustOverride Function Monitor(ByVal AControl As Control) As Boolean

End Class

'****************************************************************************************************************
' SimpleControl
' Controls: TextBox, ComboBox, DateTimePicker, NumericUpDown, MaskedTextBox
'****************************************************************************************************************
Public Class SimpleControlMonitor : Inherits BaseUndoRedoMonitor

   Private Data As String

   Public Sub New(ByVal AUndoRedoManager As UndoRedoManager)
       MyBase.New(AUndoRedoManager)
   End Sub

   Public Overrides Function Monitor(ByVal AControl As System.Windows.Forms.Control) As Boolean
       If TypeOf AControl Is TextBox Or _
          TypeOf AControl Is ComboBox Or _
          TypeOf AControl Is DateTimePicker Or _
          TypeOf AControl Is NumericUpDown Or _
          TypeOf AControl Is ListView Or _
          TypeOf AControl Is MaskedTextBox Then
           AddHandler AControl.Enter, AddressOf Control_Enter
           AddHandler AControl.Leave, AddressOf Control_Leave
           Return True
       End If
       Return False
   End Function

   Private Sub Control_Enter(ByVal sender As System.Object, ByVal e As System.EventArgs)
       Data = CType(sender, Control).Text
   End Sub

   Private Sub Control_Leave(ByVal sender As System.Object, ByVal e As System.EventArgs)
       Dim CurrentData As String = CType(sender, Control).Text
       If Not String.Equals(CurrentData, Data) Then
           AddCommand(UndoRedoCommandType.ctUndo, New SimpleControlUndoRedoCommand(Me, sender, Data))
       End If
   End Sub
End Class

'****************************************************************************************************************
' ListBox
'****************************************************************************************************************
Public Class ListBoxMonitor : Inherits BaseUndoRedoMonitor

   Private Data As Object

   Public Sub New(ByVal AUndoRedoManager As UndoRedoManager)
       MyBase.New(AUndoRedoManager)
   End Sub

   Public Overrides Function Monitor(ByVal AControl As System.Windows.Forms.Control) As Boolean
       If TypeOf AControl Is ListBox Then
           AddHandler AControl.Enter, AddressOf Control_Enter
           AddHandler CType(AControl, ListBox).SelectedIndexChanged, AddressOf Control_Changed
           Return True
       End If
       Return False
   End Function

   Public Function GetSelected(ByVal AListBox As Object) As String
       Dim Indices As List(Of String) = New List(Of String)
       For Each itemIndex As Integer In CType(AListBox, ListBox).SelectedIndices
           Indices.Add(CStr(itemIndex + 1))
       Next
       Return String.Join(",", Indices.ToArray)
   End Function

   Public Sub RestoreSelected(ByVal AListBox As Object, ByVal ASelection As String)
       If Not String.IsNullOrEmpty(ASelection) Then
           Dim Indices As List(Of Integer) = New List(Of Integer)(Array.ConvertAll(ASelection.Split(","), New Converter(Of String, Integer)(AddressOf Integer.Parse)))
           Dim Control As ListBox = CType(AListBox, ListBox)
           Select Case Control.SelectionMode
               Case SelectionMode.None
               Case SelectionMode.One
                   Control.SetSelected(Indices(0) - 1, True)
               Case SelectionMode.MultiSimple, SelectionMode.MultiExtended
                   For index As Integer = 0 To Control.Items.Count - 1
                       Control.SetSelected(index, Indices.IndexOf(index + 1) >= 0)
                   Next
           End Select
       Else
           CType(AListBox, ListBox).ClearSelected()
       End If
   End Sub

   Private Sub Control_Changed(ByVal sender As System.Object, ByVal e As System.EventArgs)
       ' Events that are also fired when the undo/redo value is changed by code, like change events,
       ' it is important to make sure that no undo/redo command is added when performing a undo/redo action.
       If Not isPerformingUndoRedo Then
           Dim CurrentData As String = GetSelected(sender)
           If Not String.Equals(Data, CurrentData) Then
               AddCommand(UndoRedoCommandType.ctUndo, New ListBoxUndoRedoCommand(Me, sender, Data))
               Data = CurrentData
           End If
       End If
   End Sub

   Private Sub Control_Enter(ByVal sender As System.Object, ByVal e As System.EventArgs)
       Data = GetSelected(sender)
   End Sub

End Class


'****************************************************************************************************************
' CheckBox
'****************************************************************************************************************
Public Class CheckBoxMonitor : Inherits BaseUndoRedoMonitor
   Private Data As CheckState

   Public Sub New(ByVal AUndoRedoManager As UndoRedoManager)
       MyBase.New(AUndoRedoManager)
   End Sub

   Public Overrides Function Monitor(ByVal AControl As System.Windows.Forms.Control) As Boolean
       If TypeOf AControl Is CheckBox Then
           AddHandler AControl.Enter, AddressOf Control_Enter
           AddHandler AControl.Leave, AddressOf Control_Leave
           Return True
       End If
       Return False
   End Function

   Private Sub Control_Enter(ByVal sender As System.Object, ByVal e As System.EventArgs)
       Data = CType(sender, CheckBox).CheckState
   End Sub

   Private Sub Control_Leave(ByVal sender As System.Object, ByVal e As System.EventArgs)
       Dim CurrentData As CheckState = CType(sender, CheckBox).CheckState
       If Data <> CurrentData Then
           AddCommand(UndoRedoCommandType.ctUndo, New CheckBoxUndoRedoCommand(Me, sender, Data))
       End If
   End Sub
End Class

'****************************************************************************************************************
' RadioButton
'****************************************************************************************************************
Public Class RadioButtonMonitor : Inherits BaseUndoRedoMonitor
   Private Data As RadioButton

   Public Sub New(ByVal AUndoRedoManager As UndoRedoManager)
       MyBase.New(AUndoRedoManager)
   End Sub

   Public Overrides Function Monitor(ByVal AControl As System.Windows.Forms.Control) As Boolean
       If TypeOf AControl Is RadioButton Then
           AddHandler CType(AControl, RadioButton).CheckedChanged, AddressOf Control_CheckedChanged
           Return True
       End If
       Return False
   End Function

   Private Sub Control_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs)
       ' Events that are also fired when the undo/redo value is changed by code, like change events,
       ' it is important to make sure that no undo/redo command is added when performing a undo/redo action.  
       If Not isPerformingUndoRedo Then
           If CType(sender, RadioButton).Checked Then
               AddCommand(UndoRedoCommandType.ctUndo, New RadioButtonUndoRedoCommand(Me, sender, Data))
           Else
               Data = sender
           End If
       End If
   End Sub
End Class

'****************************************************************************************************************
' MonthCalendar
'****************************************************************************************************************
Public Class MonthCalendarMonitor : Inherits BaseUndoRedoMonitor
   Private Data As SelectionRange

   Public Sub New(ByVal AUndoRedoManager As UndoRedoManager)
       MyBase.New(AUndoRedoManager)
   End Sub

   Public Overrides Function Monitor(ByVal AControl As System.Windows.Forms.Control) As Boolean
       If TypeOf AControl Is MonthCalendar Then
           AddHandler AControl.Enter, AddressOf Control_Enter
           AddHandler CType(AControl, MonthCalendar).DateSelected, AddressOf Control_DateSelected
           Return True
       End If
       Return False
   End Function

   Private Sub Control_Enter(ByVal sender As System.Object, ByVal e As System.EventArgs)
       Data = CType(sender, MonthCalendar).SelectionRange
   End Sub

   Private Sub Control_DateSelected(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DateRangeEventArgs)
       ' Events that are also fired when the undo/redo value is changed by code, like selected events,
       ' it is important to make sure that no undo/redo command is added when performing a undo/redo action.
       If Not isPerformingUndoRedo Then
           Dim CurrentData As SelectionRange = CType(sender, MonthCalendar).SelectionRange
           If Not SelectionRange.Equals(Data, CurrentData) Then
               AddCommand(UndoRedoCommandType.ctUndo, New MonthCalendarUndoRedoCommand(Me, sender, Data))
               Data = CurrentData
           End If
       End If
   End Sub

End Class

Código (vbnet) [Seleccionar] Expandir

'******************************************************************************************************************
' Undo/Redo framework (c) Copyright 2009 Etienne Nijboer
'******************************************************************************************************************

Public MustInherit Class BaseUndoRedoCommand

   Private _UndoRedoMonitor As BaseUndoRedoMonitor
   Private _UndoRedoControl As Control
   Private _UndoRedoData As Object

   Public ReadOnly Property UndoRedoMonitor() As BaseUndoRedoMonitor
       Get
           Return _UndoRedoMonitor
       End Get
   End Property

   Public ReadOnly Property UndoRedoControl() As Control
       Get
           Return _UndoRedoControl
       End Get
   End Property

   Protected Property UndoRedoData() As Object
       Get
           Return _UndoRedoData
       End Get
       Set(ByVal value As Object)
           _UndoRedoData = value
       End Set
   End Property

   Protected Sub New()
       Throw New Exception("Cannot create instance with the default constructor.")
   End Sub

   Public Sub New(ByVal AUndoRedoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control)
       Me.New(AUndoRedoMonitor, AMonitorControl, Nothing)
   End Sub

   Public Sub New(ByVal AUndoRedoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control, ByVal AUndoRedoData As Object)
       _UndoRedoMonitor = AUndoRedoMonitor
       _UndoRedoControl = AMonitorControl
       _UndoRedoData = AUndoRedoData
   End Sub

   Protected Sub AddCommand(ByVal UndoRedoCommandType As UndoRedoCommandType, ByVal UndoRedoCommand As BaseUndoRedoCommand)
       UndoRedoMonitor.AddCommand(UndoRedoCommandType, UndoRedoCommand)
   End Sub

   Public Overridable Sub Undo()
       AddCommand(UndoRedoCommandType.ctRedo, Activator.CreateInstance(Me.GetType, UndoRedoMonitor, UndoRedoControl))
   End Sub

   Public Overridable Sub Redo()
       AddCommand(UndoRedoCommandType.ctUndo, Activator.CreateInstance(Me.GetType, UndoRedoMonitor, UndoRedoControl))
   End Sub

   Public Overridable Sub Undo(ByVal RedoData As Object)
       AddCommand(UndoRedoCommandType.ctRedo, Activator.CreateInstance(Me.GetType, UndoRedoMonitor, UndoRedoControl, RedoData))
   End Sub

   Public Overridable Sub Redo(ByVal UndoData As Object)
       AddCommand(UndoRedoCommandType.ctUndo, Activator.CreateInstance(Me.GetType, UndoRedoMonitor, UndoRedoControl, UndoData))
   End Sub

   Public MustOverride Function CommandAsText() As String

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

End Class

'****************************************************************************************************************
' SimpleControl
' Controls: TextBox, ComboBox, DateTimePicker, NumericUpDown, MaskedTextBox
'****************************************************************************************************************
Public Class SimpleControlUndoRedoCommand : Inherits BaseUndoRedoCommand

   Protected ReadOnly Property UndoRedoText() As String
       Get
           Return CStr(UndoRedoData)
       End Get
   End Property

   Public Sub New(ByVal AUndoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control)
       MyBase.New(AUndoMonitor, AMonitorControl)
       UndoRedoData = UndoRedoControl.Text
   End Sub

   Public Sub New(ByVal AUndoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control, ByVal AUndoRedoData As String)
       MyBase.New(AUndoMonitor, AMonitorControl, AUndoRedoData)
   End Sub

   Public Overrides Sub Undo()
       MyBase.Undo()
       UndoRedoControl.Text = UndoRedoText
   End Sub

   Public Overrides Sub Redo()
       MyBase.Redo()
       UndoRedoControl.Text = UndoRedoText
   End Sub

   Public Overrides Function CommandAsText() As String
       Return String.Format("Change to '{0}'", UndoRedoText)
   End Function

End Class

'****************************************************************************************************************
' ListBox
'****************************************************************************************************************
Public Class ListBoxUndoRedoCommand : Inherits BaseUndoRedoCommand

   Public Sub New(ByVal AUndoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control)
       MyBase.New(AUndoMonitor, AMonitorControl)
       UndoRedoData = GetSelection()
   End Sub

   Public Sub New(ByVal AUndoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control, ByVal AUndoRedoData As Object)
       MyBase.New(AUndoMonitor, AMonitorControl, AUndoRedoData)
   End Sub

   Public ReadOnly Property Control() As ListBox
       Get
           Return CType(UndoRedoControl, ListBox)
       End Get
   End Property

   Private Sub RestoreSelection()
       CType(UndoRedoMonitor, ListBoxMonitor).RestoreSelected(UndoRedoControl, CStr(UndoRedoData))
   End Sub

   Private Function GetSelection() As Object
       Return CType(UndoRedoMonitor, ListBoxMonitor).GetSelected(UndoRedoControl)
   End Function

   Public Overrides Sub Undo()
       MyBase.Undo()
       RestoreSelection()
   End Sub

   Public Overrides Sub Redo()
       MyBase.Redo()
       RestoreSelection()
   End Sub

   Public Overrides Function CommandAsText() As String
       Return String.Format("Select {0}", CStr(UndoRedoData))
   End Function
End Class


'****************************************************************************************************************
' CheckBox
'****************************************************************************************************************
Public Class CheckBoxUndoRedoCommand : Inherits BaseUndoRedoCommand

   Protected ReadOnly Property UndoRedoCheckState() As CheckState
       Get
           Return CType(UndoRedoData, CheckState)
       End Get
   End Property

   Public Sub New(ByVal AUndoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control)
       MyBase.New(AUndoMonitor, AMonitorControl)
       UndoRedoData = Control.CheckState
   End Sub

   Public Sub New(ByVal AUndoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control, ByVal AUndoRedoData As String)
       MyBase.New(AUndoMonitor, AMonitorControl, AUndoRedoData)
   End Sub

   Public ReadOnly Property Control() As CheckBox
       Get
           Return CType(UndoRedoControl, CheckBox)
       End Get
   End Property

   Public Overrides Sub Undo()
       MyBase.Undo()
       Control.CheckState = UndoRedoCheckState
   End Sub

   Public Overrides Sub Redo()
       MyBase.Redo()
       Control.CheckState = UndoRedoCheckState
   End Sub

   Public Overrides Function CommandAsText() As String
       Return String.Format("Change to '{0}'", UndoRedoCheckState.ToString)
   End Function

End Class

'****************************************************************************************************************
' RadioButton
'****************************************************************************************************************
Public Class RadioButtonUndoRedoCommand : Inherits BaseUndoRedoCommand

   Protected ReadOnly Property UndoRedoRadioButton() As RadioButton
       Get
           Return CType(UndoRedoData, RadioButton)
       End Get
   End Property

   Public Sub New(ByVal AUndoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control)
       MyBase.New(AUndoMonitor, AMonitorControl)
       UndoRedoData = Control.Checked
   End Sub

   Public Sub New(ByVal AUndoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control, ByVal AUndoRedoData As Control)
       MyBase.New(AUndoMonitor, AMonitorControl, AUndoRedoData)
   End Sub

   Public ReadOnly Property Control() As RadioButton
       Get
           Return CType(UndoRedoControl, RadioButton)
       End Get
   End Property

   Public Overrides Sub Undo()
       MyBase.Undo(UndoRedoRadioButton)
       Control.Checked = False
       If UndoRedoRadioButton IsNot Nothing Then
           UndoRedoRadioButton.Checked = True
       End If
   End Sub

   Public Overrides Sub Redo()
       MyBase.Redo(UndoRedoRadioButton)
       If UndoRedoRadioButton IsNot Nothing Then
           UndoRedoRadioButton.Checked = False
       End If
       Control.Checked = True
   End Sub

   Public Overrides Function CommandAsText() As String
       If UndoRedoRadioButton IsNot Nothing Then
           Return String.Format("Invert '{0}'/'{1}'", Control.Text, UndoRedoRadioButton.Text)
       Else
           Return String.Format("Change '{0}'", Control.Text)
       End If
   End Function

End Class


'****************************************************************************************************************
' MonthCalendar
'****************************************************************************************************************
Public Class MonthCalendarUndoRedoCommand : Inherits BaseUndoRedoCommand

   Protected ReadOnly Property UndoRedoSelectionRange() As SelectionRange
       Get
           Return CType(UndoRedoData, SelectionRange)
       End Get
   End Property

   Public Sub New(ByVal AUndoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control)
       MyBase.New(AUndoMonitor, AMonitorControl)
       UndoRedoData = Control.SelectionRange
   End Sub

   Public Sub New(ByVal AUndoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control, ByVal AUndoRedoData As SelectionRange)
       MyBase.New(AUndoMonitor, AMonitorControl, AUndoRedoData)
   End Sub

   Public ReadOnly Property Control() As MonthCalendar
       Get
           Return CType(UndoRedoControl, MonthCalendar)
       End Get
   End Property

   Public Overrides Sub Undo()
       MyBase.Undo()
       Control.SelectionRange = UndoRedoSelectionRange
   End Sub

   Public Overrides Sub Redo()
       MyBase.Redo()
       Control.SelectionRange = UndoRedoSelectionRange
   End Sub

   Public Overrides Function CommandAsText() As String
       If Date.Equals(UndoRedoSelectionRange.Start, UndoRedoSelectionRange.End) Then
           Return String.Format("Select date {0}", FormatDateTime(UndoRedoSelectionRange.Start, DateFormat.ShortDate))
       Else
       End If
       Return String.Format("Change to '{0}'", String.Format("{0} until {1}", FormatDateTime(UndoRedoSelectionRange.Start, DateFormat.ShortDate), _
                                                                              FormatDateTime(UndoRedoSelectionRange.End, DateFormat.ShortDate)))
   End Function

End Class

2. Usarlo de esta manera:

Código (vbnet) [Seleccionar] Expandir

Public Class Form1

   Private WithEvents frmUndoRedoManager As UndoRedoManager

   Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
       frmUndoRedoManager = New UndoRedoManager(Me)
   End Sub

   Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
       frmUndoRedoManager.Undo()
   End Sub

   Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
       frmUndoRedoManager.Redo()
   End Sub

End Class

Saludos.

[Eleкtro]

Una class para manejar Audios en la librería NAudio.

(Es algo corta, lo sé, no he experimentado más cosas que las que necesito de esta librería)

Código (vbnet) [Seleccionar] Expandir

#Region " NAudio "

Public Class NAudio_Helper

   ' [ NAudio ]
   '
   ' // By Elektro H@cker
   '
   ' Instructions:
   ' 1. Add a reference for the "NAudio.dll" file into the project.
   '
   ' Examples:
   '
   ' Dim Stream As NAudio.Wave.WaveFileReader = New NAudio.Wave.WaveFileReader(File)
   '
   ' Set_Volume(Stream, 0.5)
   ' Play_Sound(Stream, 1)
   ' Play_Sound(My.Resources.AudioFile)
   ' Play_Sound("C:\File.wav")


   ' Play Sound (File)
   Private Sub Play_Sound(ByVal File As String, _
                          Optional ByVal Volume As Single = Nothing)

       Dim Wave As New NAudio.Wave.WaveOut

       Select Case File.Split(".").Last.ToLower
           Case "aiff"
               Wave.Init(New NAudio.Wave.AiffFileReader(File))
           Case "mp3"
               Wave.Init(New NAudio.Wave.Mp3FileReader(File))
           Case "wav"
               Wave.Init(New NAudio.Wave.WaveFileReader(File))
           Case Else
               Wave.Init(New NAudio.Wave.BlockAlignReductionStream(NAudio.Wave.WaveFormatConversionStream.CreatePcmStream(New NAudio.Wave.AudioFileReader(File))))
       End Select

       If Not Volume = Nothing Then Wave.Volume = Volume
       Wave.Play()

   End Sub

   ' Play Sound (MemoryStream)
   Private Sub Play_Sound(ByVal Stream As IO.MemoryStream, _
                          Optional ByVal Volume As Single = Nothing)

       Dim Wave As New NAudio.Wave.WaveOut
       Wave.Init(New NAudio.Wave.BlockAlignReductionStream(NAudio.Wave.WaveFormatConversionStream.CreatePcmStream(New NAudio.Wave.WaveFileReader(Stream))))
       If Not Volume = Nothing Then Wave.Volume = Volume
       Wave.Play()

   End Sub

   ' Play Sound (Unmanaged MemoryStream)
   Private Sub Play_Sound(ByVal Stream As IO.UnmanagedMemoryStream, _
                          Optional ByVal Volume As Single = Nothing)

       Dim Wave As New NAudio.Wave.WaveOut
       Wave.Init(New NAudio.Wave.BlockAlignReductionStream(NAudio.Wave.WaveFormatConversionStream.CreatePcmStream(New NAudio.Wave.WaveFileReader(Stream))))
       If Not Volume = Nothing Then Wave.Volume = Volume
       Wave.Play()

   End Sub

   ' Play Sound (NAudio Stream)
   Private Sub Play_Sound(ByVal NAudio_Stream As Object, _
                          Optional ByVal Volume As Single = Nothing)

       Dim Wave As New NAudio.Wave.WaveOut
       Wave.Init(NAudio_Stream)
       If Not Volume = Nothing Then Wave.Volume = Volume
       Wave.Play()

   End Sub

   ' Set Volume (NAudio Stream)
   Private Function Set_Volume(ByVal NAudio_Stream As Object, ByVal Volume As Single) _
   As NAudio.Wave.WaveOut

       Dim Wave As New NAudio.Wave.WaveOut
       Wave.Init(NAudio_Stream)
       Wave.Volume = Volume
       Return Wave

   End Function

End Class

#End Region

[Eleкtro]

He ideado esya función para convertir un archivo REG a un script BAT.

La verdad es que no me ha costado mucho, ya había desarrollado antes la manera de convertir usando Ruby y sólo he tenido que trasladar el código que hice y agregarle las mejoras de VBNET xD.

Código (vbnet) [Seleccionar] Expandir


    #Region " Reg2Bat "
     
       ' [ Reg2Bat Function ]
       '
       ' // By Elektro H@cker
       '
       ' Examples :
       ' MsgBox(Reg2Bat("C:\Registry.reg"))

    Private Function Reg2Bat(ByVal Reg_File As String) As String

        ' Source Input
        ' Join he lines, delete the Regedit linebreaks characters: "\  ", and then split the lines.
        Dim RegFile() As String = Split( _
                                  String.Join("@@@Reg2Bat@@@", IO.File.ReadAllLines(Reg_File)) _
                                  .Replace("\@@@Reg2Bat@@@  ", "") _
                                  .Replace("@@@Reg2Bat@@@", Environment.NewLine), _
                                  Environment.NewLine)

        Dim RegLine As String = String.Empty ' Where the Regedit Line will be stored.
        Dim RegKey As String = String.Empty ' Where the Regedit Key will be stored.
        Dim RegVal As String = String.Empty ' Where the Regedit Value will be stored.
        Dim RegData As String = String.Empty ' Where the Regedit Data will be stored.

        Dim Batch_Commands As String = String.Empty ' Where the decoded Regedit strings will be stored.

        ' Check if first line of Reg File has a valid Regedit signature
        For X As Int64 = 0 To RegFile.LongLength - 1

            RegLine = RegFile(X).Trim

            While RegLine = String.Empty
                X += 1
                RegLine = RegFile(X).Trim
            End While

            If Not RegLine.ToLower = "windows registry editor version 5.00" Then
                Throw New Exception("This is not a valid Regedit v5.00 script.")
                Return Nothing
            Else
                Batch_Commands &= ":: Converted with REG2BAT By Elektro H@cker" & Environment.NewLine & Environment.NewLine
                Batch_Commands &= String.Format("REM {0}", RegLine) & Environment.NewLine & Environment.NewLine
                Exit For
            End If

        Next

        ' Start reading the Regedit File
        For X As Int64 = 0 To RegFile.LongLength - 1

            RegLine = RegFile(X).Trim

            Select Case True

                Case RegLine.StartsWith(";") ' Comment line

                    Batch_Commands &= Environment.NewLine
                    Batch_Commands &= String.Format("REM {0}", RegLine.Substring(1, RegLine.Length - 1).Trim)
                    Batch_Commands &= Environment.NewLine

                Case RegLine.StartsWith("[-") ' Key to delete

                    RegKey = RegLine.Substring(2, RegLine.Length - 3).Trim
                    Batch_Commands &= String.Format("REG DELETE ""{0}"" /F", RegKey)
                    Batch_Commands &= Environment.NewLine

                Case RegLine.StartsWith("[") ' Key to add

                    RegKey = RegLine.Substring(1, RegLine.Length - 2).Trim
                    Batch_Commands &= String.Format("REG ADD ""{0}"" /F", RegKey)
                    Batch_Commands &= Environment.NewLine

                Case RegLine.StartsWith("@=") ' Default Value to add

                    RegData = Split(RegLine, "@=", , CompareMethod.Text).Last
                    Batch_Commands &= String.Format("REG ADD ""{0}"" /V  """" /D {1} /F", RegKey, RegData)
                    Batch_Commands &= Environment.NewLine

                Case RegLine.StartsWith("""") _
                AndAlso RegLine.Split("=").Last = "-"  ' Value to delete

                    RegVal = RegLine.Substring(1, RegLine.Length - 4)
                    Batch_Commands &= String.Format("REG DELETE ""{0}"" /V ""{1}"" /F", RegKey, RegVal)
                    Batch_Commands &= Environment.NewLine

                Case RegLine.StartsWith("""") ' Value to add

                    RegLine = RegLine.Replace("\\", "\") ' Replace Double "\\" to single "\".

                    ' Check data type:
                    Select Case RegLine.Split("=")(1).Split(":")(0).ToLower

                        Case "hex" ' Binary

                            RegVal = Split(RegLine, "=hex:", , CompareMethod.Text)(0)
                            RegData = Split(RegLine, (RegVal & "=hex:"), , CompareMethod.Text).Last.Replace(",", "")
                            Batch_Commands &= String.Format("REG ADD ""{0}"" /V {1} /T ""REG_BINARY"" /D ""{2}"" /F", RegKey, RegVal, RegData)
                            Batch_Commands &= Environment.NewLine

                        Case "dword" ' DWORD

                            RegVal = Split(RegLine, "=dword:", , CompareMethod.Text)(0)
                            RegData = "0x" & Split(RegLine, (RegVal & "=dword:"), , CompareMethod.Text).Last
                            Batch_Commands &= String.Format("REG ADD ""{0}"" /V {1} /T ""REG_DWORD"" /D ""{2}"" /F", RegKey, RegVal, RegData)
                            Batch_Commands &= Environment.NewLine

                        Case "hex(b)" ' QWORD

                            Dim TempData As String = "0x"
                            RegVal = Split(RegLine, "=hex(b):", , CompareMethod.Text)(0)
                            RegData = StrReverse(Split(RegLine, (RegVal & "=hex(b):"), , CompareMethod.Text).Last)
                            For Each [byte] In RegData.Split(",") : TempData &= StrReverse([byte]) : Next
                            Batch_Commands &= String.Format("REG ADD ""{0}"" /V {1} /T ""REG_QWORD"" /D ""{2}"" /F", RegKey, RegVal, TempData)
                            Batch_Commands &= Environment.NewLine

                        Case "hex(2)"  ' EXPAND SZ

                            Dim TempData As String = String.Empty
                            RegVal = Split(RegLine, "=Hex(2):", , CompareMethod.Text)(0)
                            RegData = Split(RegLine, (RegVal & "=hex(2):"), , CompareMethod.Text).Last.Replace(",00", "").Replace("00,", "")
                            For Each [byte] In RegData.Split(",") : TempData &= Chr(Val("&H" & [byte])) : Next
                            TempData = TempData.Replace("%", "%%").Replace("""", "\""")
                            Batch_Commands &= String.Format("REG ADD ""{0}"" /V {1} /T ""REG_EXPAND_SZ"" /D ""{2}"" /F", RegKey, RegVal, TempData)
                            Batch_Commands &= Environment.NewLine

                        Case "hex(7)" ' MULTI SZ

                            Dim TempData As String = String.Empty
                            RegVal = Split(RegLine, "=Hex(7):", , CompareMethod.Text)(0)
                            RegData = Split(RegLine, (RegVal & "=hex(7):"), , CompareMethod.Text).Last.Replace(",00,00,00", ",\0").Replace(",00", "").Replace("00,", "")

                            For Each [byte] In RegData.Split(",")

                                If [byte] = "\0" Then
                                    TempData &= "\0" ' Line separator for multiline.
                                Else
                                    TempData &= Chr(Val("&H" & [byte]))
                                End If

                            Next

                            TempData = TempData.Replace("%", "%%").Replace("""", "\""")
                            Batch_Commands &= String.Format("REG ADD ""{0}"" /V {1} /T ""REG_MULTI_SZ"" /D ""{2}"" /F", RegKey, RegVal, TempData)
                            Batch_Commands &= Environment.NewLine

                        Case Else ' REG SZ

                            RegVal = Split(RegLine, """=""", , CompareMethod.Text)(0)
                            RegData = Split(RegLine, (RegVal & """="""), , CompareMethod.Text).Last
                            Batch_Commands &= String.Format("REG ADD ""{0}"" /V {1}"" /T ""REG_SZ"" /D ""{2} /F", RegKey, RegVal, RegData)
                            Batch_Commands &= Environment.NewLine

                    End Select

            End Select

        Next

        Return Batch_Commands

    End Function
     
    #End Region


[Eleкtro]

· Expandir todas las variables de un string

PD: Útil para permitir al usuario manejar variables de entorno en la aplicación por ejemplo para setear una ruta, o cargar una ruta que contenga variables de entorno desde un archivo INI.

Código (vbnet) [Seleccionar] Expandir

#Region " Expand Variables In String "

   ' [ Expand Variables In String Function ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   ' MsgBox(Expand_Variables_In_String("%homedrive%\Users\%username%\%fake-var%\")) ' Result: C:\Users\Administrador\%fake-var%\

   Public Function Expand_Variables_In_String(ByVal str As String) As String

       Dim match As System.Text.RegularExpressions.Match = _
       System.Text.RegularExpressions.Regex.Match(str, "(%.*%)")

       Do While match.Success
           str = str.Replace(match.ToString, Environment.ExpandEnvironmentVariables(match.ToString))
           match = match.NextMatch()
       Loop

       Return str

   End Function

#End Region

[Eleкtro]

Una class de ayuda para manejar lo básico de la librería FreeImage

Convertir entre formatos, convertir a escala de grises, rotar, redimensionar, generar un thumbnail...

http://freeimage.sourceforge.net/download.html

Código (vbnet) [Seleccionar] Expandir

#Region " FreeImage Helper "


' [ FreeImage Helper ]
'
' // By Elektro H@cker
'
'
' INSTRUCTIONS:
' 1. ADD A REFERENCE FOR "FreeImageNET.dll" IN THE PROJECT.
' 2. ADD THE "FREEIMAGE.DLL" IN THE PROJECT.
'
'
' Examples :
'
' MsgBox(FreeImageHelper.Is_Avaliable() ' Result: True
' MsgBox(FreeImageHelper.Get_Version()  ' Result: 3.15.1
' MsgBox(FreeImageHelper.Get_ImageFormat("C:\Test.png")) ' Result: PNG
'
' FreeImageHelper.Convert("C:\Test.png", "C:\Test.ico", FreeImageAPI.FREE_IMAGE_FORMAT.FIF_ICO)
' FreeImageHelper.Convert(New Bitmap("C:\Test.png"), "C:\Test.jpg", FreeImageAPI.FREE_IMAGE_FORMAT.FIF_JPEG, FreeImageAPI.FREE_IMAGE_SAVE_FLAGS.JPEG_SUBSAMPLING_444 Or FreeImageAPI.FREE_IMAGE_SAVE_FLAGS.JPEG_QUALITYSUPERB)
'
' PictureBox1.BackgroundImage = FreeImageHelper.GrayScale(New Bitmap("C:\Test.bmp"))
' PictureBox1.BackgroundImage = FreeImageHelper.GrayScale("C:\Test.bmp")
'
' PictureBox1.BackgroundImage = FreeImageHelper.Resize(New Bitmap("C:\Test.bmp"), 32, 32)
' PictureBox1.BackgroundImage = FreeImageHelper.Resize("C:\Test.bmp", 64, 128)
'
' PictureBox1.BackgroundImage = FreeImageHelper.Rotate(New Bitmap("C:\Test.bmp"), 90)
' PictureBox1.BackgroundImage = FreeImageHelper.Rotate("C:\Test.bmp", -90)
'
' PictureBox1.BackgroundImage = FreeImageHelper.Thumbnail(New Bitmap("C:\Test.png"), 64, True)
' PictureBox1.BackgroundImage = FreeImageHelper.Thumbnail("C:\Test.png", 64, True)



Imports FreeImageAPI

Public Class FreeImageHelper

   ' <summary>
   ' Checks if <i>FreeImage.dll</i> is avaliable on the system.
   ' </summary>
   Public Shared Function Is_Avaliable() As Boolean
       Return FreeImage.IsAvailable
   End Function

   ' <summary>
   ' Gets the version of FreeImage.dll.
   ' </summary>
   Shared Function Get_Version() As String
       Return FreeImage.GetVersion
   End Function

   ' <summary>
   ' Gets the image format of a image file.
   ' </summary>
   Shared Function Get_ImageFormat(ByVal File As String) As String
       Return FreeImage.GetFileType(File, 0).ToString.Substring(4)
   End Function

   ' <summary>
   ' Convert a Bitmap object between image formats and save it to disk.
   ' </summary>
   Shared Sub Convert(ByVal bmp As System.Drawing.Bitmap, _
                      ByVal Output As String, _
                      ByVal NewFormat As FREE_IMAGE_FORMAT, _
                      Optional ByVal SaveFlags As FREE_IMAGE_SAVE_FLAGS = FREE_IMAGE_SAVE_FLAGS.DEFAULT)

       Try
           FreeImage.SaveBitmap(bmp, Output, NewFormat, SaveFlags)
       Catch ex As Exception
           ' Throw New Exception(ex.Message)
           MsgBox(ex.Message)
       End Try

   End Sub

   ' <summary>
   ' Convert a image file between image formats and save it to disk.
   ' </summary>
   Shared Sub Convert(ByVal File As String, _
                      ByVal Output As String, _
                      ByVal NewFormat As FREE_IMAGE_FORMAT, _
                      Optional ByVal SaveFlags As FREE_IMAGE_SAVE_FLAGS = FREE_IMAGE_SAVE_FLAGS.DEFAULT)

       Try
           FreeImage.Save(NewFormat, FreeImage.LoadEx(File), Output, SaveFlags)
       Catch ex As Exception
           ' Throw New Exception(ex.Message)
           MsgBox(ex.Message)
       End Try

   End Sub

   ' <summary>
   ' GrayScales a Bitmap object.
   ' </summary>
   Shared Function GrayScale(ByVal bmp As System.Drawing.Bitmap) As System.Drawing.Bitmap

       Try

           Dim ImageStream As New System.IO.MemoryStream
           bmp.Save(ImageStream, bmp.RawFormat)

           Dim Image As FIBITMAP = FreeImage.LoadFromStream(ImageStream)
           ImageStream.Dispose()

           Return FreeImage.GetBitmap(FreeImage.ConvertToGreyscale(Image))

       Catch ex As Exception
           ' Throw New Exception(ex.Message)
           MsgBox(ex.Message)
           Return Nothing
       End Try

   End Function

   ' <summary>
   ' GrayScales a image file.
   ' </summary>
   Shared Function GrayScale(ByVal File As String) As System.Drawing.Bitmap

       Try
           Return FreeImage.GetBitmap(FreeImage.ConvertToGreyscale(FreeImage.LoadEx(File)))
       Catch ex As Exception
           ' Throw New Exception(ex.Message)
           MsgBox(ex.Message)
           Return Nothing
       End Try

   End Function

   ' <summary>
   ' Resizes a Bitmap object.
   ' </summary>
   Shared Function Resize(ByVal bmp As System.Drawing.Bitmap, _
                          ByVal X As Int32, _
                          ByVal Y As Int32, _
                          Optional ByVal Quality As FREE_IMAGE_FILTER = FREE_IMAGE_FILTER.FILTER_BILINEAR) As System.Drawing.Bitmap

       Try

           Dim ImageStream As New System.IO.MemoryStream
           bmp.Save(ImageStream, bmp.RawFormat)

           Dim Image As FIBITMAP = FreeImage.LoadFromStream(ImageStream)
           ImageStream.Dispose()

           Return FreeImage.GetBitmap(FreeImage.Rescale(Image, X, Y, Quality))

       Catch ex As Exception
           ' Throw New Exception(ex.Message)
           MsgBox(ex.Message)
           Return Nothing
       End Try

   End Function

   ' <summary>
   ' Resizes a image file.
   ' </summary>
   Shared Function Resize(ByVal File As String, _
                          ByVal X As Int32, _
                          ByVal Y As Int32, _
                          Optional ByVal Quality As FREE_IMAGE_FILTER = FREE_IMAGE_FILTER.FILTER_BILINEAR) As System.Drawing.Bitmap

       Try

           Return FreeImage.GetBitmap(FreeImage.Rescale(FreeImage.LoadEx(File), X, Y, Quality))

       Catch ex As Exception
           ' Throw New Exception(ex.Message)
           MsgBox(ex.Message)
           Return Nothing
       End Try

   End Function

   ' <summary>
   ' Rotates a Bitmap object.
   ' </summary>
   Shared Function Rotate(ByVal bmp As System.Drawing.Bitmap, _
                          ByVal Angle As Double) As System.Drawing.Bitmap

       Try

           Dim ImageStream As New System.IO.MemoryStream
           bmp.Save(ImageStream, bmp.RawFormat)

           Dim Image As FIBITMAP = FreeImage.LoadFromStream(ImageStream)
           ImageStream.Dispose()

           Return FreeImage.GetBitmap(FreeImage.Rotate(Image, Angle))

       Catch ex As Exception
           ' Throw New Exception(ex.Message)
           MsgBox(ex.Message)
           Return Nothing
       End Try

   End Function

   ' <summary>
   ' Rotates a image file.
   ' </summary>
   Shared Function Rotate(ByVal File As String, _
                          ByVal Angle As Double) As System.Drawing.Bitmap

       Try

           Return FreeImage.GetBitmap(FreeImage.Rotate(FreeImage.LoadEx(File), Angle))

       Catch ex As Exception
           ' Throw New Exception(ex.Message)
           MsgBox(ex.Message)
           Return Nothing
       End Try

   End Function

   ' <summary>
   ' Returns a Thumbnail of a Bitmap object.
   ' </summary>
   Shared Function Thumbnail(ByVal bmp As System.Drawing.Bitmap, _
                                  ByVal size As Int32, _
                                  ByVal convert As Boolean) As System.Drawing.Bitmap

       Try

           Dim ImageStream As New System.IO.MemoryStream
           bmp.Save(ImageStream, bmp.RawFormat)

           Dim Image As FIBITMAP = FreeImage.LoadFromStream(ImageStream)
           ImageStream.Dispose()

           Return FreeImage.GetBitmap(FreeImage.MakeThumbnail(Image, size, convert))

       Catch ex As Exception
           ' Throw New Exception(ex.Message)
           MsgBox(ex.Message)
           Return Nothing
       End Try

   End Function

   ' <summary>
   ' Returns a Thumbnail of a image file.
   ' </summary>
   Shared Function Thumbnail(ByVal File As String, _
                                  ByVal size As Int32, _
                                  ByVal convert As Boolean) As System.Drawing.Bitmap

       Try
           Return FreeImage.GetBitmap(FreeImage.MakeThumbnail(FreeImage.LoadEx(File), size, convert))
       Catch ex As Exception
           ' Throw New Exception(ex.Message)
           MsgBox(ex.Message)
           Return Nothing
       End Try

   End Function

End Class

#End Region





Informa a Windows de cambios en el sistema para refrescar el sistema.

Código (vbnet) [Seleccionar] Expandir

#Region " System Notifier "

' [ System Notifier ]
'
' Examples :
'
' SystemNotifier.Notify(SystemNotifier.EventID.FileAssociation_Changed, SystemNotifier.NotifyFlags.DWORD, IntPtr.Zero, IntPtr.Zero)

Public Class SystemNotifier

   <System.Runtime.InteropServices.DllImport("shell32.dll")> _
   Shared Sub SHChangeNotify( _
       ByVal wEventID As EventID, _
       ByVal uFlags As NotifyFlags, _
       ByVal dwItem1 As IntPtr, _
       ByVal dwItem2 As IntPtr)
   End Sub

   Shared Sub Notify(ByVal wEventID As EventID, ByVal uFlags As NotifyFlags, ByVal dwItem1 As IntPtr, ByVal dwItem2 As IntPtr)
       SHChangeNotify(wEventID, uFlags, dwItem1, dwItem2)
   End Sub

   <Flags()> _
   Public Enum NotifyFlags

       ' <summary>
       ' The <i>dwItem1</i> and <i>dwItem2</i> parameters are DWORD values.
       ' </summary>
       DWORD = &H3

       ' <summary>
       ' <i>dwItem1</i> and <i>dwItem2</i> are the addresses of ItemIDList structures,
       ' that represent the item(s) affected by the change.
       ' Each ItemIDList must be relative to the desktop folder.
       ' </summary>
       ItemIDList = &H0

       ' <summary>
       ' <i>dwItem1</i> and <i>dwItem2</i> are the addresses of null-terminated strings,
       ' of maximum length MAX_PATH that contain the full path names of the items affected by the change.
       ' </summary>
       PathA = &H1

       ' <summary>
       ' <i>dwItem1</i> and <i>dwItem2</i> are the addresses of null-terminated strings,
       ' of maximum length MAX_PATH that contain the full path names of the items affected by the change.
       ' </summary>
       PathW = &H5

       ' <summary>
       ' <i>dwItem1</i> and <i>dwItem2</i> are the addresses of null-terminated strings,
       ' that represent the friendly names of the printer(s) affected by the change.
       ' </summary>
       PrinterA = &H2

       ' <summary>
       ' <i>dwItem1</i> and <i>dwItem2</i> are the addresses of null-terminated strings,
       ' that represent the friendly names of the printer(s) affected by the change.
       ' </summary>
       PrinterW = &H6

       ' <summary>
       ' The function should not return until the notification has been delivered to all affected components.
       ' As this flag modifies other data-type flags it cannot by used by itself.
       ' </summary>
       Flush = &H1000

       ' <summary>
       ' The function should begin delivering notifications to all affected components,
       ' but should return as soon as the notification process has begun.
       ' As this flag modifies other data-type flags it cannot by used by itself.
       ' </summary>
       FlushNoWait = &H2000

   End Enum

   <Flags()> _
   Public Enum EventID

       ' <summary>
       ' All events have occurred.
       ' </summary>
       All_Events = &H7FFFFFFF

       ' <summary>
       ' A folder has been created.
       ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
       ' <i>dwItem1</i> contains the folder that was created.
       ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
       ' </summary>
       Directory_Created = &H8

       ' <summary>
       ' A folder has been removed.
       ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
       ' <i>dwItem1</i> contains the folder that was removed.
       ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
       ' </summary>
       Directory_Deleted = &H10

       ' <summary>
       ' The name of a folder has changed.
       ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
       ' <i>dwItem1</i> contains the previous pointer to an item identifier list (PIDL) or name of the folder.
       ' <i>dwItem2</i> contains the new PIDL or name of the folder.
       ' </summary>
       Directory_Renamed = &H20000

       ' <summary>
       ' A nonfolder item has been created.
       ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
       ' <i>dwItem1</i> contains the item that was created.
       ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
       ' </summary>
       Item_Created = &H2

       ' <summary>
       ' A nonfolder item has been deleted.
       ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
       ' <i>dwItem1</i> contains the item that was deleted.
       ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
       ' </summary>
       Item_Deleted = &H4

       ' <summary>
       ' The name of a nonfolder item has changed.
       ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
       ' <i>dwItem1</i> contains the previous PIDL or name of the item.
       ' <i>dwItem2</i> contains the new PIDL or name of the item.
       ' </summary>
       Item_Renamed = &H1

       ' <summary>
       ' A drive has been added.
       ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
       ' <i>dwItem1</i> contains the root of the drive that was added.
       ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
       ' </summary>
       Drive_Added = &H100

       ' <summary>
       ' A drive has been added and the Shell should create a new window for the drive.
       ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
       ' <i>dwItem1</i> contains the root of the drive that was added.
       ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
       ' </summary>
       Drive_Added_Shell = &H10000

       ' <summary>
       ' A drive has been removed. <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
       ' <i>dwItem1</i> contains the root of the drive that was removed.
       ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
       ' </summary>
       Drive_Removed = &H80

       ' <summary>
       ' Storage media has been inserted into a drive.
       ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
       ' <i>dwItem1</i> contains the root of the drive that contains the new media.
       ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
       ' </summary>
       Media_Inserted = &H20

       ' <summary>
       ' Storage media has been removed from a drive.
       ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
       ' <i>dwItem1</i> contains the root of the drive from which the media was removed.
       ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
       ' </summary>
       Media_Removed = &H40

       ' <summary>
       ' A folder on the local computer is being shared via the network.
       ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
       ' <i>dwItem1</i> contains the folder that is being shared.
       ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
       ' </summary>
       Net_Shared = &H200

       ' <summary>
       ' A folder on the local computer is no longer being shared via the network.
       ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
       ' <i>dwItem1</i> contains the folder that is no longer being shared.
       ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
       ' </summary>
       Net_Unshared = &H400

       ' <summary>
       ' The computer has disconnected from a server.
       ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
       ' <i>dwItem1</i> contains the server from which the computer was disconnected.
       ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
       ' </summary>
       Server_Disconnected = &H4000

       ' <summary>
       ' The attributes of an item or folder have changed.
       ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
       ' <i>dwItem1</i> contains the item or folder that has changed.
       ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
       ' </summary>
       Attributes_Changed = &H800

       ' <summary>
       ' A file type association has changed. <see cref="NotifyFlags.ItemIDList"/>
       ' must be specified in the <i>uFlags</i> parameter.
       ' <i>dwItem1</i> and <i>dwItem2</i> are not used and must be <see langword="null"/>.
       ' </summary>
       FileAssociation_Changed = &H8000000

       ' <summary>
       ' The amount of free space on a drive has changed.
       ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
       ' <i>dwItem1</i> contains the root of the drive on which the free space changed.
       ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
       ' </summary>
       Freespace_Changed = &H40000

       ' <summary>
       ' The contents of an existing folder have changed but the folder still exists and has not been renamed.
       ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
       ' <i>dwItem1</i> contains the folder that has changed.
       ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
       ' If a folder has been created, deleted or renamed use Directory_Created, Directory_Removed or Directory_Renamed respectively instead.
       ' </summary>
       Update_Directory = &H1000

       ' <summary>
       ' An image in the system image list has changed.
       ' <see cref="NotifyFlags.DWORD"/> must be specified in <i>uFlags</i>.
       ' </summary>
       Update_Image = &H8000

   End Enum

End Class

#End Region

[Eleкtro]

No apruebo el uso de aplicaciones commandline a menos que sea para situaciones complicadas y tediosas como esta...

...Una class para usar SETACL para modificar el propietario de una clave de registro y para modificar los permisos de la clave:

PD: a ver si alguien nos sorprende con un código nativo... 

Código (vbnet) [Seleccionar] Expandir

#Region " SETACL Helper "


' [ SETACL Helper ]
'
' // By Elektro H@cker
'
'
' INSTRUCTIONS:
' 1. Add the "SETACL.exe" in the project.
'
' Examples :
'
' SETACL.Set_Owner("HKCU\Test", True)
' SETACL.Set_Permission("HKCU\Test\", SETACL.SETACL_Permission.full, False)


Public Class SETACL

   ' <summary>
   ' Gets or sets the SETACL executable path.
   ' </summary>
   Public Shared SETACL_Location As String = ".\SetACL.exe"

   ' <summary>
   ' Gets or sets the SETACL logfile filename.
   ' </summary>
   Public Shared SETACL_Logfile As String = ".\SetACL.log"


   Public Enum SETACL_Permission

       ' <summary>
       ' Create link
       ' </summary>
       create_link

       ' <summary>
       ' Create subkeys
       ' </summary>
       create_subkey

       ' <summary>
       ' Delete
       ' </summary>
       delete

       ' <summary>
       ' Enumerate subkeys
       ' </summary>
       enum_subkeys

       ' <summary>
       ' Notify
       ' </summary>
       notify

       ' <summary>
       ' Query value
       ' </summary>
       query_val

       ' <summary>
       ' Read control
       ' </summary>
       read_access

       ' <summary>
       ' Set value
       ' </summary>
       set_val

       ' <summary>
       ' Write permissions
       ' </summary>
       write_dacl

       ' <summary>
       ' Take ownership
       ' </summary>
       write_owner


       ' <summary>
       ' Read (KEY_ENUMERATE_SUB_KEYS + KEY_EXECUTE + KEY_NOTIFY + KEY_QUERY_VALUE + KEY_READ + READ_CONTROL)
       ' </summary>
       read

       ' <summary>
       ' Full access
       ' (KEY_CREATE_LINK + KEY_CREATE_SUB_KEY +KEY_ENUMERATE_SUB_KEYS + ...
       ' ...KEY_EXECUTE + KEY_NOTIFY + KEY_QUERY_VALUE + KEY_READ + KEY_SET_VALUE + ...
       ' ...KEY_WRITE + READ_CONTROL + WRITE_OWNER + WRITE_DAC + DELETE)
       ' </summary>
       full

   End Enum

   ' <summary>
   ' Checks if SETACL process is avaliable.
   ' </summary>
   Public Shared Function Is_Avaliable() As Boolean
       Return IO.File.Exists(SETACL_Location)
   End Function

   ' <summary>
   ' Takes ownership of a registry key.
   ' </summary>
   Public Shared Sub Set_Owner(ByVal RegKey As String, ByVal Recursive As Boolean, Optional ByVal UserName As String = "%USERNAME%")

       If RegKey.EndsWith("\") Then RegKey = RegKey.Substring(0, RegKey.Length - 1)

       Dim Recursion As String = "No" : If Recursive Then Recursion = "Yes"

       Dim SETACL As New Process(), SETACL_Info As New ProcessStartInfo()

       SETACL_Info.FileName = SETACL_Location
       SETACL_Info.Arguments = String.Format("-on ""{0}"" -ot reg -ownr ""n:{1}"" -rec ""{2}"" -actn setowner -silent -ignoreerr -log ""{3}""", RegKey, UserName, Recursion, SETACL_Logfile)
       SETACL_Info.CreateNoWindow = True
       SETACL_Info.UseShellExecute = False
       SETACL.StartInfo = SETACL_Info
       SETACL.Start()
       SETACL.WaitForExit()

       If SETACL.ExitCode <> 0 Then
           ' Throw New Exception("Exit code: " & SETACL.ExitCode)
           MsgBox(IO.File.ReadAllText(SETACL_Logfile))
       End If

   End Sub

   ' <summary>
   ' Sets the user permission of a registry key.
   ' </summary>
   Public Shared Sub Set_Permission(ByVal RegKey As String, ByVal Permission As SETACL_Permission, ByVal Recursive As Boolean, Optional ByVal UserName As String = "%USERNAME%")

       If RegKey.EndsWith("\") Then RegKey = RegKey.Substring(0, RegKey.Length - 1)

       Dim Recursion As String = "No" : If Recursive Then Recursion = "Yes"

       Dim SETACL As New Process(), SETACL_Info As New ProcessStartInfo()

       SETACL_Info.FileName = SETACL_Location
       SETACL_Info.Arguments = String.Format("-on ""{0}"" -ot reg -ace ""n:{1};p:{2}"" -rec ""{3}"" -actn ace -silent -ignoreerr -log ""{4}""", RegKey, UserName, Permission, Recursion, SETACL_Logfile)
       SETACL_Info.CreateNoWindow = True
       SETACL_Info.UseShellExecute = False
       SETACL.StartInfo = SETACL_Info
       SETACL.Start()
       SETACL.WaitForExit()

       If SETACL.ExitCode <> 0 Then
           ' Throw New Exception("Exit code: " & SETACL.ExitCode)
           MsgBox(IO.File.ReadAllText(SETACL_Logfile))
       End If

   End Sub

End Class

#End Region

[Novlucker]

http://msdn.microsoft.com/en-us/library/microsoft.win32.registrykey.setaccesscontrol.aspx