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

Iniciado por Eleкtro, 18 Diciembre 2012, 22:23 PM

0 Miembros y 2 Visitantes están viendo este tema.

OscarCadenas_91

que guay todo lo que aportas vale oro.

Gracias por compartir tus codigos ;-) ;-)

Eleкtro

#451
Tras analizar diversos enfoques de iteradores y paralelismo para optimizar la manera de buscar archivos/carpetas, y aunque al final he preferido no programar las funciones de manera asíncrona, les presento el método definitivo (bueno, o casi xD) para buscar archivos/directorios de manera sencilla, personalizada, omitiendo y/o controlando errores de permisos de usuario (eso si, de forma básica, quien quiera puede añadirle eventos para un mayor control), y realizando una búsqueda muy, muy rápida al dividir el trabajo en varios threads, de esta manera disminuirán el tiempo de ejecución hasta un 400% en las búsquedas de archivos por ejemplo sería muy útil en aplicaciones de tipo USB-Stealer, donde es primordial la rápidez del algoritmo sin dejar de lado la eficiencia del mismo.

Modo de empleo:

Código (vbnet) [Seleccionar]
Dim filePaths As List(Of String) = FileDirSearcher.GetFilePaths("C:\Windows\System32", SearchOption.AllDirectories).ToList
Dim dirPaths As List(Of String) = FileDirSearcher.GetDirPaths("C:\Windows\System32", SearchOption.AllDirectories).ToList


o:
Código (vbnet) [Seleccionar]
Dim files As List(Of FileInfo) = FileDirSearcher.GetFiles("C:\Windows\System32", SearchOption.AllDirectories).ToList
Dim dirs As List(Of DirectoryInfo) = FileDirSearcher.GetDirs("C:\Windows\System32", SearchOption.AllDirectories).ToList


o:
Código (vbnet) [Seleccionar]
Dim files As IEnumerable(Of FileInfo) = FileDirSearcher.GetFiles(dirPath:="C:\Windows\System32",
                                                                searchOption:=SearchOption.TopDirectoryOnly,
                                                                fileNamePatterns:={"*"},
                                                                fileExtPatterns:={"*.dll", "*.exe"},
                                                                ignoreCase:=True,
                                                                throwOnError:=True)

Dim dirs As IEnumerable(Of DirectoryInfo) = FileDirSearcher.GetDirs(dirPath:="C:\Windows\System32",
                                                                   searchOption:=SearchOption.TopDirectoryOnly,
                                                                   dirPathPatterns:={"*"},
                                                                   dirNamePatterns:={"*Microsoft*"},
                                                                   ignoreCase:=True,
                                                                   throwOnError:=True)


Source: http://pastebin.com/yrcvG7LP

EDITO: Versión anterior del código fuente de este Snippet (no tiene ninguna mejora implementada), por si quieren comparar los tiempos de espera de búsqueda: http://pastebin.com/Wg5SHdmS








Eleкtro

#452
Esto es una versión "reducida" de la class para buscar archivos/directorios. El funcionamiento es el mismo pero internamente trabaja de manera ligeramente distinta, simplemente lo he estructurado de otra forma más óptima para eliminar toda la repetición de código posible y así hacer el entendimiento del código más ameno, los resultados son los mismos.

Nota: Si alquien quiere comparar este código con algún otro algoritmo (que de seguro los hay mejores) para hacer algún tipo de profilling de I/O o del rendimiento de memoria entonces no se vayan a asustar por el consumo de memoria al recojer +100k de archivos, es el GarbageCollector de .Net haciendo de las suyas... lo pueden invokar manualmente (GC.Collect) y desaparecerá todo ese consumo ficticio de RAM.

Espero que a alguien le sirva el code :):

Código (vbnet) [Seleccionar]
' ***********************************************************************
' Author   : Elektro
' Modified : 14-February-2015
' ***********************************************************************

#Region " Usage Examples "

' he eliminado esto por el límite de caracteres del foro

#End Region

#Region " Option Statements "

Option Explicit On
Option Strict On
Option Infer Off

#End Region

#Region " Imports "

Imports System.IO
Imports System.Collections.Concurrent
Imports System.Threading.Tasks

#End Region

#Region " File Dir Searcher "

