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.