''' <summary>
''' Searchs for files and directories.
''' </summary>
Public NotInheritable Class FileDirSearcher

#Region " Public Methods "

    ''' <summary>
    ''' Gets the files those matches the criteria inside the specified directory and/or sub-directories.
    ''' </summary>
    ''' <param name="dirPath">The root directory path to search for files.</param>
    ''' <param name="searchOption">The searching mode.</param>
    ''' <param name="fileNamePatterns">The file name pattern(s) to match.</param>
    ''' <param name="fileExtPatterns">The file extension pattern(s) to match.</param>
    ''' <param name="ignoreCase">If <c>True</c>, ignores the comparing case of <paramref name="fileNamePatterns"/> and <paramref name="fileExtPatterns"/> patterns.</param>
    ''' <param name="throwOnError">If set to <c>true</c>, exceptions will be thrown, like access denied to file or directory.</param>
    ''' <returns>An <see cref="IEnumerable(Of FileInfo)"/> instance containing the files information.</returns>
    ''' <exception cref="System.ArgumentException">dirPath or searchOption</exception>
    Public Shared Function GetFiles(ByVal dirPath As String,
                                    ByVal searchOption As SearchOption,
                                    Optional ByVal fileNamePatterns As IEnumerable(Of String) = Nothing,
                                    Optional ByVal fileExtPatterns As IEnumerable(Of String) = Nothing,
                                    Optional ByVal ignoreCase As Boolean = True,
                                    Optional ByVal throwOnError As Boolean = False) As IEnumerable(Of FileInfo)

        ' Analyze and resolve path problems. (eg. 'C:' -> 'C:\')
        AnalyzePath(dirPath)

        ' Analyze the passed arguments.
        AnalyzeArgs(dirPath, searchOption)

        ' Get and return the files.
        Dim queue As New ConcurrentQueue(Of FileInfo)
        CollectFiles(queue, dirPath, searchOption, fileNamePatterns, fileExtPatterns, ignoreCase, throwOnError)
        Return queue.AsEnumerable

    End Function

    ''' <summary>
    ''' Gets the filepaths those matches the criteria inside the specified directory and/or sub-directories.
    ''' </summary>
    ''' <param name="dirPath">The root directory path to search for files.</param>
    ''' <param name="searchOption">The searching mode.</param>
    ''' <param name="fileNamePatterns">The file name pattern(s) to match.</param>
    ''' <param name="fileExtPatterns">The file extension pattern(s) to match.</param>
    ''' <param name="ignoreCase">If <c>True</c>, ignores the comparing case of <paramref name="fileNamePatterns"/> and <paramref name="fileExtPatterns"/> patterns.</param>
    ''' <param name="throwOnError">If set to <c>true</c>, exceptions will be thrown, like access denied to file or directory.</param>
    ''' <returns>An <see cref="IEnumerable(Of String)"/> instance containing the filepaths.</returns>
    ''' <exception cref="System.ArgumentException">dirPath or searchOption</exception>
    Public Shared Function GetFilePaths(ByVal dirPath As String,
                                        ByVal searchOption As SearchOption,
                                        Optional ByVal fileNamePatterns As IEnumerable(Of String) = Nothing,
                                        Optional ByVal fileExtPatterns As IEnumerable(Of String) = Nothing,
                                        Optional ByVal ignoreCase As Boolean = True,
                                        Optional ByVal throwOnError As Boolean = False) As IEnumerable(Of String)

        ' Analyze and resolve path problems. (eg. 'C:' -> 'C:\')
        AnalyzePath(dirPath)

        ' Analyze the passed arguments.
        AnalyzeArgs(dirPath, searchOption)

        ' Get and return the filepaths.
        Dim queue As New ConcurrentQueue(Of String)
        CollectFilePaths(queue, dirPath, searchOption, fileNamePatterns, fileExtPatterns, ignoreCase, throwOnError)
        Return queue.AsEnumerable

    End Function

    ''' <summary>
    ''' Gets the directories those matches the criteria inside the specified directory and/or sub-directories.
    ''' </summary>
    ''' <param name="dirPath">The root directory path to search for directories.</param>
    ''' <param name="searchOption">The searching mode.</param>
    ''' <param name="dirPathPatterns">The directory path pattern(s) to match.</param>
    ''' <param name="dirNamePatterns">The directory name pattern(s) to match.</param>
    ''' <param name="ignoreCase">If <c>True</c>, ignores the comparing case of <paramref name="dirPathPatterns"/> and <paramref name="dirNamePatterns"/> patterns.</param>
    ''' <param name="throwOnError">If set to <c>true</c>, exceptions will be thrown, like access denied to directory.</param>
    ''' <returns>An <see cref="IEnumerable(Of DirectoryInfo)"/> instance containing the dirrectories information.</returns>
    ''' <exception cref="System.ArgumentException">dirPath or searchOption</exception>
    Public Shared Function GetDirs(ByVal dirPath As String,
                                   ByVal searchOption As SearchOption,
                                   Optional ByVal dirPathPatterns As IEnumerable(Of String) = Nothing,
                                   Optional ByVal dirNamePatterns As IEnumerable(Of String) = Nothing,
                                   Optional ByVal ignoreCase As Boolean = True,
                                   Optional ByVal throwOnError As Boolean = False) As IEnumerable(Of DirectoryInfo)

        ' Analyze and resolve path problems. (eg. 'C:' -> 'C:\')
        AnalyzePath(dirPath)

        ' Analyze the passed arguments.
        AnalyzeArgs(dirPath, searchOption)

        ' Get and return the directories.
        Dim queue As New ConcurrentQueue(Of DirectoryInfo)
        CollectDirs(queue, dirPath, searchOption, dirPathPatterns, dirNamePatterns, ignoreCase, throwOnError)
        Return queue.AsEnumerable

    End Function

    ''' <summary>
    ''' Gets the filepaths those matches the criteria inside the specified directory and/or sub-directories.
    ''' </summary>
    ''' <param name="dirPath">The root directory path to search for directories.</param>
    ''' <param name="searchOption">The searching mode.</param>
    ''' <param name="dirPathPatterns">The directory path pattern(s) to match.</param>
    ''' <param name="dirNamePatterns">The directory name pattern(s) to match.</param>
    ''' <param name="ignoreCase">If <c>True</c>, ignores the comparing case of <paramref name="dirPathPatterns"/> and <paramref name="dirNamePatterns"/> patterns.</param>
    ''' <param name="throwOnError">If set to <c>true</c>, exceptions will be thrown, like access denied to directory.</param>
    ''' <returns>An <see cref="IEnumerable(Of String)"/> instance containing the directory paths.</returns>
    ''' <exception cref="System.ArgumentException">dirPath or searchOption</exception>
    Public Shared Function GetDirPaths(ByVal dirPath As String,
                                       ByVal searchOption As SearchOption,
                                       Optional ByVal dirPathPatterns As IEnumerable(Of String) = Nothing,
                                       Optional ByVal dirNamePatterns As IEnumerable(Of String) = Nothing,
                                       Optional ByVal ignoreCase As Boolean = True,
                                       Optional ByVal throwOnError As Boolean = False) As IEnumerable(Of String)

        ' Analyze and resolve path problems. (eg. 'C:' -> 'C:\')
        AnalyzePath(dirPath)

        ' Analyze the passed arguments.
        AnalyzeArgs(dirPath, searchOption)

        ' Get and return the directory paths.
        Dim queue As New ConcurrentQueue(Of String)
        CollectDirPaths(queue, dirPath, searchOption, dirPathPatterns, dirNamePatterns, ignoreCase, throwOnError)
        Return queue.AsEnumerable

    End Function

#End Region

#Region " Private Methods "

    ''' <summary>
    ''' Analyzes a directory path and perform specific changes on it.
    ''' </summary>
    ''' <param name="dirPath">The directory path.</param>
    ''' <exception cref="System.ArgumentNullException">dirPath;Value is null, empty, or white-spaced.</exception>
    Private Shared Sub AnalyzePath(ByRef dirPath As String)

        If String.IsNullOrEmpty(dirPath) OrElse String.IsNullOrWhiteSpace(dirPath) Then
            Throw New ArgumentNullException("dirPath", "Value is null, empty, or white-spaced.")

        Else
            ' Trim unwanted characters.
            dirPath = dirPath.TrimStart({" "c}).TrimEnd({" "c})

            If Path.IsPathRooted(dirPath) Then
                ' The root paths contained on the returned FileInfo objects will start with the same string-case as this root path.
                ' So just for a little visual improvement, I'll treat this root path as a Drive-Letter and I convert it to UpperCase.
                dirPath = Char.ToUpper(dirPath.First) & dirPath.Substring(1)
            End If

            If Not dirPath.EndsWith("\"c) Then
                ' Possibly its a drive letter without backslash ('C:') or else just a normal path without backslash ('C\Dir').
                ' In any case, fix the ending backslash.
                dirPath = dirPath.Insert(dirPath.Length, "\"c)
            End If

        End If

    End Sub

    ''' <summary>
    ''' Analyzes the specified directory values.
    ''' </summary>
    ''' <param name="dirPath">The root directory path to search for files.</param>
    ''' <param name="searchOption">The searching mode.</param>
    ''' <exception cref="System.ArgumentException">dirPath or searchOption</exception>
    Private Shared Sub AnalyzeArgs(ByVal dirPath As String, ByVal searchOption As SearchOption)

        If Not Directory.Exists(dirPath) Then
            Throw New ArgumentException(String.Format("Directory doesn't exists: '{0}'", dirPath), "dirPath")

        ElseIf (searchOption <> searchOption.TopDirectoryOnly) AndAlso (searchOption <> searchOption.AllDirectories) Then
            Throw New ArgumentException(String.Format("Value of '{0}' is not valid enumeration value.", CStr(searchOption)), "searchOption")

        End If

    End Sub

    ''' <summary>
    ''' Tries to instance the byreferred <see cref="DirectoryInfo"/> object using the given directory path.
    ''' </summary>
    ''' <param name="dirPath">The directory path used to instance the byreffered <see cref="DirectoryInfo"/> object.</param>
    ''' <param name="dirInfo">The byreffered <see cref="DirectoryInfo"/> object to instance it using the given directory path.</param>
    ''' <param name="throwOnError">If set to <c>true</c>, exceptions will be thrown, like access denied to directory.</param>
    Private Shared Sub SetupDirInfoObject(ByVal dirPath As String,
                                          ByRef dirInfo As DirectoryInfo,
                                          ByVal throwOnError As Boolean)

        Try
            dirInfo = New DirectoryInfo(dirPath)

        Catch ex As Exception

            Select Case ex.GetType ' Handle or suppress exceptions by its type,

                ' I've wrote different types just to feel free to expand this feature in the future.
                Case GetType(ArgumentNullException),
                     GetType(ArgumentException),
                     GetType(Security.SecurityException),
                     GetType(PathTooLongException),
                     ex.GetType

                    If throwOnError Then
                        Throw
                    End If

            End Select

        End Try

    End Sub

    ''' <summary>
    ''' Tries to instance the byreferred <paramref name="col"/> object using the given directory path.
    ''' </summary>
    ''' <typeparam name="A">The type of the <paramref name="col"/> object used to cast and fill the byreffered collection.</typeparam>
    ''' <param name="objectAction">The method to invoke, only for <see cref="FileInfo"/> or <see cref="DirectoryInfo"/> objects, this parameter can be <c>Nothing</c>.</param>
    ''' <param name="sharedAction">The method to invoke, only for filepaths or directorypaths, this parameter can be <c>Nothing</c>.</param>
    ''' <param name="dirPath">The directory path used to instance the byreffered <paramref name="col"/> object.</param>
    ''' <param name="searchPattern">The search pattern to list files or directories.</param>
    ''' <param name="col">The byreffered <see cref="IEnumerable(Of A)"/> object to instance it using the given directory path.</param>
    ''' <param name="throwOnError">If set to <c>true</c>, exceptions will be thrown, like access denied to file or directory.</param>
    Private Shared Sub SetupFileDirCollection(Of A)(ByVal objectAction As Func(Of String,
                                                                               SearchOption,
                                                                               IEnumerable(Of A)),
                                                    ByVal sharedAction As Func(Of String,
                                                                             String,
                                                                             SearchOption,
                                                                             IEnumerable(Of A)),
                                                    ByVal dirPath As String,
                                                    ByVal searchPattern As String,
                                                    ByRef col As IEnumerable(Of A),
                                                    ByVal throwOnError As Boolean)

        Try
            If objectAction IsNot Nothing Then
                col = objectAction.Invoke(searchPattern, SearchOption.TopDirectoryOnly)

            ElseIf sharedAction IsNot Nothing Then
                col = sharedAction.Invoke(dirPath, searchPattern, SearchOption.TopDirectoryOnly)

            Else
                Throw New ArgumentException("Any Action has been defined.")

            End If

        Catch ex As Exception

            Select Case ex.GetType ' Handle or suppress exceptions by its type,

                ' I've wrote different types just to feel free to expand this feature in the future.
                Case GetType(UnauthorizedAccessException),
                     GetType(DirectoryNotFoundException),
                     ex.GetType

                    If throwOnError Then
                        Throw
                    End If

            End Select

        End Try

    End Sub

    ''' <summary>
    ''' Determines whether at least one of the specified patterns matches the given value.
    ''' </summary>
    ''' <param name="value">The value, which can be a filename, file extension, direcrory path, or directory name.</param>
    ''' <param name="patterns">The patterns to match the given value.</param>
    ''' <param name="ignoreCase">if set to <c>true</c>, compares ignoring string-case rules.</param>
    ''' <returns><c>true</c> at least one of the specified patterns matches the given value; <c>false</c> otherwise.</returns>
    Private Shared Function IsMatchPattern(ByVal value As String,
                                           ByVal patterns As IEnumerable(Of String),
                                           ByVal ignoreCase As Boolean) As Boolean

        ' Iterate the filename pattern(s) to match each name pattern on the current name.
        For Each pattern As String In patterns

            ' Supress consecuent conditionals if pattern its an asterisk.
            If pattern.Equals("*", StringComparison.OrdinalIgnoreCase) Then
                Return True

            ElseIf ignoreCase Then ' Compare name ignoring string-case rules.
                If value.ToLower Like pattern.ToLower Then
                    Return True
                End If

            Else ' Compare filename unignoring string-case rules.
                If value Like pattern Then
                    Return True
                End If

            End If ' ignoreCase

        Next pattern

        Return False

    End Function

    ''' <summary>
    ''' Runs the next collector tasks synchronouslly.
    ''' </summary>
    ''' <typeparam name="T"></typeparam>
    ''' <param name="action">The collector method to invoke.</param>
    ''' <param name="queue">The <see cref="ConcurrentQueue(Of FileInfo)"/> instance.</param>
    ''' <param name="dirPath">The directory path.</param>
    ''' <param name="firstPatterns">The first comparison patterns.</param>
    ''' <param name="secondPatterns">The second comparison patterns.</param>
    ''' <param name="ignoreCase">if set to <c>true</c>, compares ignoring string-case rules.</param>
    ''' <param name="throwOnError">If set to <c>true</c>, exceptions will be thrown, like access denied to file or directory.</param>
    Private Shared Sub RunNextTasks(Of T)(ByVal action As Action(Of ConcurrentQueue(Of T),
                                                                 String,
                                                                 SearchOption,
                                                                 IEnumerable(Of String),
                                                                 IEnumerable(Of String),
                                                                 Boolean,
                                                                 Boolean),
                                          ByVal queue As ConcurrentQueue(Of T),
                                          ByVal dirPath As String,
                                          ByVal firstPatterns As IEnumerable(Of String),
                                          ByVal secondPatterns As IEnumerable(Of String),
                                          ByVal ignoreCase As Boolean,
                                          ByVal throwOnError As Boolean)

        Try
            Task.WaitAll(New DirectoryInfo(dirPath).
                             GetDirectories.
                             Select(Function(dir As DirectoryInfo)
                                        Return Task.Factory.StartNew(Sub()
                                                                         action.Invoke(queue,
                                                                                       dir.FullName, SearchOption.AllDirectories,
                                                                                       firstPatterns, secondPatterns,
                                                                                       ignoreCase, throwOnError)
                                                                     End Sub)
                                    End Function).ToArray)

        Catch ex As Exception

            Select Case ex.GetType ' Handle or suppress exceptions by its type,

                ' I've wrote different types just to feel free to expand this feature in the future.
                Case GetType(UnauthorizedAccessException),
                     GetType(DirectoryNotFoundException),
                     ex.GetType

                    If throwOnError Then
                        Throw
                    End If

            End Select

        End Try

    End Sub

    ''' <summary>
    ''' Collects the files those matches the criteria inside the specified directory and/or sub-directories.
    ''' </summary>
    ''' <param name="queue">The <see cref="ConcurrentQueue(Of FileInfo)"/> instance to enqueue new files.</param>
    ''' <param name="dirPath">The root directory path to search for files.</param>
    ''' <param name="searchOption">The searching mode.</param>
    ''' <param name="fileNamePatterns">The file name pattern(s) to match.</param>
    ''' <param name="fileExtPatterns">The file extension pattern(s) to match.</param>
    ''' <param name="ignoreCase">If <c>True</c>, ignores the comparing case of <paramref name="fileNamePatterns"/> and <paramref name="fileExtPatterns"/> patterns.</param>
    ''' <param name="throwOnError">If set to <c>true</c>, exceptions will be thrown, like access denied to file or directory.</param>
    Private Shared Sub CollectFiles(ByVal queue As ConcurrentQueue(Of FileInfo),
                                    ByVal dirPath As String,
                                    ByVal searchOption As SearchOption,
                                    ByVal fileNamePatterns As IEnumerable(Of String),
                                    ByVal fileExtPatterns As IEnumerable(Of String),
                                    ByVal ignoreCase As Boolean,
                                    ByVal throwOnError As Boolean)

        ' Initialize a FileInfo collection.
        Dim fileInfoCol As IEnumerable(Of FileInfo) = Nothing

        ' Initialize a DirectoryInfo.
        Dim dirInfo As DirectoryInfo = Nothing
        SetupDirInfoObject(dirPath, dirInfo, throwOnError)

        If fileExtPatterns IsNot Nothing Then
            ' Decrease time execution by searching for files that has extension.
            SetupFileDirCollection(Of FileInfo)(AddressOf dirInfo.GetFiles, Nothing,
                                                dirInfo.FullName, "*.*", fileInfoCol, throwOnError)
        Else
            ' Search for all files.
            SetupFileDirCollection(Of FileInfo)(AddressOf dirInfo.GetFiles, Nothing,
                                                dirInfo.FullName, "*", fileInfoCol, throwOnError)
        End If

        ' If the fileInfoCol collection is not empty then...
        If fileInfoCol IsNot Nothing Then

            ' Iterate the files.
            For Each fInfo As FileInfo In fileInfoCol

                ' Flag to determine whether a filename pattern is matched. Activated by default.
                Dim flagNamePattern As Boolean = True

                ' Flag to determine whether a file extension pattern is matched. Activated by default.
                Dim flagExtPattern As Boolean = True

                ' If filename patterns collection is not empty then...
                If fileNamePatterns IsNot Nothing Then
                    flagNamePattern = IsMatchPattern(fInfo.Name, fileNamePatterns, ignoreCase)
                End If

                ' If file extension patterns collection is not empty then...
                If fileExtPatterns IsNot Nothing Then
                    flagExtPattern = IsMatchPattern(fInfo.Extension, fileExtPatterns, ignoreCase)
                End If

                ' If fileName and also fileExtension patterns are matched then...
                If flagNamePattern AndAlso flagExtPattern Then
                    queue.Enqueue(fInfo) ' Enqueue this FileInfo object.
                End If

            Next fInfo

        End If ' fileInfoCol IsNot Nothing

        ' If searchOption is recursive then...
        If searchOption = searchOption.AllDirectories Then
            RunNextTasks(Of FileInfo)(AddressOf CollectFiles,
                                      queue, dirInfo.FullName, fileNamePatterns, fileExtPatterns, ignoreCase, throwOnError)
        End If

    End Sub

    ''' <summary>
    ''' Collects the filepaths those matches the criteria inside the specified directory and/or sub-directories.
    ''' </summary>
    ''' <param name="queue">The <see cref="ConcurrentQueue(Of String)"/> instance to enqueue new filepaths.</param>
    ''' <param name="dirPath">The root directory path to search for files.</param>
    ''' <param name="searchOption">The searching mode.</param>
    ''' <param name="fileNamePatterns">The file name pattern(s) to match.</param>
    ''' <param name="fileExtPatterns">The file extension pattern(s) to match.</param>
    ''' <param name="ignoreCase">If <c>True</c>, ignores the comparing case of <paramref name="fileNamePatterns"/> and <paramref name="fileExtPatterns"/> patterns.</param>
    ''' <param name="throwOnError">If set to <c>true</c>, exceptions will be thrown, like access denied to file or directory.</param>
    Private Shared Sub CollectFilePaths(ByVal queue As ConcurrentQueue(Of String),
                                        ByVal dirPath As String,
                                        ByVal searchOption As SearchOption,
                                        ByVal fileNamePatterns As IEnumerable(Of String),
                                        ByVal fileExtPatterns As IEnumerable(Of String),
                                        ByVal ignoreCase As Boolean,
                                        ByVal throwOnError As Boolean)

        ' Initialize a filepath collection.
        Dim filePathCol As IEnumerable(Of String) = Nothing

        If fileExtPatterns IsNot Nothing Then
            ' Decrease time execution by searching for files that has extension.
            SetupFileDirCollection(Of String)(Nothing, AddressOf Directory.GetFiles,
                                              dirPath, "*.*", filePathCol, throwOnError)
        Else
            ' Search for all files.
            SetupFileDirCollection(Of String)(Nothing, AddressOf Directory.GetFiles,
                                              dirPath, "*", filePathCol, throwOnError)
        End If

        ' If the filepath collection is not empty then...
        If filePathCol IsNot Nothing Then

            ' Iterate the filepaths.
            For Each filePath As String In filePathCol

                ' Flag to determine whether a filename pattern is matched. Activated by default.
                Dim flagNamePattern As Boolean = True

                ' Flag to determine whether a file extension pattern is matched. Activated by default.
                Dim flagExtPattern As Boolean = True

                ' If filename patterns collection is not empty then...
                If fileNamePatterns IsNot Nothing Then
                    flagNamePattern = IsMatchPattern(Path.GetFileNameWithoutExtension(filePath), fileNamePatterns, ignoreCase)
                End If

                ' If file extension patterns collection is not empty then...
                If fileExtPatterns IsNot Nothing Then
                    flagExtPattern = IsMatchPattern(Path.GetExtension(filePath), fileExtPatterns, ignoreCase)
                End If

                ' If fileName and also fileExtension patterns are matched then...
                If flagNamePattern AndAlso flagExtPattern Then
                    queue.Enqueue(filePath) ' Enqueue this filepath.
                End If

            Next filePath

        End If ' filePathCol IsNot Nothing

        ' If searchOption is recursive then...
        If searchOption = searchOption.AllDirectories Then
            RunNextTasks(Of String)(AddressOf CollectFilePaths,
                                    queue, dirPath, fileNamePatterns, fileExtPatterns, ignoreCase, throwOnError)
        End If

    End Sub

    ''' <summary>
    ''' Collects the directories those matches the criteria inside the specified directory and/or sub-directories.
    ''' </summary>
    ''' <param name="queue">The <see cref="ConcurrentQueue(Of DirectoryInfo)"/> instance to enqueue new directories.</param>
    ''' <param name="dirPath">The root directory path to search for directories.</param>
    ''' <param name="searchOption">The searching mode.</param>
    ''' <param name="dirPathPatterns">The directory path pattern(s) to match.</param>
    ''' <param name="dirNamePatterns">The directory name pattern(s) to match.</param>
    ''' <param name="ignoreCase">If <c>True</c>, ignores the comparing case of <paramref name="dirPathPatterns"/> and <paramref name="dirNamePatterns"/> patterns.</param>
    ''' <param name="throwOnError">If set to <c>true</c>, exceptions will be thrown, like access denied to directory.</param>
    Private Shared Sub CollectDirs(ByVal queue As ConcurrentQueue(Of DirectoryInfo),
                                   ByVal dirPath As String,
                                   ByVal searchOption As SearchOption,
                                   ByVal dirPathPatterns As IEnumerable(Of String),
                                   ByVal dirNamePatterns As IEnumerable(Of String),
                                   ByVal ignoreCase As Boolean,
                                   ByVal throwOnError As Boolean)

        ' Initialize a DirectoryInfo collection.
        Dim dirInfoCol As IEnumerable(Of DirectoryInfo) = Nothing

        ' Initialize a DirectoryInfo.
        Dim dirInfo As DirectoryInfo = Nothing
        SetupDirInfoObject(dirPath, dirInfo, throwOnError)

        ' Get the top directories of the current directory.
        SetupFileDirCollection(Of DirectoryInfo)(AddressOf dirInfo.GetDirectories, Nothing,
                                                 dirInfo.FullName, "*", dirInfoCol, throwOnError)

        ' If the fileInfoCol collection is not empty then...
        If dirInfoCol IsNot Nothing Then

            ' Iterate the files.
            For Each dir As DirectoryInfo In dirInfoCol

                ' Flag to determine whether a directory path pattern is matched. Activated by default.
                Dim flagPathPattern As Boolean = True

                ' Flag to determine whether a directory name pattern is matched. Activated by default.
                Dim flagNamePattern As Boolean = True

                ' If directory path patterns collection is not empty then...
                If dirPathPatterns IsNot Nothing Then
                    flagPathPattern = IsMatchPattern(dir.FullName, dirPathPatterns, ignoreCase)
                End If

                ' If directory name patterns collection is not empty then...
                If dirNamePatterns IsNot Nothing Then
                    flagNamePattern = IsMatchPattern(dir.Name, dirNamePatterns, ignoreCase)
                End If

                ' If directory path and also directory name patterns are matched then...
                If flagPathPattern AndAlso flagNamePattern Then
                    queue.Enqueue(dir) ' Enqueue this DirectoryInfo object.
                End If

            Next dir

        End If ' dirInfoCol IsNot Nothing

        ' If searchOption is recursive then...
        If searchOption = searchOption.AllDirectories Then
            RunNextTasks(Of DirectoryInfo)(AddressOf CollectDirs,
                                           queue, dirPath, dirPathPatterns, dirNamePatterns, ignoreCase, throwOnError)
        End If

    End Sub

    ''' <summary>
    ''' Collects the directory paths those matches the criteria inside the specified directory and/or sub-directories.
    ''' </summary>
    ''' <param name="queue">The <see cref="ConcurrentQueue(Of String)"/> instance to enqueue new directory paths.</param>
    ''' <param name="dirPath">The root directory path to search for directories.</param>
    ''' <param name="searchOption">The searching mode.</param>
    ''' <param name="dirPathPatterns">The directory path pattern(s) to match.</param>
    ''' <param name="dirNamePatterns">The directory name pattern(s) to match.</param>
    ''' <param name="ignoreCase">If <c>True</c>, ignores the comparing case of <paramref name="dirPathPatterns"/> and <paramref name="dirNamePatterns"/> patterns.</param>
    ''' <param name="throwOnError">If set to <c>true</c>, exceptions will be thrown, like access denied to directory.</param>
    Private Shared Sub CollectDirPaths(ByVal queue As ConcurrentQueue(Of String),
                                       ByVal dirPath As String,
                                       ByVal searchOption As SearchOption,
                                       ByVal dirPathPatterns As IEnumerable(Of String),
                                       ByVal dirNamePatterns As IEnumerable(Of String),
                                       ByVal ignoreCase As Boolean,
                                       ByVal throwOnError As Boolean)

        ' Initialize a directory paths collection.
        Dim dirPathCol As IEnumerable(Of String) = Nothing

        ' Get the top directory paths of the current directory.
        SetupFileDirCollection(Of String)(Nothing, AddressOf Directory.GetDirectories,
                                          dirPath, "*", dirPathCol, throwOnError)

        ' If the fileInfoCol collection is not empty then...
        If dirPathCol IsNot Nothing Then

            ' Iterate the files.
            For Each dir As String In dirPathCol

                ' Flag to determine whether a directory path pattern is matched. Activated by default.
                Dim flagPathPattern As Boolean = True

                ' Flag to determine whether a directory name pattern is matched. Activated by default.
                Dim flagNamePattern As Boolean = True

                ' If directory path patterns collection is not empty then...
                If dirPathPatterns IsNot Nothing Then
                    flagPathPattern = IsMatchPattern(dir, dirPathPatterns, ignoreCase)
                End If

                ' If directory name patterns collection is not empty then...
                If dirNamePatterns IsNot Nothing Then
                    flagNamePattern = IsMatchPattern(Path.GetFileName(dir), dirNamePatterns, ignoreCase)
                End If

                ' If directory path and also directory name patterns are matched then...
                If flagPathPattern AndAlso flagNamePattern Then
                    queue.Enqueue(dir) ' Enqueue this directory path.
                End If

            Next dir

        End If ' dirPathCol IsNot Nothing

        ' If searchOption is recursive then...
        If searchOption = searchOption.AllDirectories Then
            RunNextTasks(Of String)(AddressOf CollectDirPaths,
                                    queue, dirPath, dirPathPatterns, dirNamePatterns, ignoreCase, throwOnError)
        End If

    End Sub

#End Region

End Class

#End Region








Eleкtro

#453
Una manera sencilla de medír el tiempo de ejecución de un método, útil para llevar a cabo análisis/comparaciones.

( Los resultados se puedne mostrar en un messageBox o en la consola de depuración, usando el parámetro opcional. )

Modo de empleo:
Código (vbnet) [Seleccionar]
   MeasureAction(Sub()
                     For x As Integer = 0 To 5000
                         Debug.WriteLine(x)
                     Next
                 End Sub)


O bien:
Código (vbnet) [Seleccionar]
   MeasureAction(AddressOf Test)

   Private Function Test() As Boolean
       ' Esto provocará un error:
       Return CTypeDynamic(Of Boolean)("")
   End Function


Source:
Código (vbnet) [Seleccionar]
   ''' <remarks>
   ''' *****************************************************************
   ''' Snippet Title: Measure Code Execution Time
   ''' Code's Author: Elektro
   ''' Date Modified: 16-February-2015
   ''' Usage Example:
   ''' MeasureAction(AddressOf MyMethodName, writeResultInConsole:=True)
   '''
   ''' MeasureAction(Sub()
   '''                   ' My Method Lambda...
   '''               End Sub)
   ''' *****************************************************************
   ''' </remarks>
   ''' <summary>
   ''' Measures the code execution time of a method.
   ''' </summary>
   ''' <param name="action">The action to be invoked.</param>
   ''' <param name="writeResultInConsole">
   ''' If set to <c>true</c>, print the results in console instead of displaying a <see cref="MessageBox"/>.
   ''' </param>
   Private Sub MeasureAction(ByVal action As Action,
                             Optional ByVal writeResultInConsole As Boolean = False)

       ' Measures the elapsed time.
       Dim timeWatch As New Stopwatch

       ' The time display format (Hours:Minutes:Secons:Milliseconds)
       Dim timeFormat As String = "hh\:mm\:ss\:fff"

       ' Flag that determines whether the method invocation has succeed.
       Dim success As Boolean = False

       ' Captures any exception caused by the invoked method.
       Dim invokeEx As Exception = Nothing

       ' Retains and formats the information string.
       Dim sb As New System.Text.StringBuilder

       ' Determines the MessageBox icon.
       Dim msgIcon As MessageBoxIcon

       ' Determines the MessageBox buttons.
       Dim msgButtons As MessageBoxButtons

       ' Determines the MessageBox result.
       Dim msgResult As DialogResult

       ' Start to measure time.
       timeWatch.Start()

       Try
           ' Invoke the method.
           action.Invoke()
           success = True

       Catch ex As Exception
           ' Capture the exception details.
           invokeEx = ex
           success = False

       Finally
           ' Ensure to stop measuring time.
           timeWatch.Stop()

       End Try

       Select Case success

           Case True
               With sb ' Set an information message.
                   .AppendLine(String.Format("Method Name: {0}", action.Method.Name))
                   .AppendLine()
                   .AppendLine(String.Format("Elapsed Time: {0}", timeWatch.Elapsed.ToString(timeFormat)))
               End With

           Case Else
               With sb ' Set an error message.
                   .AppendLine("Exception occurred during code execution measuring.")
                   .AppendLine()
                   .AppendLine(String.Format("Method Name: {0}", action.Method.Name))
                   .AppendLine()
                   .AppendLine(String.Format("Exception Type: {0}", invokeEx.GetType.Name))
                   .AppendLine()
                   .AppendLine("Exception Message:")
                   .AppendLine(invokeEx.Message)
                   .AppendLine()
                   .AppendLine("Exception Stack Trace:")
                   .AppendLine(invokeEx.StackTrace)
               End With

       End Select

       If writeResultInConsole Then ' Print results in console.
           Debug.WriteLine(String.Join(Environment.NewLine,
                                       sb.ToString.Split({Environment.NewLine}, StringSplitOptions.RemoveEmptyEntries)))

       Else
           ' Show the MessageBox with the information string.
           msgIcon = If(success, MessageBoxIcon.Information, MessageBoxIcon.Error)
           msgButtons = If(success, MessageBoxButtons.OK, MessageBoxButtons.RetryCancel)
           msgResult = MessageBox.Show(sb.ToString, "Code Execution Measurer", msgButtons, msgIcon)

           ' If invoked method has failed, retry or cancel.
           If Not success AndAlso (msgResult = DialogResult.Retry) Then
               MeasureAction(action, writeResultInConsole)
           End If

       End If

   End Sub








Eleкtro

#454
He desarrollado este snippet para administrar las capacidades de arrastrar (dragging) en tiempo de ejecución, de uno o varios Forms, extendiendo el control y la eficiencia de los típicos códigos "copy&paste" que se pueden encontrar por internet para llevar a cabo dicha tarea.

Ejemplos de uso:
Código (vbnet) [Seleccionar]
Public Class Form1

   ''' <summary>
   ''' The <see cref="FormDragger"/> instance that manages the form(s) dragging.
   ''' </summary>
   Private formDragger As FormDragger = FormDragger.Empty

   Private Sub Test() Handles MyBase.Shown
       Me.InitializeDrag()
   End Sub

   Private Sub Button1_Click(ByVal sender As Object, ByVal e As EventArgs) _
   Handles Button1.Click

       Me.AlternateDragEnabled(Me)

   End Sub

   Private Sub InitializeDrag()

       ' 1st way, using the single-Form constructor:
       Me.formDragger = New FormDragger(Me, enabled:=True, cursor:=Cursors.SizeAll)

       ' 2nd way, using the multiple-Forms constructor:
       ' Me.formDragger = New FormDragger({Me, Form2, form3})

       ' 3rd way, using the default constructor then adding a Form into the collection:
       ' Me.formDragger = New FormDragger
       ' Me.formDragger.AddForm(Me, enabled:=True, cursor:=Cursors.SizeAll)

   End Sub

   ''' <summary>
   ''' Alternates the dragging of the specified form.
   ''' </summary>
   ''' <param name="form">The form.</param>
   Private Sub AlternateDragEnabled(ByVal form As Form)

       Dim formInfo As FormDragger.FormDragInfo = Me.formDragger.FindFormDragInfo(form)
       formInfo.Enabled = Not formInfo.Enabled

   End Sub

End Class


Source:
Código (vbnet) [Seleccionar]
' ***********************************************************************
' Author   : Elektro
' Modified : 15-March-2015
' ***********************************************************************
' <copyright file="FormDragger.vb" company="Elektro Studios">
'     Copyright (c) Elektro Studios. All rights reserved.
' </copyright>
' ***********************************************************************

#Region " Option Statements "

Option Explicit On
Option Strict On
Option Infer Off

#End Region

#Region " Usage Examples "

'Public Class Form1

'    ''' <summary>
'    ''' The <see cref="FormDragger"/> instance that manages the form(s) dragging.
'    ''' </summary>
'    Private formDragger As FormDragger = FormDragger.Empty

'    Private Sub Test() Handles MyBase.Shown
'        Me.InitializeDrag()
'    End Sub

'    Private Sub Button1_Click(ByVal sender As Object, ByVal e As EventArgs) _
'    Handles Button1.Click

'        Me.AlternateDragEnabled(Me)

'    End Sub

'    Private Sub InitializeDrag()

'        ' 1st way, using the single-Form constructor:
'        Me.formDragger = New FormDragger(Me, enabled:=True, cursor:=Cursors.SizeAll)

'        ' 2nd way, using the multiple-Forms constructor:
'        ' Me.formDragger = New FormDragger({Me, Form2, form3})

'        ' 3rd way, using the default constructor then adding a Form into the collection:
'        ' Me.formDragger = New FormDragger
'        ' Me.formDragger.AddForm(Me, enabled:=True, cursor:=Cursors.SizeAll)

'    End Sub

'    ''' <summary>
'    ''' Alternates the dragging of the specified form.
'    ''' </summary>
'    ''' <param name="form">The form.</param>
'    Private Sub AlternateDragEnabled(ByVal form As Form)

'        Dim formInfo As FormDragger.FormDragInfo = Me.formDragger.FindFormDragInfo(form)
'        formInfo.Enabled = Not formInfo.Enabled

'    End Sub

'End Class

#End Region

#Region " Imports "

Imports System.ComponentModel

#End Region

#Region " Form Dragger "

''' <summary>
''' Enable or disable drag at runtime on a <see cref="Form"/>.
''' </summary>
Public NotInheritable Class FormDragger : Implements IDisposable

#Region " Properties "

   ''' <summary>
   ''' Gets an <see cref="IEnumerable(Of Form)"/> collection that contains the Forms capables to perform draggable operations.
   ''' </summary>
   ''' <value>The <see cref="IEnumerable(Of Form)"/>.</value>
   <EditorBrowsable(EditorBrowsableState.Always)>
   Public ReadOnly Property Forms As IEnumerable(Of FormDragInfo)
       Get
           Return Me.forms1
       End Get
   End Property
   ''' <summary>
   ''' An <see cref="IEnumerable(Of Form)"/> collection that contains the Forms capables to perform draggable operations.
   ''' </summary>
   Private forms1 As IEnumerable(Of FormDragInfo) = {}

   ''' <summary>
   ''' Represents a <see cref="FormDragger"/> instance that is <c>Nothing</c>.
   ''' </summary>
   ''' <value><c>Nothing</c></value>
   <EditorBrowsable(EditorBrowsableState.Always)>
   Public Shared ReadOnly Property Empty As FormDragger
       Get
           Return Nothing
       End Get
   End Property

#End Region

#Region " Types "

   ''' <summary>
   ''' Defines the draggable info of a <see cref="Form"/>.
   ''' </summary>
   <Serializable>
   Public NotInheritable Class FormDragInfo

#Region " Properties "

       ''' <summary>
       ''' Gets the associated <see cref="Form"/> used to perform draggable operations.
       ''' </summary>
       ''' <value>The associated <see cref="Form"/>.</value>
       <EditorBrowsable(EditorBrowsableState.Always)>
       Public ReadOnly Property Form As Form
           Get
               Return form1
           End Get
       End Property
       ''' <summary>
       ''' The associated <see cref="Form"/>
       ''' </summary>
       <NonSerialized>
       Private ReadOnly form1 As Form

       ''' <summary>
       ''' Gets the name of the associated <see cref="Form"/>.
       ''' </summary>
       ''' <value>The Form.</value>
       <EditorBrowsable(EditorBrowsableState.Always)>
       Public ReadOnly Property Name As String
           Get
               If Me.Form IsNot Nothing Then
                   Return Form.Name
               Else
                   Return String.Empty
               End If
           End Get
       End Property

       ''' <summary>
       ''' Gets or sets a value indicating whether drag is enabled on the associated <see cref="Form"/>.
       ''' </summary>
       ''' <value><c>true</c> if drag is enabled; otherwise, <c>false</c>.</value>
       <EditorBrowsable(EditorBrowsableState.Always)>
       Public Property Enabled As Boolean

       ''' <summary>
       ''' A <see cref="FormDragger"/> instance instance containing the draggable information of the associated <see cref="Form"/>.
       ''' </summary>
       ''' <value>The draggable information.</value>
       <EditorBrowsable(EditorBrowsableState.Never)>
       Public Property DragInfo As FormDragger = FormDragger.Empty

       ''' <summary>
       ''' Gets or sets the <see cref="Cursor"/> used to drag the associated <see cref="Form"/>.
       ''' </summary>
       ''' <value>The <see cref="Cursor"/>.</value>
       <EditorBrowsable(EditorBrowsableState.Always)>
       Public Property Cursor As Cursor = Cursors.SizeAll

       ''' <summary>
       ''' Gets or sets the old form's cursor to restore it after dragging.
       ''' </summary>
       ''' <value>The old form's cursor.</value>
       <EditorBrowsable(EditorBrowsableState.Never)>
       Public Property OldCursor As Cursor = Nothing

       ''' <summary>
       ''' Gets or sets the initial mouse coordinates, normally <see cref="Form.MousePosition"/>.
       ''' </summary>
       ''' <value>The initial mouse coordinates.</value>
       <EditorBrowsable(EditorBrowsableState.Never)>
       Public Property InitialMouseCoords As Point = Point.Empty

       ''' <summary>
       ''' Gets or sets the initial <see cref="Form"/> location, normally <see cref="Form.Location"/>.
       ''' </summary>
       ''' <value>The initial location.</value>
       <EditorBrowsable(EditorBrowsableState.Never)>
       Public Property InitialLocation As Point = Point.Empty

#End Region

#Region " Constructors "

       ''' <summary>
       ''' Initializes a new instance of the <see cref="FormDragInfo"/> class.
       ''' </summary>
       ''' <param name="form">The form.</param>
       Public Sub New(ByVal form As Form)
           Me.form1 = form
           Me.Cursor = form.Cursor
       End Sub

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

#End Region

#Region " Hidden Methods "

       ''' <summary>
       ''' Serves as a hash function for a particular type.
       ''' </summary>
       <EditorBrowsable(EditorBrowsableState.Never)>
       Public Shadows Function GetHashCode() As Integer
           Return MyBase.GetHashCode
       End Function

       ''' <summary>
       ''' Gets the System.Type of the current instance.
       ''' </summary>
       ''' <returns>The exact runtime type of the current instance.</returns>
       <EditorBrowsable(EditorBrowsableState.Never)>
       Public Shadows Function [GetType]() As Type
           Return MyBase.GetType
       End Function

       ''' <summary>
       ''' Determines whether the specified System.Object instances are considered equal.
       ''' </summary>
       <EditorBrowsable(EditorBrowsableState.Never)>
       Public Shadows Function Equals(ByVal obj As Object) As Boolean
           Return MyBase.Equals(obj)
       End Function

       ''' <summary>
       ''' Determines whether the specified System.Object instances are the same instance.
       ''' </summary>
       <EditorBrowsable(EditorBrowsableState.Never)>
       Private Shadows Sub ReferenceEquals()
       End Sub

       ''' <summary>
       ''' Returns a String that represents the current object.
       ''' </summary>
       <EditorBrowsable(EditorBrowsableState.Never)>
       Public Shadows Function ToString() As String
           Return MyBase.ToString
       End Function

#End Region

   End Class

#End Region

#Region " Constructors "

   ''' <summary>
   ''' Initializes a new instance of the <see cref="FormDragger"/> class.
   ''' </summary>
   Public Sub New()
       Me.forms1={}
   End Sub

   ''' <summary>
   ''' Initializes a new instance of the <see cref="FormDragger"/> class.
   ''' </summary>
   ''' <param name="form">The <see cref="Form"/> used to perform draggable operations.</param>
   ''' <param name="enabled">If set to <c>true</c>, enable dragging on the <see cref="Form"/>.</param>
   ''' <param name="cursor">The <see cref="Cursor"/> used to drag the specified <see cref="Form"/>.</param>
   Public Sub New(ByVal form As Form,
                  Optional enabled As Boolean = False,
                  Optional cursor As Cursor = Nothing)

       Me.forms1 =
           {
               New FormDragInfo(form) With
                        {
                            .Enabled = enabled,
                            .Cursor = cursor
                        }
           }

       Me.AssocHandlers(form)

   End Sub

   ''' <summary>
   ''' Initializes a new instance of the <see cref="FormDragger"/> class.
   ''' </summary>
   ''' <param name="forms">The <see cref="Forms"/> used to perform draggable operations.</param>
   Public Sub New(ByVal forms As IEnumerable(Of Form))

       Me.forms1 = (From form As Form In forms
                    Select New FormDragInfo(form)).ToArray

       For Each form As Form In forms
           Me.AssocHandlers(form)
       Next form

   End Sub

   ''' <summary>
   ''' Initializes a new instance of the <see cref="FormDragger"/> class.
   ''' </summary>
   ''' <param name="formInfo">
   ''' The <see cref="FormDragInfo"/> instance
   ''' that contains the <see cref="Form"/> reference and its draggable info.
   ''' </param>
   ''' <param name="mouseCoordinates">The current mouse coordinates.</param>
   ''' <param name="location">The current location.</param>
   Private Sub New(ByVal formInfo As FormDragInfo,
                   ByVal mouseCoordinates As Point,
                   ByVal location As Point)

       formInfo.InitialMouseCoords = mouseCoordinates
       formInfo.InitialLocation = location

   End Sub

#End Region

#Region " Public Methods "

   ''' <summary>
   ''' Adds the specified <see cref="Form"/> into the draggable <see cref="Forms"/> collection.
   ''' </summary>
   ''' <param name="form">The <see cref="Form"/>.</param>
   ''' <param name="enabled">If set to <c>true</c>, enable dragging on the <see cref="Form"/>.</param>
   ''' <param name="cursor">The <see cref="Cursor"/> used to drag the specified <see cref="Form"/>.</param>
   ''' <exception cref="System.ArgumentException">The specified form is already added.;form</exception>
   Public Function AddForm(ByVal form As Form,
                           Optional enabled As Boolean = False,
                           Optional cursor As Cursor = Nothing) As FormDragInfo

       For Each formInfo As FormDragInfo In Me.forms1

           If formInfo.Form.Equals(form) Then
               Throw New ArgumentException("The specified form is already added.", "form")
               Exit Function
           End If

       Next formInfo

       Dim newFormInfo As New FormDragInfo(form) With {.Enabled = enabled, .Cursor = cursor}
       Me.forms1 = Me.forms1.Concat({newFormInfo})
       Me.AssocHandlers(form)

       Return newFormInfo

   End Function

   ''' <summary>
   ''' Removes the specified <see cref="Form"/> from the draggable <see cref="Forms"/> collection.
   ''' </summary>
   ''' <param name="form">The form.</param>
   ''' <exception cref="System.ArgumentException">The specified form is not found.;form</exception>
   Public Sub RemoveForm(ByVal form As Form)

       Dim formInfoToRemove As FormDragInfo = Nothing

       For Each formInfo As FormDragInfo In Me.forms1

           If formInfo.Form.Equals(form) Then
               formInfoToRemove = formInfo
               Exit For
           End If

       Next formInfo

       If formInfoToRemove IsNot Nothing Then

           Me.forms1 = From formInfo As FormDragInfo In Me.forms1
                       Where Not formInfo Is formInfoToRemove

           formInfoToRemove.Enabled = False
           Me.DeassocHandlers(formInfoToRemove.Form)

       Else
           Throw New ArgumentException("The specified form is not found.", "form")

       End If

   End Sub

   ''' <summary>
   ''' Finds the <see cref="FormDragInfo"/> instance that is associated with the specified <see cref="Form"/> reference.
   ''' </summary>
   ''' <param name="form">The <see cref="Form"/>.</param>
   ''' <returns>The <see cref="FormDragInfo"/> instance that is associated with the specified <see cref="Form"/> reference.</returns>
   Public Function FindFormDragInfo(ByVal form As Form) As FormDragInfo

       Return (From formInfo As FormDragger.FormDragInfo In Me.forms1
               Where formInfo.Form Is form).FirstOrDefault

   End Function

   ''' <summary>
   ''' Finds the <see cref="FormDragInfo"/> instance that is associated with the specified <see cref="Form"/> reference.
   ''' </summary>
   ''' <param name="name">The <see cref="Form"/> name.</param>
   ''' <returns>The <see cref="FormDragInfo"/> instance that is associated with the specified <see cref="Form"/> reference.</returns>
   Public Function FindFormDragInfo(ByVal name As String,
                                    Optional stringComparison As StringComparison =
                                             StringComparison.OrdinalIgnoreCase) As FormDragInfo

       Return (From formInfo As FormDragger.FormDragInfo In Me.forms1
               Where formInfo.Name.Equals(name, stringComparison)).FirstOrDefault

   End Function

#End Region

#Region " Private Methods "

   ''' <summary>
   ''' Associates the <see cref="Form"/> handlers to enable draggable operations.
   ''' </summary>
   ''' <param name="form">The form.</param>
   Private Sub AssocHandlers(ByVal form As Form)

       AddHandler form.MouseDown, AddressOf Me.Form_MouseDown
       AddHandler form.MouseUp, AddressOf Me.Form_MouseUp
       AddHandler form.MouseMove, AddressOf Me.Form_MouseMove
       AddHandler form.MouseEnter, AddressOf Me.Form_MouseEnter
       AddHandler form.MouseLeave, AddressOf Me.Form_MouseLeave

   End Sub

   ''' <summary>
   ''' Deassociates the <see cref="Form"/> handlers to disable draggable operations.
   ''' </summary>
   ''' <param name="form">The form.</param>
   Private Sub DeassocHandlers(ByVal form As Form)

       If Not form.IsDisposed AndAlso Not form.Disposing Then

           RemoveHandler form.MouseDown, AddressOf Me.Form_MouseDown
           RemoveHandler form.MouseUp, AddressOf Me.Form_MouseUp
           RemoveHandler form.MouseMove, AddressOf Me.Form_MouseMove
           RemoveHandler form.MouseEnter, AddressOf Me.Form_MouseEnter
           RemoveHandler form.MouseLeave, AddressOf Me.Form_MouseLeave

       End If

   End Sub

   ''' <summary>
   ''' Return the new location.
   ''' </summary>
   ''' <param name="formInfo">
   ''' The <see cref="FormDragInfo"/> instance
   ''' that contains the <see cref="Form"/> reference and its draggable info.
   ''' </param>
   ''' <param name="mouseCoordinates">The current mouse coordinates.</param>
   ''' <returns>The new location.</returns>
   Private Function GetNewLocation(ByVal formInfo As FormDragInfo,
                                   ByVal mouseCoordinates As Point) As Point

       Return New Point(formInfo.InitialLocation.X + (mouseCoordinates.X - formInfo.InitialMouseCoords.X),
                        formInfo.InitialLocation.Y + (mouseCoordinates.Y - formInfo.InitialMouseCoords.Y))

   End Function

#End Region

#Region " Hidden Methods "

   ''' <summary>
   ''' Serves as a hash function for a particular type.
   ''' </summary>
   <EditorBrowsable(EditorBrowsableState.Never)>
   Public Shadows Function GetHashCode() As Integer
       Return MyBase.GetHashCode
   End Function

   ''' <summary>
   ''' Gets the System.Type of the current instance.
   ''' </summary>
   ''' <returns>The exact runtime type of the current instance.</returns>
   <EditorBrowsable(EditorBrowsableState.Never)>
   Public Shadows Function [GetType]() As Type
       Return MyBase.GetType
   End Function

   ''' <summary>
   ''' Determines whether the specified System.Object instances are considered equal.
   ''' </summary>
   <EditorBrowsable(EditorBrowsableState.Never)>
   Public Shadows Function Equals(ByVal obj As Object) As Boolean
       Return MyBase.Equals(obj)
   End Function

   ''' <summary>
   ''' Determines whether the specified System.Object instances are the same instance.
   ''' </summary>
   <EditorBrowsable(EditorBrowsableState.Never)>
   Private Shadows Sub ReferenceEquals()
   End Sub

   ''' <summary>
   ''' Returns a String that represents the current object.
   ''' </summary>
   <EditorBrowsable(EditorBrowsableState.Never)>
   Public Shadows Function ToString() As String
       Return MyBase.ToString
   End Function

#End Region

#Region " Event Handlers "

   ''' <summary>
   ''' Handles the MouseEnter event of the Form.
   ''' </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 Form_MouseEnter(ByVal sender As Object, ByVal e As EventArgs)

       Dim formInfo As FormDragInfo = FindFormDragInfo(DirectCast(sender, Form))

       formInfo.OldCursor = formInfo.Form.Cursor

       If formInfo.Enabled Then
           formInfo.Form.Cursor = formInfo.Cursor
           ' Optional:
           ' formInfo.Form.BringToFront()
       End If

   End Sub

   ''' <summary>
   ''' Handles the MouseLeave event of the Form.
   ''' </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 Form_MouseLeave(ByVal sender As Object, ByVal e As EventArgs)

       Dim formInfo As FormDragInfo = FindFormDragInfo(DirectCast(sender, Form))

       formInfo.Form.Cursor = formInfo.OldCursor

   End Sub

   ''' <summary>
   ''' Handles the MouseDown event of the Form.
   ''' </summary>
   ''' <param name="sender">The source of the event.</param>
   ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
   Private Sub Form_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs)

       Dim formInfo As FormDragInfo = FindFormDragInfo(DirectCast(sender, Form))

       If formInfo.Enabled Then
           formInfo.DragInfo = New FormDragger(formInfo, Form.MousePosition, formInfo.Form.Location)
       End If

   End Sub

   ''' <summary>
   ''' Handles the MouseMove event of the Form.
   ''' </summary>
   ''' <param name="sender">The source of the event.</param>
   ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
   Private Sub Form_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs)

       Dim formInfo As FormDragInfo = FindFormDragInfo(DirectCast(sender, Form))

       If formInfo.Enabled AndAlso (formInfo.DragInfo IsNot FormDragger.Empty) Then
           formInfo.Form.Location = formInfo.DragInfo.GetNewLocation(formInfo, Form.MousePosition)
       End If

   End Sub

   ''' <summary>
   ''' Handles the MouseUp event of the Form.
   ''' </summary>
   ''' <param name="sender">The source of the event.</param>
   ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
   Private Sub Form_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs)

       Dim formInfo As FormDragInfo = FindFormDragInfo(DirectCast(sender, Form))

       formInfo.DragInfo = FormDragger.Empty

   End Sub

#End Region

#Region " IDisposable "

   ''' <summary>
   ''' To detect redundant calls when disposing.
   ''' </summary>
   Private isDisposed As Boolean = False

   ''' <summary>
   ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
   ''' </summary>
   Public Sub Dispose() Implements IDisposable.Dispose
       Me.Dispose(True)
       GC.SuppressFinalize(Me)
   End Sub

   ''' <summary>
   ''' Releases unmanaged and - optionally - managed resources.
   ''' </summary>
   ''' <param name="IsDisposing">
   ''' <c>true</c> to release both managed and unmanaged resources;
   ''' <c>false</c> to release only unmanaged resources.
   ''' </param>
   Protected Sub Dispose(ByVal isDisposing As Boolean)

       If Not Me.isDisposed Then

           If isDisposing Then

               For Each formInfo As FormDragInfo In Me.forms1

                   With formInfo

                       .Enabled = False
                       .OldCursor = Nothing
                       .DragInfo = FormDragger.Empty
                       .InitialMouseCoords = Point.Empty
                       .InitialLocation = Point.Empty

                       Me.DeassocHandlers(.Form)

                   End With ' form

               Next formInfo

               Me.forms1 = Nothing

           End If ' IsDisposing

       End If ' Not Me.IsDisposed

       Me.isDisposed = True

   End Sub

#End Region

End Class

#End Region








Eleкtro

Aquí les dejo un (casi)completo set de utilidades para manejar el registro de windows desde una aplicación .Net, tiene todo tipo de funcionalidades.

Ejemplos de uso:
Código (vbnet) [Seleccionar]
----------------
Set RegInfo Instance
----------------

    Dim regInfo As New RegEdit.RegInfo
    With regInfo
        .RootKeyName = "HKCU"
        .SubKeyPath = "Subkey Path"
        .ValueName = "Value Name"
        .ValueType = Microsoft.Win32.RegistryValueKind.String
        .ValueData = "Hello World!"
    End With

    Dim regInfoByte As New RegEdit.RegInfo(Of Byte())
    With regInfoByte
        .RootKeyName = "HKCU"
        .SubKeyPath = "Subkey Path"
        .ValueName = "Value Name"
        .ValueType = Microsoft.Win32.RegistryValueKind.Binary
        .ValueData = System.Text.Encoding.ASCII.GetBytes("Hello World!")
    End With

----------------
Create SubKey
----------------

    RegEdit.CreateSubKey(fullKeyPath:="HKCU\Subkey Path\")
    RegEdit.CreateSubKey(rootKeyName:="HKCU",
                         subKeyPath:="Subkey Path")
    RegEdit.CreateSubKey(regInfo:=regInfoByte)

    Dim regKey1 As Microsoft.Win32.RegistryKey =
        RegEdit.CreateSubKey(fullKeyPath:="HKCU\Subkey Path\",
                             registryKeyPermissionCheck:=Microsoft.Win32.RegistryKeyPermissionCheck.Default,
                             registryOptions:=Microsoft.Win32.RegistryOptions.None)

    Dim regKey2 As Microsoft.Win32.RegistryKey =
        RegEdit.CreateSubKey(rootKeyName:="HKCU",
                             subKeyPath:="Subkey Path",
                             registryKeyPermissionCheck:=Microsoft.Win32.RegistryKeyPermissionCheck.Default,
                             registryOptions:=Microsoft.Win32.RegistryOptions.None)

    Dim regInfo2 As RegEdit.RegInfo(Of String) = RegEdit.CreateSubKey(Of String)(fullKeyPath:="HKCU\Subkey Path\")
    Dim regInfo3 As RegEdit.RegInfo(Of String) = RegEdit.CreateSubKey(Of String)(rootKeyName:="HKCU",
                                                                                 subKeyPath:="Subkey Path")

----------------
Create Value
----------------

    RegEdit.CreateValue(fullKeyPath:="HKCU\Subkey Path\",
                        valueName:="Value Name",
                        valueData:="Value Data",
                        valueType:=Microsoft.Win32.RegistryValueKind.String)

    RegEdit.CreateValue(rootKeyName:="HKCU",
                        subKeyPath:="Subkey Path",
                        valueName:="Value Name",
                        valueData:="Value Data",
                        valueType:=Microsoft.Win32.RegistryValueKind.String)

    RegEdit.CreateValue(regInfo:=regInfoByte)

    RegEdit.CreateValue(Of String)(fullKeyPath:="HKCU\Subkey Path\",
                                   valueName:="Value Name",
                                   valueData:="Value Data",
                                   valueType:=Microsoft.Win32.RegistryValueKind.String)

    RegEdit.CreateValue(Of String)(rootKeyName:="HKCU",
                                   subKeyPath:="Subkey Path",
                                   valueName:="Value Name",
                                   valueData:="Value Data",
                                   valueType:=Microsoft.Win32.RegistryValueKind.String)

    RegEdit.CreateValue(Of Byte())(regInfo:=regInfoByte)

----------------
Copy KeyTree
----------------

    RegEdit.CopyKeyTree(sourceFullKeyPath:="HKCU\Source Subkey Path\",
                        targetFullKeyPath:="HKCU\Target Subkey Path\")

    RegEdit.CopyKeyTree(sourceRootKeyName:="HKCU",
                        sourceSubKeyPath:="Source Subkey Path\",
                        targetRootKeyName:="HKCU",
                        targetSubKeyPath:="Target Subkey Path\")

----------------
Move KeyTree
----------------

    RegEdit.MoveKeyTree(sourceFullKeyPath:="HKCU\Source Subkey Path\",
                        targetFullKeyPath:="HKCU\Target Subkey Path\")

    RegEdit.MoveKeyTree(sourceRootKeyName:="HKCU",
                        sourceSubKeyPath:="Source Subkey Path\",
                        targetRootKeyName:="HKCU",
                        targetSubKeyPath:="Target Subkey Path\")

----------------
Copy SubKeys
----------------

    RegEdit.CopySubKeys(sourceFullKeyPath:="HKCU\Source Subkey Path\",
                        targetFullKeyPath:="HKCU\Target Subkey Path\")

    RegEdit.CopySubKeys(sourceRootKeyName:="HKCU",
                        sourceSubKeyPath:="Source Subkey Path\",
                        targetRootKeyName:="HKCU",
                        targetSubKeyPath:="Target Subkey Path\")

----------------
Move SubKeys
----------------

    RegEdit.MoveSubKeys(sourceFullKeyPath:="HKCU\Source Subkey Path\",
                        targetFullKeyPath:="HKCU\Target Subkey Path\")

    RegEdit.MoveSubKeys(sourceRootKeyName:="HKCU",
                        sourceSubKeyPath:="Source Subkey Path\",
                        targetRootKeyName:="HKCU",
                        targetSubKeyPath:="Target Subkey Path\")

----------------
Copy Value
----------------

    RegEdit.CopyValue(sourceFullKeyPath:="HKCU\Source Subkey Path\",
                      sourceValueName:="Value Name",
                      targetFullKeyPath:="HKCU\Target Subkey Path\",
                      targetValueName:="Value Name")

    RegEdit.CopyValue(sourceRootKeyName:="HKCU",
                      sourceSubKeyPath:="Source Subkey Path\",
                      sourceValueName:="Value Name",
                      targetRootKeyName:="HKCU",
                      targetSubKeyPath:="Target Subkey Path\",
                      targetValueName:="Value Name")

----------------
Move Value
----------------

    RegEdit.MoveValue(sourceFullKeyPath:="HKCU\Source Subkey Path\",
                      sourceValueName:="Value Name",
                      targetFullKeyPath:="HKCU\Target Subkey Path\",
                      targetValueName:="Value Name")

    RegEdit.MoveValue(sourceRootKeyName:="HKCU",
                      sourceSubKeyPath:="Source Subkey Path\",
                      sourceValueName:="Value Name",
                      targetRootKeyName:="HKCU",
                      targetSubKeyPath:="Target Subkey Path\",
                      targetValueName:="Value Name")

----------------
DeleteValue
----------------

    RegEdit.DeleteValue(fullKeyPath:="HKCU\Subkey Path\",
                        valueName:="Value Name",
                        throwOnMissingValue:=True)

    RegEdit.DeleteValue(rootKeyName:="HKCU",
                        subKeyPath:="Subkey Path",
                        valueName:="Value Name",
                        throwOnMissingValue:=True)

    RegEdit.DeleteValue(regInfo:=regInfoByte,
                        throwOnMissingValue:=True)

----------------
Delete SubKey
----------------

    RegEdit.DeleteSubKey(fullKeyPath:="HKCU\Subkey Path\",
                         throwOnMissingSubKey:=False)

    RegEdit.DeleteSubKey(rootKeyName:="HKCU",
                         subKeyPath:="Subkey Path",
                         throwOnMissingSubKey:=False)

    RegEdit.DeleteSubKey(regInfo:=regInfoByte,
                         throwOnMissingSubKey:=False)

----------------
Exist SubKey?
----------------

    Dim exist1 As Boolean = RegEdit.ExistSubKey(fullKeyPath:="HKCU\Subkey Path\")

    Dim exist2 As Boolean = RegEdit.ExistSubKey(rootKeyName:="HKCU",
                                                subKeyPath:="Subkey Path")

----------------
Exist Value?
----------------

    Dim exist3 As Boolean = RegEdit.ExistValue(fullKeyPath:="HKCU\Subkey Path\",
                                               valueName:="Value Name")

    Dim exist4 As Boolean = RegEdit.ExistValue(rootKeyName:="HKCU",
                                               subKeyPath:="Subkey Path",
                                               valueName:="Value Name")

----------------
Value Is Empty?
----------------

    Dim isEmpty1 As Boolean = RegEdit.ValueIsEmpty(fullKeyPath:="HKCU\Subkey Path\",
                                                   valueName:="Value Name")

    Dim isEmpty2 As Boolean = RegEdit.ValueIsEmpty(rootKeyName:="HKCU",
                                                   subKeyPath:="Subkey Path",
                                                   valueName:="Value Name")

----------------
Export Key
----------------

    RegEdit.ExportKey(fullKeyPath:="HKCU\Subkey Path\",
                      outputFile:="C:\Backup.reg")

    RegEdit.ExportKey(rootKeyName:="HKCU",
                      subKeyPath:="Subkey Path",
                      outputFile:="C:\Backup.reg")

----------------
Import RegFile
----------------

    RegEdit.ImportRegFile(regFilePath:="C:\Backup.reg")

----------------
Jump To Key
----------------

    RegEdit.JumpToKey(fullKeyPath:="HKCU\Subkey Path\")

    RegEdit.JumpToKey(rootKeyName:="HKCU",
                      subKeyPath:="Subkey Path")

----------------
Find SubKey
----------------

    Dim regInfoSubkeyCol As IEnumerable(Of RegEdit.Reginfo) =
        RegEdit.FindSubKey(rootKeyName:="HKCU",
                           subKeyPath:="Subkey Path",
                           subKeyName:="Subkey Name",
                           matchFullSubKeyName:=False,
                           ignoreCase:=True,
                           searchOption:=IO.SearchOption.AllDirectories)

    For Each reg As RegEdit.RegInfo In regInfoSubkeyCol
        Debug.WriteLine(reg.RootKeyName)
        Debug.WriteLine(reg.SubKeyPath)
        Debug.WriteLine(reg.ValueName)
        Debug.WriteLine(reg.ValueData.ToString)
        Debug.WriteLine("")
    Next reg

----------------
Find Value
----------------

    Dim regInfoValueNameCol As IEnumerable(Of RegEdit.Reginfo) =
        RegEdit.FindValue(rootKeyName:="HKCU",
                              subKeyPath:="Subkey Path",
                              valueName:="Value Name",
                              matchFullValueName:=False,
                              ignoreCase:=True,
                              searchOption:=IO.SearchOption.AllDirectories)

    For Each reg As RegEdit.RegInfo In regInfoValueNameCol
        Debug.WriteLine(reg.RootKeyName)
        Debug.WriteLine(reg.SubKeyPath)
        Debug.WriteLine(reg.ValueName)
        Debug.WriteLine(reg.ValueData.ToString)
        Debug.WriteLine("")
    Next reg

----------------
Find Value Data
----------------

    Dim regInfoValueDataCol As IEnumerable(Of RegEdit.Reginfo) =
        RegEdit.FindValueData(rootKeyName:="HKCU",
                              subKeyPath:="Subkey Path",
                              valueData:="Value Data",
                              matchFullData:=False,
                              ignoreCase:=True,
                              searchOption:=IO.SearchOption.AllDirectories)

    For Each reg As RegEdit.RegInfo In regInfoValueDataCol
        Debug.WriteLine(reg.RootKeyName)
        Debug.WriteLine(reg.SubKeyPath)
        Debug.WriteLine(reg.ValueName)
        Debug.WriteLine(reg.ValueData.ToString)
        Debug.WriteLine("")
    Next reg

----------------
Get...
----------------

    Dim rootKeyName As String = RegEdit.GetRootKeyName(registryPath:="HKCU\Subkey Path\")
    Dim subKeyPath As String = RegEdit.GetSubKeyPath(registryPath:="HKCU\Subkey Path\")
    Dim rootKey As Microsoft.Win32.RegistryKey = RegEdit.GetRootKey(registryPath:="HKCU\Subkey Path\")

----------------
Get Value Data
----------------

    Dim dataObject As Object = RegEdit.GetValueData(rootKeyName:="HKCU",
                                                    subKeyPath:="Subkey Path",
                                                    valueName:="Value Name")

    Dim dataString As String = RegEdit.GetValueData(Of String)(fullKeyPath:="HKCU\Subkey Path\",
                                                               valueName:="Value Name",
                                                               registryValueOptions:=Microsoft.Win32.RegistryValueOptions.DoNotExpandEnvironmentNames)

    Dim dataByte As Byte() = RegEdit.GetValueData(Of Byte())(regInfo:=regInfoByte,
                                                             registryValueOptions:=Microsoft.Win32.RegistryValueOptions.None)
    Debug.WriteLine("dataByte=" & String.Join(",", dataByte))

-----------------
Set UserAccessKey
-----------------

RegEdit.SetUserAccessKey(fullKeyPath:="HKCU\Subkey Path",
                         userAccess:={RegEdit.ReginiUserAccess.AdministratorsFullAccess})

RegEdit.SetUserAccessKey(rootKeyName:="HKCU",
                         subKeyPath:="Subkey Path",
                         userAccess:={RegEdit.ReginiUserAccess.AdministratorsFullAccess,
                                      RegEdit.ReginiUserAccess.CreatorFullAccess,
                                      RegEdit.ReginiUserAccess.SystemFullAccess})



Código fuente:
http://pastebin.com/cNM1j8Uh

Saludos!








Eleкtro

#456
Este snippet sirve para añadir o eliminar de forma muuuuuy sencilla :P un archivo/aplicación al Startup de Windows mediante el registro, con características interesantes...

Modo de empleo:
Código (vbnet) [Seleccionar]
WinStartupUtil.Add(UserType.CurrentUser, StartupType.Run, KeyBehavior.System32,
                   title:="Application Title",
                   filePath:="C:\Application.exe",
                   arguments:="/Arguments",
                   secureModeByPass:=True)


Código (vbnet) [Seleccionar]
WinStartupUtil.Remove(UserType.CurrentUser, StartupType.Run, KeyBehavior.System32,
                      title:="Application Title",
                      throwOnMissingValue:=True)



Source:
Código (vbnet) [Seleccionar]
' ***********************************************************************
' Author   : Elektro
' Modified : 25-March-2015
' ***********************************************************************
' <copyright file="WinStartupUtil.vb" company="Elektro Studios">
'     Copyright (c) Elektro Studios. All rights reserved.
' </copyright>
' ***********************************************************************

#Region " Usage Examples "

'WinStartupUtil.Add(WinStartupUtil.UserType.CurrentUser,
'                   WinStartupUtil.StartupType.Run,
'                   WinStartupUtil.KeyBehavior.System32,
'                   title:="Application Title",
'                   filePath:="C:\Application.exe",
'                   secureModeByPass:=True)

'WinStartupUtil.Remove(WinStartupUtil.UserType.CurrentUser,
'                      WinStartupUtil.StartupType.Run,
'                      WinStartupUtil.KeyBehavior.System32,
'                      title:="Application Title",
'                      throwOnMissingValue:=True)

#End Region

#Region " Option Statements "

Option Explicit On
Option Strict On
Option Infer Off

#End Region

#Region " Imports "

Imports Microsoft.Win32

#End Region

#Region " WinStartupUtil "


''' <summary>
''' Adds or removes an application to Windows Startup.
''' </summary>
Public NotInheritable Class WinStartupUtil

#Region " Properties "

   ''' <summary>
   ''' Gets the 'Run' registry subkey path.
   ''' </summary>
   ''' <value>The 'Run' registry subkey path.</value>
   Public Shared ReadOnly Property RunSubKeyPath As String
       Get
           Return "Software\Microsoft\Windows\CurrentVersion\Run"
       End Get
   End Property

   ''' <summary>
   ''' Gets the 'Run' registry subkey path for x86 appications on x64 operating system.
   ''' </summary>
   ''' <value>The 'Run' registry subkey path for x86 appications on x64 operating system.</value>
   Public Shared ReadOnly Property RunSubKeyPathSysWow64 As String
       Get
           Return "Software\Wow6432Node\Microsoft\Windows\CurrentVersion\Run"
       End Get
   End Property

   ''' <summary>
   ''' Gets the 'RunOnce' registry subkey path.
   ''' </summary>
   ''' <value>The 'RunOnce' registry subkey path.</value>
   Public Shared ReadOnly Property RunOnceSubKeyPath As String
       Get
           Return "Software\Microsoft\Windows\CurrentVersion\RunOnce"
       End Get
   End Property

   ''' <summary>
   ''' Gets the 'RunOnce' registry subkey path for x86 appications on x64 operating system.
   ''' </summary>
   ''' <value>The 'RunOnce' registry subkey path for x86 appications on x64 operating system.</value>
   Public Shared ReadOnly Property RunOnceSubKeyPathSysWow64 As String
       Get
           Return "Software\Wow6432Node\Microsoft\Windows\CurrentVersion\RunOnce"
       End Get
   End Property

#End Region

#Region " Enumerations "

   ''' <summary>
   ''' Specifies an user type.
   ''' </summary>
   Public Enum UserType As Integer

       ''' <summary>
       ''' 'HKEY_CURRENT_USER' root key.
       ''' </summary>
       CurrentUser = &H1

       ''' <summary>
       ''' 'HKEY_LOCAL_MACHINE' root key.
       ''' </summary>
       AllUsers = &H2

   End Enum

   ''' <summary>
   ''' Specifies a Startup type.
   ''' </summary>
   Public Enum StartupType As Integer

       ''' <summary>
       ''' 'Run' registry subkey.
       ''' </summary>
       Run = &H1

       ''' <summary>
       ''' 'RunOnce' registry subkey.
       ''' </summary>
       RunOnce = &H2

   End Enum

   ''' <summary>
   ''' Specifies a registry key behavior.
   ''' </summary>
   Public Enum KeyBehavior As Integer

       ''' <summary>
       ''' System32 registry subkey.
       ''' </summary>
       System32 = &H1

       ''' <summary>
       ''' SysWow64 registry subkey.
       ''' </summary>
       SysWow64 = &H2

   End Enum

#End Region

#Region " Public Methods "

   ''' <summary>
   ''' Adds an application to Windows Startup.
   ''' </summary>
   ''' <param name="userType">The type of user.</param>
   ''' <param name="startupType">The type of startup.</param>
   ''' <param name="keyBehavior">The registry key behavior.</param>
   ''' <param name="title">The registry value title.</param>
   ''' <param name="filePath">The application file path.</param>
   ''' <param name="secureModeByPass">
   ''' If set to <c>true</c>, the file is ran even when the user logs into 'Secure Mode' on Windows.
   ''' </param>
   ''' <exception cref="System.ArgumentNullException">title or filePath</exception>
   Public Shared Sub Add(ByVal userType As UserType,
                         ByVal startupType As StartupType,
                         ByVal keyBehavior As KeyBehavior,
                         ByVal title As String,
                         ByVal filePath As String,
                         Optional ByVal arguments As String = "",
                         Optional secureModeByPass As Boolean = False)

       If String.IsNullOrEmpty(title) Then
           Throw New ArgumentNullException("title")

       ElseIf String.IsNullOrEmpty(filePath) Then
           Throw New ArgumentNullException("filePath")

       Else
           If secureModeByPass Then
               title = title.Insert(0, "*")
           End If

           Dim regKey As RegistryKey = Nothing
           Try
               regKey = GetRootKey(userType).OpenSubKey(GetSubKeyPath(startupType, keyBehavior), writable:=True)
               regKey.SetValue(title, String.Format("""{0}"" {1}", filePath, arguments), RegistryValueKind.String)

           Catch ex As Exception
               Throw

           Finally
               If regKey IsNot Nothing Then
                   regKey.Close()
               End If

           End Try

       End If

   End Sub

   ''' <summary>
   ''' Removes an application from Windows Startup.
   ''' </summary>
   ''' <param name="userType">The type of user.</param>
   ''' <param name="startupType">The type of startup.</param>
   ''' <param name="keyBehavior">The registry key behavior.</param>
   ''' <param name="title">The value name to find.</param>
   ''' <param name="throwOnMissingValue">if set to <c>true</c>, throws an exception on missing value.</param>
   ''' <exception cref="System.ArgumentNullException">title</exception>
   ''' <exception cref="System.ArgumentException">Registry value not found.;title</exception>
   Friend Shared Sub Remove(ByVal userType As UserType,
                            ByVal startupType As StartupType,
                            ByVal keyBehavior As KeyBehavior,
                            ByVal title As String,
                            Optional ByVal throwOnMissingValue As Boolean = False)

       If String.IsNullOrEmpty(title) Then
           Throw New ArgumentNullException("title")

       Else
           Dim valueName As String = String.Empty
           Dim regKey As RegistryKey = Nothing

           Try
               regKey = GetRootKey(userType).OpenSubKey(GetSubKeyPath(startupType, keyBehavior), writable:=True)

               If regKey.GetValue(title, defaultValue:=Nothing) IsNot Nothing Then
                   valueName = title

               ElseIf regKey.GetValue(title.Insert(0, "*"), defaultValue:=Nothing) IsNot Nothing Then
                   valueName = title.Insert(0, "*")

               Else
                   If throwOnMissingValue Then
                       Throw New ArgumentException("Registry value not found.", "title")
                   End If

               End If

               regKey.DeleteValue(valueName, throwOnMissingValue:=throwOnMissingValue)

           Catch ex As Exception
               Throw

           Finally
               If regKey IsNot Nothing Then
                   regKey.Close()
               End If

           End Try

       End If

   End Sub

#End Region

#Region " Private Methods "

   ''' <summary>
   ''' Gets a <see cref="RegistryKey"/> instance of the specified root key.
   ''' </summary>
   ''' <param name="userType">The type of user.</param>
   ''' <returns>A <see cref="RegistryKey"/> instance of the specified root key.</returns>
   ''' <exception cref="System.ArgumentException">Invalid enumeration value.;userType</exception>
   Private Shared Function GetRootKey(ByVal userType As UserType) As RegistryKey

       Select Case userType

           Case userType.CurrentUser
               Return Registry.CurrentUser

           Case userType.AllUsers
               Return Registry.LocalMachine

           Case Else
               Throw New ArgumentException("Invalid enumeration value.", "userType")

       End Select ' userType

   End Function

   ''' <summary>
   ''' Gets the proper registry subkey path from the parameters criteria.
   ''' </summary>
   ''' <param name="startupType">Type of the startup.</param>
   ''' <param name="keyBehavior">The key behavior.</param>
   ''' <returns>The registry subkey path.</returns>
   ''' <exception cref="System.ArgumentException">
   ''' Invalid enumeration value.;startupType or
   ''' Invalid enumeration value.;keyBehavior
   ''' </exception>
   Private Shared Function GetSubKeyPath(ByVal startupType As StartupType,
                                         ByVal keyBehavior As KeyBehavior) As String

       Select Case keyBehavior

           Case keyBehavior.System32

               Select Case startupType

                   Case startupType.Run
                       Return RunSubKeyPath

                   Case startupType.RunOnce
                       Return RunOnceSubKeyPath

                   Case Else
                       Throw New ArgumentException("Invalid enumeration value.", "startupType")

               End Select ' startupType

           Case keyBehavior.SysWow64

               Select Case startupType

                   Case startupType.Run
                       Return RunSubKeyPathSysWow64

                   Case startupType.RunOnce
                       Return RunOnceSubKeyPathSysWow64

                   Case Else
                       Throw New ArgumentException("Invalid enumeration value.", "startupType")

               End Select ' startupType

           Case Else
               Throw New ArgumentException("Invalid enumeration value.", "keyBehavior")

       End Select ' keyBehavior

   End Function

#End Region

End Class

#End Region








Eleкtro

#457
El siguiente snippet sirve para "redondear" una cantidad de bytes a la unidad de tamaño más apróximada, con soporte para precisión decimal y formato personalizado.

Ejemplo de uso:
Código (vbnet) [Seleccionar]
       For Each unit As RoundByteInfo.SizeUnit In [Enum].GetValues(GetType(RoundByteInfo.SizeUnit))

           Dim rByteInfo As New RoundByteInfo(unit)
            Dim stringFormat As String = String.Format("{0} Bytes rounded to {1} {2}.",
                                                       rByteInfo.ByteValue(CultureInfo.CurrentCulture.NumberFormat),
                                                       rByteInfo.RoundedValue(decimalPrecision:=2, numberFormatInfo:=Nothing),
                                                       rByteInfo.UnitLongName)

           Debug.WriteLine(stringFormat)

       Next unit


Output:
1 Bytes rounded to 1,00 Bytes.
1.024 Bytes rounded to 1,00 KiloBytes.
1.048.576 Bytes rounded to 1,00 MegaBytes.
1.073.741.824 Bytes rounded to 1,00 GigaBytes.
1.099.511.627.776 Bytes rounded to 1,00 TeraBytes.
1.125.899.906.842.620 Bytes rounded to 1,00 PetaBytes.


Source:
Código (vbnet) [Seleccionar]
' ***********************************************************************
' Author   : Elektro
' Modified : 07-April-2015
' ***********************************************************************
' <copyright file="RoundByteInfo.vb" company="Elektro Studios">
'     Copyright (c) Elektro Studios. All rights reserved.
' </copyright>
' ***********************************************************************

#Region " Usage Examples "

'For Each unit As RoundByteInfo.SizeUnit In [Enum].GetValues(GetType(RoundByteInfo.SizeUnit))
'
'    Dim rByteInfo As New RoundByteInfo(unit)
'    Dim stringFormat As String = String.Format("{0} Bytes rounded to {1} {2}.",
'                                               rByteInfo.ByteValue,
'                                               rByteInfo.RoundedValue(decimalPrecision:=2),
'                                               rByteInfo.UnitLongName)
'    Debug.WriteLine(stringFormat)
'
'Next unit

#End Region

#Region " Option Statements "

Option Explicit On
Option Strict On
Option Infer Off

#End Region

#Region " Imports "

Imports System.Globalization

#End Region

#Region " RoundByteInfo "

''' <summary>
''' Rounds the specified byte value to its most approximated size unit.
''' </summary>
Public NotInheritable Class RoundByteInfo

#Region " Properties "

   ''' <summary>
   ''' Gets the byte value.
   ''' </summary>
   ''' <value>The byte value.</value>
   Public ReadOnly Property ByteValue As Double
       Get
           Return Me.byteValue1
       End Get
   End Property

   ''' <summary>
   ''' Gets the byte value.
   ''' </summary>
   ''' <param name="numberFormatInfo">A custom <see cref="NumberFormatInfo"/> format provider.</param>
   ''' <value>The byte value.</value>
   Public ReadOnly Property ByteValue(ByVal numberFormatInfo As NumberFormatInfo) As String
       Get
           If numberFormatInfo Is Nothing Then
               numberFormatInfo = CultureInfo.CurrentCulture.NumberFormat
           End If
           Return Me.byteValue1.ToString("N0", numberFormatInfo)
       End Get
   End Property

   ''' <summary>
   ''' Gets the rounded byte value.
   ''' </summary>
   ''' <value>The rounded byte value.</value>
   Public ReadOnly Property RoundedValue As Double
       Get
           Return Me.roundedValue1
       End Get
   End Property

   ''' <summary>
   ''' Gets the rounded value with the specified decimal precision.
   ''' </summary>
   ''' <param name="decimalPrecision">The numeric decimal precision.</param>
   ''' <param name="numberFormatInfo">A custom <see cref="NumberFormatInfo"/> format provider.</param>
   ''' <value>The rounded value with the specified decimal precision.</value>
   Public ReadOnly Property RoundedValue(ByVal decimalPrecision As Integer,
                                         Optional ByVal numberFormatInfo As NumberFormatInfo = Nothing) As String
       Get
           If numberFormatInfo Is Nothing Then
               numberFormatInfo = CultureInfo.CurrentCulture.NumberFormat
           End If
           Return Me.roundedValue1.ToString("N" & decimalPrecision, numberFormatInfo)
       End Get
   End Property

   ''' <summary>
   ''' Gets the rounded <see cref="SizeUnit"/>.
   ''' </summary>
   ''' <value>The rounded <see cref="SizeUnit"/>.</value>
   Public ReadOnly Property Unit As SizeUnit
       Get
           Return Me.unit1
       End Get
   End Property

   ''' <summary>
   ''' Gets the rounded <see cref="SizeUnit"/> short name.
   ''' </summary>
   ''' <value>The rounded <see cref="SizeUnit"/> short name.</value>
   Public ReadOnly Property UnitShortName As String
       Get
           Return Me.unitShortName1
       End Get
   End Property

   ''' <summary>
   ''' Gets the rounded <see cref="SizeUnit"/> long name.
   ''' </summary>
   ''' <value>The rounded <see cref="SizeUnit"/> long name.</value>
   Public ReadOnly Property UnitLongName As String
       Get
           Return Me.unitLongName1
       End Get
   End Property

   ''' <summary>
   ''' The byte value.
   ''' </summary>
   Private byteValue1 As Double

   ''' <summary>
   ''' The rounded value.
   ''' </summary>
   Private roundedValue1 As Double

   ''' <summary>
   ''' The rounded <see cref="SizeUnit"/>.
   ''' </summary>
   Private unit1 As SizeUnit

   ''' <summary>
   ''' The rounded <see cref="SizeUnit"/> short name.
   ''' </summary>
   Private unitShortName1 As String

   ''' <summary>
   ''' The rounded <see cref="SizeUnit"/> long name.
   ''' </summary>
   Private unitLongName1 As String

#End Region

#Region " Enumerations "

   ''' <summary>
   ''' Specifies a size unit.
   ''' </summary>
   Public Enum SizeUnit As Long

       ''' <summary>
       ''' 1 Byte (or 8 bits).
       ''' </summary>
       [Byte] = 1L

       ''' <summary>
       ''' Byte-length of 1 KiloByte.
       ''' </summary>
       KiloByte = [Byte] * 1024L

       ''' <summary>
       ''' Byte-length of 1 MegaByte.
       ''' </summary>
       MegaByte = KiloByte * KiloByte

       ''' <summary>
       ''' Byte-length of 1 GigaByte.
       ''' </summary>
       GigaByte = KiloByte * MegaByte

       ''' <summary>
       ''' Byte-length of 1 TeraByte.
       ''' </summary>
       TeraByte = KiloByte * GigaByte

       ''' <summary>
       ''' Byte-length of 1 PetaByte.
       ''' </summary>
       PetaByte = KiloByte * TeraByte

   End Enum

#End Region

#Region " Constructors "

   ''' <summary>
   ''' Initializes a new instance of the <see cref="RoundByteInfo"/> class.
   ''' </summary>
   ''' <param name="bytes">The byte value.</param>
   ''' <exception cref="System.ArgumentException">Value should be greater than 0.;bytes</exception>
   Public Sub New(ByVal bytes As Double)

       If bytes <= 0L Then
           Throw New ArgumentException("Value should be greater than 0.", "bytes")
       Else
           Me.SetRoundByte(bytes)

       End If

   End Sub

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

#End Region

#Region " Private Methods "

   ''' <summary>
   ''' Rounds the specified byte value to its most approximated <see cref="SizeUnit"/>.
   ''' </summary>
   ''' <param name="bytes">The byte value.</param>
   Private Sub SetRoundByte(ByVal bytes As Double)

       Me.byteValue1 = bytes

       Select Case bytes

           Case Is >= SizeUnit.PetaByte
               Me.roundedValue1 = bytes / SizeUnit.PetaByte
               Me.unit1 = SizeUnit.PetaByte
               Me.unitShortName1 = "PB"
               Me.unitLongName1 = "PetaBytes"

           Case Is >= SizeUnit.TeraByte
               Me.roundedValue1 = bytes / SizeUnit.TeraByte
               Me.unit1 = SizeUnit.TeraByte
               Me.unitShortName1 = "TB"
               Me.unitLongName1 = "TeraBytes"

           Case Is >= SizeUnit.GigaByte
               Me.roundedValue1 = bytes / SizeUnit.GigaByte
               Me.unit1 = SizeUnit.GigaByte
               Me.unitShortName1 = "GB"
               Me.unitLongName1 = "GigaBytes"

           Case Is >= SizeUnit.MegaByte
               Me.roundedValue1 = bytes / SizeUnit.MegaByte
               Me.unit1 = SizeUnit.MegaByte
               Me.unitShortName1 = "MB"
               Me.unitLongName1 = "MegaBytes"

           Case Is >= SizeUnit.KiloByte
               Me.roundedValue1 = bytes / SizeUnit.KiloByte
               Me.unit1 = SizeUnit.KiloByte
               Me.unitShortName1 = "KB"
               Me.unitLongName1 = "KiloBytes"

           Case Is >= SizeUnit.Byte, Is <= 0
               Me.roundedValue1 = bytes / SizeUnit.Byte
               Me.unit1 = SizeUnit.Byte
               Me.unitShortName1 = "Bytes"
               Me.unitLongName1 = "Bytes"

       End Select

   End Sub

#End Region

End Class

#End Region








Eleкtro

#458
Una simple función que publiqué en S.O para cifrar/descifrar un String mediante la técnica de Caesar.

Ejemplo de uso:
Código (vbnet) [Seleccionar]
       Dim value As String = "Hello World!"

       Dim encrypted As String = CaesarEncrypt(value, shift:=15)
       Dim decrypted As String = CaesarDecrypt(encrypted, shift:=15)

       Debug.WriteLine(String.Format("Unmodified string: {0}", value))
       Debug.WriteLine(String.Format("Encrypted  string: {0}", encrypted))
       Debug.WriteLine(String.Format("Decrypted  string: {0}", decrypted))


Source:
Código (vbnet) [Seleccionar]
   ''' <summary>
   ''' Encrypts a string using Caesar's substitution technique.
   ''' </summary>
   ''' <remarks> http://en.wikipedia.org/wiki/Caesar_cipher </remarks>
   ''' <param name="text">The text to encrypt.</param>
   ''' <param name="shift">The character shifting.</param>
   ''' <param name="charSet">A set of character to use in encoding.</param>
   ''' <returns>The encrypted string.</returns>
   Public Shared Function CaesarEncrypt(ByVal text As String,
                                        ByVal shift As Integer,
                                        Optional ByVal charSet As String =
                                                       "abcdefghijklmnopqrstuvwxyz" &
                                                       "ABCDEFGHIJKLMNOPQRSTUVWXYZ" &
                                                       "0123456789" &
                                                       "çñáéíóúàèìòùäëïöü" &
                                                       "ÇÑÁÉÍÓÚÀÈÌÒÙÄËÏÖÜ" &
                                                       " ,;.:-_´¨{`^[+*]ºª\!|""#$~%€&¬/()=?¿'¡}*") As String

       Dim sb As New System.Text.StringBuilder With {.Capacity = text.Length}

       For Each c As Char In text

           Dim charIndex As Integer = charSet.IndexOf(c)

           If charIndex = -1 Then
               Throw New ArgumentException(String.Format("Character '{0}' not found in character set '{1}'.", c, charSet), "charSet")

           Else
               Do Until (charIndex + shift) < (charSet.Length)
                   charIndex -= charSet.Length
               Loop

               sb.Append(charSet(charIndex + shift))

           End If

       Next c

       Return sb.ToString

   End Function

   ''' <summary>
   ''' Decrypts a string using Caesar's substitution technique.
   ''' </summary>
   ''' <remarks> http://en.wikipedia.org/wiki/Caesar_cipher </remarks>
   ''' <param name="text">The encrypted text to decrypt.</param>
   ''' <param name="shift">The character shifting to reverse the encryption.</param>
   ''' <param name="charSet">A set of character to use in decoding.</param>
   ''' <returns>The decrypted string.</returns>
   Public Shared Function CaesarDecrypt(ByVal text As String,
                                        ByVal shift As Integer,
                                        Optional ByVal charSet As String =
                                                       "abcdefghijklmnopqrstuvwxyz" &
                                                       "ABCDEFGHIJKLMNOPQRSTUVWXYZ" &
                                                       "0123456789" &
                                                       "çñáéíóúàèìòùäëïöü" &
                                                       "ÇÑÁÉÍÓÚÀÈÌÒÙÄËÏÖÜ" &
                                                       " ,;.:-_´¨{`^[+*]ºª\!|""#$~%€&¬/()=?¿'¡}*") As String

       Return CaesarEncrypt(text, shift, String.Join("", charSet.Reverse))

   End Function








Eleкtro

Transformar una imagen a blanco y negro:

Código (vbnet) [Seleccionar]
    ''' <summary>
    ''' Transforms an image to black and white.
    ''' </summary>
    ''' <param name="img">The image.</param>
    ''' <returns>The black and white image.</returns>
    Public Shared Function GetBlackAndWhiteImage(ByVal img As Image) As Image

        Dim bmp As Bitmap = New Bitmap(img.Width, img.Height)

        Dim grayMatrix As New System.Drawing.Imaging.ColorMatrix(
            {
                New Single() {0.299F, 0.299F, 0.299F, 0, 0},
                New Single() {0.587F, 0.587F, 0.587F, 0, 0},
                New Single() {0.114F, 0.114F, 0.114F, 0, 0},
                New Single() {0, 0, 0, 1, 0},
                New Single() {0, 0, 0, 0, 1}
            })

        Using g As Graphics = Graphics.FromImage(bmp)

            Using ia As System.Drawing.Imaging.ImageAttributes = New System.Drawing.Imaging.ImageAttributes()

                ia.SetColorMatrix(grayMatrix)
                ia.SetThreshold(0.5)

                g.DrawImage(img, New Rectangle(0, 0, img.Width, img.Height), 0, 0, img.Width, img.Height,
                                                 GraphicsUnit.Pixel, ia)

            End Using

        End Using

        Return bmp

    End Function