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

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

0 Miembros y 1 Visitante están viendo este tema.

Eleкtro

· Convierte entero a caracter

Código (vbnet) [Seleccionar]
#Region " Byte To Char "

    ' [ Byte To Char Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(Byte_To_Char(97)) ' Result: a

    Private Function Byte_To_Char(ByVal int As Int32) As String
        Return Convert.ToChar(int)
    End Function

#End Region





· Convierte caracter a entero

Código (vbnet) [Seleccionar]
#Region " Char To Byte "

    ' [ Char To Byte Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(Char_To_Byte("a")) ' Result: 97
    ' Dim MyChar As String = "a" : MsgBox(Chr(Char_To_Byte(MyChar))) ' Result: a    ( ...xD )

    Private Function Char_To_Byte(ByVal str As String) As Int32
        Dim character As Char = str & "c"
        Return Convert.ToByte(character)
    End Function

#End Region





· Obtiene el SHA1 de un string

Código (vbnet) [Seleccionar]
#Region " Get SHA1 Of String "

    ' [ Get SHA1 Of String Function ]
    '
    ' Examples :
    ' MsgBox(Get_SHA1_Of_String("Hello")) ' Result: D2EFCBBA102ED3339947E85F4141EB08926E40E9

    Private Function Get_SHA1_Of_String(ByVal str As String) As String
        'create our SHA1 provider
        Dim sha As System.Security.Cryptography.SHA1 = New System.Security.Cryptography.SHA1CryptoServiceProvider()
        Dim hashedValue As String = String.Empty
        'hash the data
        Dim hashedData As Byte() = sha.ComputeHash(System.Text.Encoding.Unicode.GetBytes(str))

        'loop through each byte in the byte array
        For Each b As Byte In hashedData
            'convert each byte and append
            hashedValue += String.Format("{0,2:X2}", b)
        Next

        'return the hashed value
        Return hashedValue
    End Function

#End Region





· Obtiene el SHA1 de un archivo

Código (vbnet) [Seleccionar]
#Region " Get SHA1 Of File "

    ' [ Get SHA1 Of File Function ]
    '
    ' Examples :
    ' MsgBox(Get_SHA1_Of_File("C:\File.txt"))

    Private Function Get_SHA1_Of_File(ByVal File As String) As String
        Dim File_Stream As New System.IO.FileStream(File, IO.FileMode.Open)
        Dim sha As New System.Security.Cryptography.SHA1CryptoServiceProvider
        Dim hash As Array
        Dim shaHash As String
        Dim sb As New System.Text.StringBuilder

        sha.ComputeHash(File_Stream)
        hash = sha.Hash
        For Each hashByte As Byte In hash : sb.Append(String.Format("{0:X1}", hashByte)) : Next
        shaHash = sb.ToString
        File_Stream.Close()

        Return shaHash
    End Function

#End Region





· cifra un string en AES

Código (vbnet) [Seleccionar]
#Region " AES Encrypt "

    ' [ AES Encrypt Function ]
    '
    ' Examples :
    ' MsgBox(AES_Encrypt("Test_Text", "Test_Password")) ' Result: cv/vYwpl51/dxbxSMNSPSg==

    Public Function AES_Encrypt(ByVal input As String, ByVal pass As String) As String
        Dim AES As New System.Security.Cryptography.RijndaelManaged
        Dim Hash_AES As New System.Security.Cryptography.MD5CryptoServiceProvider
        Dim encrypted As String = ""
        Try
            Dim hash(31) As Byte
            Dim temp As Byte() = Hash_AES.ComputeHash(System.Text.ASCIIEncoding.ASCII.GetBytes(pass))
            Array.Copy(temp, 0, hash, 0, 16)
            Array.Copy(temp, 0, hash, 15, 16)
            AES.Key = hash
            AES.Mode = Security.Cryptography.CipherMode.ECB
            Dim DESEncrypter As System.Security.Cryptography.ICryptoTransform = AES.CreateEncryptor
            Dim Buffer As Byte() = System.Text.ASCIIEncoding.ASCII.GetBytes(input)
            encrypted = Convert.ToBase64String(DESEncrypter.TransformFinalBlock(Buffer, 0, Buffer.Length))
            Return encrypted
        Catch ex As Exception
            Return Nothing
        End Try
    End Function

#End Region





· descifra un string AES

Código (vbnet) [Seleccionar]
#Region " AES Decrypt "

    ' [ AES Decrypt Function ]
    '
    ' Examples :
    ' MsgBox(AES_Decrypt("cv/vYwpl51/dxbxSMNSPSg==", "Test_Password")) ' Result: Test_Text

    Public Function AES_Decrypt(ByVal input As String, ByVal pass As String) As String
        Dim AES As New System.Security.Cryptography.RijndaelManaged
        Dim Hash_AES As New System.Security.Cryptography.MD5CryptoServiceProvider
        Dim decrypted As String = ""
        Try
            Dim hash(31) As Byte
            Dim temp As Byte() = Hash_AES.ComputeHash(System.Text.ASCIIEncoding.ASCII.GetBytes(pass))
            Array.Copy(temp, 0, hash, 0, 16)
            Array.Copy(temp, 0, hash, 15, 16)
            AES.Key = hash
            AES.Mode = Security.Cryptography.CipherMode.ECB
            Dim DESDecrypter As System.Security.Cryptography.ICryptoTransform = AES.CreateDecryptor
            Dim Buffer As Byte() = Convert.FromBase64String(input)
            decrypted = System.Text.ASCIIEncoding.ASCII.GetString(DESDecrypter.TransformFinalBlock(Buffer, 0, Buffer.Length))
            Return decrypted
        Catch ex As Exception
            Return Nothing
        End Try
    End Function

#End Region





· Devuelve el código fuente de una URL

Código (vbnet) [Seleccionar]
#Region " Get URL SourceCode "

    ' [ Get URL SourceCode Function ]
    '
    ' Examples :
    ' MsgBox(Get_URL_SourceCode("http://www.el-hacker.com"))

    Function Get_URL_SourceCode(ByVal url As String) As String

        Dim sourcecode As String = String.Empty

        Try
            Dim request As System.Net.HttpWebRequest = System.Net.HttpWebRequest.Create(url)
            Dim response As System.Net.HttpWebResponse = request.GetResponse()
            Dim sr As System.IO.StreamReader = New System.IO.StreamReader(response.GetResponseStream())
            sourcecode = sr.ReadToEnd()
        Catch ex As Exception
            MsgBox(ex.Message)
        End Try

        Return sourcecode

    End Function

#End Region





· Intercambia entre el modo pantalla completa o modo normal.

Código (vbnet) [Seleccionar]
#Region " Toogle FullScreen "

    ' [ Toogle FullScreen ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' Toogle_FullScreen()

    Dim MyFormBorderStyle = Me.FormBorderStyle
    Dim MyWindowState = Me.WindowState
    Dim MyTopMost = Me.TopMost
    Dim IsFullscreened As Boolean

    Public Sub Toogle_FullScreen()
        If Not IsFullscreened Then
            IsFullscreened = True
            Me.FormBorderStyle = FormBorderStyle.None
            Me.WindowState = FormWindowState.Maximized
            Me.TopMost = True
        ElseIf IsFullscreened Then
            IsFullscreened = False
            Me.FormBorderStyle = MyFormBorderStyle
            Me.WindowState = MyWindowState
            Me.TopMost = MyTopMost
        End If
    End Sub

#End Region





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

Código (vbnet) [Seleccionar]
#Region " Get FrameWork Of File "

    ' [ Get FrameWork Of File Function ]
    '
    ' Examples :
    ' MsgBox(Get_FrameWork_Of_File("C:\My .Net Application.exe"))

    Private Function Get_FrameWork_Of_File(ByVal File As String) As String
        Try
            Dim FW As System.Reflection.Assembly = Reflection.Assembly.ReflectionOnlyLoadFrom(File)
            Return FW.ImageRuntimeVersion
        Catch ex As Exception
            Return Nothing ' Is not managed code
        End Try
    End Function

#End Region





· Devuelve positivo si el número es primo

Código (vbnet) [Seleccionar]
#Region " Number Is Prime? "

    ' [ Number Is Prime? Function ]
    '
    ' Examples :
    ' MsgBox(Number_Is_Prime(4)) ' Result: False

    Private Function Number_Is_Prime(ByVal Number As Long, Optional ByVal f As Integer = 2) As Boolean
        If Number = f Then Return True
        If Number Mod f = 0 Or Number = 1 Then Return False _
        Else Return Number_Is_Prime(Number, f + 1)
    End Function

#End Region





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

Código (vbnet) [Seleccionar]
#Region " Validate Windows FileName "

    ' [ Validate Windows FileName Function ]
    '
    ' Examples :
    ' MsgBox(Validate_Windows_FileName("C:\Test.txt")) ' Result: True
    ' MsgBox(Validate_Windows_FileName("C:\Te&st.txt")) ' Result: False

    Private Function Validate_Windows_FileName(ByRef FileName As String) As Boolean
        Dim Windows_Reserved_Chars As String = "\/:*?""<>|"

        For i As Integer = 0 To FileName.Length - 1
            If Windows_Reserved_Chars.Contains(FileName(i)) Then
                Return False ' FileName is not valid
            End If
        Next

        Return True ' FileName is valid
    End Function

#End Region





· cifra un string a Base64

Código (vbnet) [Seleccionar]
#Region " String To Base64 "

    ' [ String To Base64 Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(String_To_Base64("Test")) ' Result: VGVzdA==

    Private Function String_To_Base64(ByVal str As String) As String
        Return Convert.ToBase64String(System.Text.Encoding.UTF8.GetBytes(str))
    End Function

#End Region





· descifra un string Base64 a string

Código (vbnet) [Seleccionar]
#Region " Base64 To String "

    ' [ Base64 To String Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(Base64_To_String("VGVzdA==")) ' Result: Test

    Private Function Base64_To_String(ByVal str As String) As String
        Return System.Text.Encoding.ASCII.GetString(Convert.FromBase64String(str))
    End Function

#End Region









Eleкtro

· Devuelve la resolución de la pantalla primária o de la pantalla extendida

Código (vbnet) [Seleccionar]
#Region " Get Screen Resolution "

    ' [ Get Screen Resolution Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(Get_Screen_Resolution(False).ToString)
    ' MsgBox(Get_Screen_Resolution(True).ToString)
    ' Me.Size = Get_Screen_Resolution()

    Private Function Get_Screen_Resolution(ByVal Get_Extended_Screen_Resolution As Boolean) As Point

        If Not Get_Extended_Screen_Resolution Then
            Return New Point(My.Computer.Screen.Bounds.Width, My.Computer.Screen.Bounds.Height)
        Else
            Dim X As Integer, Y As Integer

            For Each screen As Screen In screen.AllScreens
                X += screen.Bounds.Width
                Y += screen.Bounds.Height
            Next

            Return New Point(X, Y)
        End If

    End Function

#End Region








Eleкtro

#72
· Enviar evento click del ratón.

Código (vbnet) [Seleccionar]
#Region " Mouse Click "

   ' [ Mouse Click ]
   '
   ' // By Elektro H@cker
   '
   ' Examples:
   ' Mouse_Click(MouseButton.Left)      ' Press the left click button
   ' Mouse_Click(MouseButton.Left_Down) ' Hold the left click button
   ' Mouse_Click(MouseButton.Left_Up)   ' Release the left click button

   Public Declare Sub Mouse_Event Lib "User32" Alias "mouse_event" (ByVal dwFlags As MouseButton, ByVal dx As Integer, ByVal dy As Integer, ByVal dwData As Integer, ByVal dwExtraInfo As Integer)

   Public Enum MouseButton As Int32

       Left_Down = &H2    ' Left button (hold)
       Left_Up = &H4      ' Left button (release)

       Right_Down = &H8   ' Right button (hold)
       Right_Up = &H10    ' Right button (release)

       Middle_Down = &H20 ' Middle button (hold)
       Middle_Up = &H40   ' Middle button (release)

       Left               ' Left   button (press)
       Right              ' Right  button (press)
       Middle             ' Middle button (press)

   End Enum

   Private Sub Mouse_Click(ByVal MouseButton As MouseButton)
       Select Case MouseButton
           Case MouseButton.Left : Mouse_Event(MouseButton.Left_Down, 0, 0, 0, 0) : Mouse_Event(MouseButton.Left_Up, 0, 0, 0, 0)
           Case MouseButton.Right : Mouse_Event(MouseButton.Right_Down, 0, 0, 0, 0) : Mouse_Event(MouseButton.Right_Up, 0, 0, 0, 0)
           Case MouseButton.Middle : Mouse_Event(MouseButton.Middle_Down, 0, 0, 0, 0) : Mouse_Event(MouseButton.Middle_Up, 0, 0, 0, 0)
           Case Else : Mouse_Event(MouseButton, 0, 0, 0, 0)
       End Select
   End Sub

#End Region







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

Código (vbnet) [Seleccionar]

#Region " Set Cursor Pos "

   ' [ Set Cursor Pos Function ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   ' Set_Cursor_Pos(500, 500)
   ' Set_Cursor_Pos(2500, 0, False)

   Private Sub Set_Cursor_Pos(ByVal X As Int32, ByVal Y As Int32, _
                                   Optional ByVal Enable_Extended_Screen As Boolean = True)

       If Not Enable_Extended_Screen Then
           Dim Screen_X = My.Computer.Screen.Bounds.Width
           Dim Screen_Y = My.Computer.Screen.Bounds.Height
           If X > Screen_X Then X = Screen_X
           If Y > Screen_Y Then Y = Screen_Y
       End If

       Cursor.Position = New System.Drawing.Point(X, Y)

   End Sub

#End Region







· Devuelve la posición del mouse en formato seleccionable

Código (vbnet) [Seleccionar]
#Region " Get Cursor Pos "

   Public Enum Cursor_Data
       AsText
       AsPoint
   End Enum

   ' [ Get Cursor Pos Function ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   ' MsgBox(Get_Cursor_Pos(Cursor_Data.AsText))
   ' MsgBox(Get_Cursor_Pos(Cursor_Data.AsPoint).ToString)

   Private Function Get_Cursor_Pos(ByVal Cursor_Data As Cursor_Data)
       Select Case Cursor_Data
           Case Cursor_Data.AsText : Return Cursor.Position.X & ", " & Cursor.Position.Y
           Case Cursor_Data.AsPoint : Return Cursor.Position
           Case Else : Return Nothing
       End Select
   End Function

#End Region





· Mueve el cursor

Código (vbnet) [Seleccionar]
#Region " Mouse Move "

   ' [ Mouse Move ]
   '
   ' // By Elektro H@cker
   '
   ' Examples:
   ' Mouse_Move(-50, 0) ' Move the cursor 50 pixels to left
   ' Mouse_Move(+50, 0) ' Move the cursor 50 pixels to right
   ' Mouse_Move(0, +50) ' Move the cursor 50 pixels to down
   ' Mouse_Move(0, -50) ' Move the cursor 50 pixels to up

   Public Enum MouseMove_Event As Int32
       Move = &H1
   End Enum

   Public Declare Sub Mouse_Event Lib "User32" Alias "mouse_event" (ByVal dwFlags As MouseMove_Event, ByVal dx As Integer, ByVal dy As Integer, ByVal dwData As Integer, ByVal dwExtraInfo As Integer)

   Private Sub Mouse_Move(ByVal X As Int32, ByVal Y As Int32)
       Mouse_Event(&H1, X, Y, 0, 0)
   End Sub

#End Region








Eleкtro

#73
· Descomprimir con la librería SevenzipSharp:

EDITO: Mejorado (Extracción con password)

Código (vbnet) [Seleccionar]
#Region " SevenZipSharp Extract "

   ' [ SevenZipSharp Extract Function ]
   '
   ' // By Elektro H@cker
   '
   ' Instructions :
   ' 1. Add a reference to "SevenZipSharp.dll".
   ' 2. Add the "7z.dll" or "7z64.dll" files to the project.
   ' 3. Use the code below.
   '
   ' Examples :
   ' SevenZipSharp_Extract("C:\File.7zip")                  ' Will be extracted in the same dir.
   ' SevenZipSharp_Extract("C:\File.7zip", "C:\Extracted\") ' Will be extracted in "C:\Extracted\".
   ' SevenZipSharp_Extract("C:\File.7zip", , "Password")    ' Will be extracted with the given password.

   Imports SevenZip
   Dim dll As String = "7z.dll"

   Private Function SevenZipSharp_Extract(ByVal InputFile As String, _
                                          Optional ByVal OutputDir As String = Nothing, _
                                          Optional ByVal Password As String = "Nothing") As Boolean

       Try
           ' Set library path
           SevenZipExtractor.SetLibraryPath(dll)

           ' Create extractor and specify the file to extract
           Dim Extractor As SevenZipExtractor = New SevenZipExtractor(InputFile, Password)

           ' Specify the output path where the files will be extracted
           If OutputDir Is Nothing Then OutputDir = My.Computer.FileSystem.GetFileInfo(InputFile).DirectoryName

           ' Add Progress Handler
           ' AddHandler Extractor.Extracting, AddressOf SevenZipSharp_Extract_Progress

           ' Check for password matches
           If Extractor.Check() Then
               ' Start the extraction
               Extractor.BeginExtractArchive(OutputDir)
           Else
               Return False ' Bad password
           End If

           Return True ' File extracted

           Extractor.Dispose()

       Catch ex As Exception
           'Return False ' File not extracted
           Throw New Exception(ex.Message)
       End Try

   End Function

   ' Public Sub SevenZipSharp_Extract_Progress(ByVal sender As Object, ByVal e As ProgressEventArgs)
   '     MsgBox("Percent extracted: " & e.PercentDone)
   ' End Sub

#End Region







· Comprimir con la librería SevenzipSharp:

EDITO: Mejorado (Compresión con password)

Código (vbnet) [Seleccionar]
#Region " SevenZipSharp Compress "

   ' [ SevenZipSharp Compress Function ]
   '
   ' // By Elektro H@cker
   '
   ' Instructions :
   ' 1. Add a reference to "SevenZipSharp.dll".
   ' 2. Add the "7z.dll" or "7z64.dll" files to the project.
   ' 3. Use the code below.
   '
   ' Examples :
   ' SevenZipSharp_Compress("C:\File.txt")                          ' File will be compressed in the same dir.
   ' SevenZipSharp_Compress("C:\File.txt", "C:\Compressed\File.7z") ' File will be compressed in "C:\Extracted\".
   ' SevenZipSharp_Compress("C:\Folder\", , , , , , "Password")     ' File will be compressed with the given password.
   ' SevenZipSharp_Compress("C:\File.txt", , OutArchiveFormat.Zip, , CompressionMethod.Lzma, CompressionLevel.Ultra)

   Imports SevenZip
   Dim dll As String = "7z.dll"

   Private Function SevenZipSharp_Compress(ByVal Input_DirOrFile As String, _
                                      Optional ByVal OutputFileName As String = Nothing, _
                                      Optional ByVal Format As OutArchiveFormat = OutArchiveFormat.SevenZip, _
                                      Optional ByVal CompressionMode As CompressionMode = CompressionMode.Create, _
                                      Optional ByVal CompressionMethod As CompressionMethod = CompressionMethod.Lzma, _
                                      Optional ByVal CompressionLevel As CompressionLevel = CompressionLevel.Normal, _
                                      Optional ByVal Password As String = Nothing) As Boolean
       Try
           ' Set library path
           SevenZipExtractor.SetLibraryPath(dll)

           ' Create compressor and specify the file or folder to compress
           Dim Compressor As SevenZipCompressor = New SevenZipCompressor()

           ' Set compression parameters
           Compressor.CompressionLevel = CompressionLevel ' Archiving compression level.
           Compressor.CompressionMethod = CompressionMethod ' Append files to compressed file or overwrite the compressed file.
           Compressor.ArchiveFormat = Format ' Compression file format
           Compressor.CompressionMode = CompressionMode ' Compression mode
           Compressor.DirectoryStructure = True ' Preserve the directory structure.
           Compressor.IncludeEmptyDirectories = True ' Include empty directories to archives.
           Compressor.ScanOnlyWritable = False ' Compress files only open for writing.
           Compressor.EncryptHeaders = False ' Encrypt 7-Zip archive headers
           Compressor.TempFolderPath = System.IO.Path.GetTempPath() ' Temporary folder path
           Compressor.FastCompression = False ' Compress as fast as possible, without calling events.
           Compressor.PreserveDirectoryRoot = True ' Preserve the directory root for CompressDirectory.
           Compressor.ZipEncryptionMethod = ZipEncryptionMethod.ZipCrypto ' Encryption method for zip archives.
           Compressor.DefaultItemName = "File.7z" ' Item name used when an item to be compressed has no name, for example, when you compress a MemoryStream instance

           ' Get File extension
           Dim CompressedFileExtension As String = Nothing
           Select Case Compressor.ArchiveFormat
               Case OutArchiveFormat.SevenZip : CompressedFileExtension = ".7z"
               Case OutArchiveFormat.BZip2 : CompressedFileExtension = ".bz"
               Case OutArchiveFormat.GZip : CompressedFileExtension = ".gzip"
               Case OutArchiveFormat.Tar : CompressedFileExtension = ".tar"
               Case OutArchiveFormat.XZ : CompressedFileExtension = ".xz"
               Case OutArchiveFormat.Zip : CompressedFileExtension = ".zip"
           End Select
         
           ' Add Progress Handler
           'AddHandler Compressor.Compressing, AddressOf SevenZipSharp_Compress_Progress

           ' Removes the end slash ("\") if given for a directory
           If Input_DirOrFile.EndsWith("\") Then Input_DirOrFile = Input_DirOrFile.Substring(0, Input_DirOrFile.Length - 1)

           ' Generate the OutputFileName if any is given.
           If OutputFileName Is Nothing Then _
               OutputFileName = (My.Computer.FileSystem.GetFileInfo(Input_DirOrFile).DirectoryName & "\" & (Input_DirOrFile.Split("\").Last) & CompressedFileExtension).Replace("\\", "\")
         
           ' Check if given argument is Dir or File ...then start the compression
           If IO.Directory.Exists(Input_DirOrFile) Then ' Is a Dir
               If Not Password Is Nothing Then
                   Compressor.CompressDirectory(Input_DirOrFile, OutputFileName, True, Password)
               Else
                   Compressor.CompressDirectory(Input_DirOrFile, OutputFileName, True)
               End If
           ElseIf IO.File.Exists(Input_DirOrFile) Then ' Is a File
               If Not Password Is Nothing Then
                   Compressor.CompressFilesEncrypted(OutputFileName, Password, Input_DirOrFile)
               Else
                   Compressor.CompressFiles(OutputFileName, Input_DirOrFile)
               End If
           End If

       Catch ex As Exception
           'Return False ' File not compressed
           Throw New Exception(ex.Message)
       End Try

       Return True ' File compressed

   End Function

   ' Public Sub SevenZipSharp_Compress_Progress(ByVal sender As Object, ByVal e As ProgressEventArgs)
   '     MsgBox("Percent compressed: " & e.PercentDone)
   ' End Sub

#End Region








Eleкtro

#74
· Devuelve información sobre archivos comprimidos (tamaño, nombre de los archivos internos, total de archivos internos..)

Código (vbnet) [Seleccionar]
#Region " SevenZipSharp FileInfo "

   ' [ SevenZipSharp FileInfo Function ]
   '
   ' // By Elektro H@cker
   '
   ' Instructions :
   ' 1. Add a reference to "SevenZipSharp.dll".
   ' 2. Add the "7z.dll" or "7z64.dll" files to the project.
   ' 3. Use the code below.
   '
   ' Examples :
   ' MsgBox(SevenZipSharp_FileInfo("C:\Test.7z", SevenZip_Info.Format))
   ' For Each FileName In SevenZipSharp_FileInfo("C:\Test.zip", SevenZip_Info.Internal_Files_FileNames) : MsgBox(FileName) : Next

   Imports SevenZip
   Dim dll As String = "7z.dll"

   Public Enum SevenZip_Info
       FileName
       Format
       Size_In_Bytes
       Internal_Files_FileNames
       Total_Internal_Files
   End Enum

   Private Function SevenZipSharp_FileInfo(ByVal InputFile As String, ByVal Info As SevenZip_Info)

       Try
           ' Set library path
           SevenZip.SevenZipExtractor.SetLibraryPath(dll)

           ' Create extractor and specify the file to extract
           Dim Extractor As SevenZip.SevenZipExtractor = New SevenZip.SevenZipExtractor(InputFile)

           ' Return info
           Select Case Info

               Case SevenZip_Info.FileName
                   Return Extractor.FileName

               Case SevenZip_Info.Format
                   Return Extractor.Format

               Case SevenZip_Info.Size_In_Bytes
                   Return Extractor.PackedSize

               Case SevenZip_Info.Total_Internal_Files
                   Return Extractor.FilesCount

               Case SevenZip_Info.Internal_Files_FileNames
                   Dim FileList As New List(Of String)
                   For Each Internal_File In Extractor.ArchiveFileData
                       FileList.Add(Internal_File.FileName)
                   Next
                   Return FileList

               Case Else
                   Return Nothing

           End Select

           Extractor.Dispose()

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

   End Function

#End Region








Eleкtro

Una función muy simple, elimina el último caracter de un string, puede ahorrar bastante escritura de código a veces...

Código (vbnet) [Seleccionar]
#Region " Remove Last Char "

    ' [ Remove Last Char Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(Remove_Last_Char("C:\Folder\"))
    ' Var = Remove_Last_Char(Var)

    Private Function Remove_Last_Char(ByVal str As String) As String
        Return str.Substring(0, str.Length - 1)
    End Function

#End Region








Eleкtro

· Convierte un string a LowerCase/Titlecase/UpperCase/WordCase

Código (vbnet) [Seleccionar]
#Region " String to Case "

    ' [ String to Case Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(String_To_Case("THiS is a TeST", StringCase.Titlecase))
    ' Var = String_To_WordCase(Var, StringCase.LowerCase)

    Public Enum StringCase
        LowerCase
        Titlecase
        UpperCase
        WordCase
    End Enum

    Private Function String_To_Case(ByVal str As String, ByVal StringCase As StringCase) As String
        Select Case StringCase
            Case Form1.StringCase.LowerCase : Return System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToLower(str)
            Case Form1.StringCase.Titlecase : Return Char.ToUpper(str(0)) + StrConv(str.Substring(1), VbStrConv.Lowercase)
            Case Form1.StringCase.UpperCase : Return System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToUpper(str)
            Case Form1.StringCase.WordCase : Return System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToTitleCase(str)
            Case Else : Return Nothing
        End Select
    End Function

#End Region








Eleкtro

La función de convertir un string a Case, mejorada y mucho más ampliada:

Código (vbnet) [Seleccionar]
#Region " String to Case "

   ' [ String to Case Function ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   ' MsgBox(String_To_Case("THiS is a TeST", StringCase.Titlecase))
   ' MsgBox(String_To_Case("THiS is a TeST", StringCase.DelimitedCase_Lower, ";"))
   ' Var = String_To_WordCase(Var, StringCase.LowerCase)

   Public Enum StringCase

       LowerCase
       UpperCase
       Titlecase
       WordCase

       CamelCase_First_Lower
       CamelCase_First_Upper

       MixedCase_First_Lower
       MixedCase_First_Upper
       MixedCase_Word_Lower
       MixedCase_Word_Upper

       DelimitedCase_Lower
       DelimitedCase_Mixed_Word_Lower
       DelimitedCase_Mixed_Word_Upper
       DelimitedCase_Title
       DelimitedCase_Upper
       DelimitedCase_Word

   End Enum

   Private Function String_To_Case(ByVal str As String, _
                                   ByVal StringCase As StringCase, _
                                   Optional ByVal Delimiter As String = "-") As String
       Select Case StringCase

           Case StringCase.LowerCase
               Return str.ToLower

           Case StringCase.UpperCase
               Return str.ToUpper

           Case StringCase.Titlecase
               Return Char.ToUpper(str(0)) + StrConv(str.Substring(1), VbStrConv.Lowercase)

           Case StringCase.WordCase
               Return System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToTitleCase(str)

           Case StringCase.CamelCase_First_Lower
               Return Char.ToLower(str(0)) & _
                   System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToTitleCase(str).Replace(" ", "").Substring(1)

           Case StringCase.CamelCase_First_Upper
               Return Char.ToUpper(str(0)) & _
                   System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToTitleCase(str).Replace(" ", "").Substring(1)

           Case StringCase.MixedCase_First_Lower
               Dim MixedString As String = Nothing
               For X As Integer = 0 To str.Length - 1
                   Dim c As Char = str(X)
                   If (X / 2).ToString.Contains(",") Then _
                        MixedString += c.ToString.ToUpper _
                   Else MixedString += c.ToString.ToLower
               Next
               Return MixedString

           Case StringCase.MixedCase_First_Upper
               Dim MixedString As String = Nothing
               For X As Integer = 0 To str.Length - 1
                   Dim c As Char = str(X)
                   If (X / 2).ToString.Contains(",") Then _
                        MixedString += c.ToString.ToLower _
                   Else MixedString += c.ToString.ToUpper
               Next
               Return MixedString

           Case StringCase.MixedCase_Word_Lower
               Dim MixedString As String = Nothing
               Dim Count As Integer = 1
               For X As Integer = 0 To str.Length - 1
                   Dim c As Char = str(X)
                   If Not c = " " Then Count += 1 Else Count = 1
                   If (Count / 2).ToString.Contains(",") Then _
                        MixedString += c.ToString.ToUpper _
                   Else MixedString += c.ToString.ToLower
               Next
               Return MixedString

           Case StringCase.MixedCase_Word_Upper
               Dim MixedString As String = Nothing
               Dim Count As Integer = 1
               For X As Integer = 0 To str.Length - 1
                   Dim c As Char = str(X)
                   If Not c = " " Then Count += 1 Else Count = 1
                   If (Count / 2).ToString.Contains(",") Then _
                        MixedString += c.ToString.ToLower _
                   Else MixedString += c.ToString.ToUpper
               Next
               Return MixedString

           Case StringCase.DelimitedCase_Lower
               Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
               Return rgx.Replace(str.ToLower, Delimiter)

           Case StringCase.DelimitedCase_Upper
               Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
               Return rgx.Replace(str.ToUpper, Delimiter)

           Case StringCase.DelimitedCase_Title
               Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
               Return rgx.Replace(Char.ToUpper(str(0)) + StrConv(str.Substring(1), VbStrConv.Lowercase), Delimiter)

           Case StringCase.DelimitedCase_Word
               Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
               Return rgx.Replace(System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToTitleCase(str), Delimiter)

           Case StringCase.DelimitedCase_Mixed_Word_Lower
               Dim MixedString As String = Nothing
               Dim Count As Integer = 1
               For X As Integer = 0 To str.Length - 1
                   Dim c As Char = str(X)
                   If Not c = " " Then Count += 1 Else Count = 1
                   If (Count / 2).ToString.Contains(",") Then _
                        MixedString += c.ToString.ToUpper _
                   Else MixedString += c.ToString.ToLower
               Next
               Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
               Return rgx.Replace(MixedString, Delimiter)

           Case StringCase.DelimitedCase_Mixed_Word_Upper
               Dim MixedString As String = Nothing
               Dim Count As Integer = 1
               For X As Integer = 0 To str.Length - 1
                   Dim c As Char = str(X)
                   If Not c = " " Then Count += 1 Else Count = 1
                   If (Count / 2).ToString.Contains(",") Then _
                        MixedString += c.ToString.ToLower _
                   Else MixedString += c.ToString.ToUpper
               Next
               Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
               Return rgx.Replace(MixedString, Delimiter)

           Case Else
               Return Nothing

       End Select

   End Function

#End Region








Eleкtro

· Un AppActivate distinto, en mi opinión mejor, se usa por el nombre del proceso, con posibilidad de seleccionar el proceso por el título de la ventana de dicho proceso:

Código (vbnet) [Seleccionar]
#Region " Activate APP "

    ' [ Activate APP Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' ActivateAPP("notepad.exe")
    ' ActivateAPP("notepad.exe", "Notepad Sub-Window Title")
    ' MsgBox(ActivateAPP("notepad"))

    Private Function ActivateAPP(ByVal ProcessName As String, _
                                 Optional ByVal WindowTitle As String = Nothing) As Boolean

        If ProcessName.ToLower.EndsWith(".exe") Then ProcessName = ProcessName.Substring(0, ProcessName.Length - 4)
        Dim ProcessTitle As String = Nothing
        Dim ProcessArray = Process.GetProcessesByName(ProcessName)

        If ProcessArray.Length = 0 Then : Return False ' ProcessName not found

        ElseIf ProcessArray.Length > 1 AndAlso Not WindowTitle Is Nothing Then
            For Each Title In ProcessArray
                If Title.MainWindowTitle.Contains(WindowTitle) Then _
                   ProcessTitle = Title.MainWindowTitle
            Next

        Else : ProcessTitle = ProcessArray(0).MainWindowTitle
        End If

        AppActivate(ProcessTitle)
        Return True ' Window activated

    End Function

#End Region






· Escribe texto en un Log

Código (vbnet) [Seleccionar]
#Region " Write Log "

    ' [ Write Log Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' WriteLog("Application started", InfoType.Information)
    ' WriteLog("Application got mad", InfoType.Critical)

    Dim LogFile = CurDir() & "\" & System.Reflection.Assembly.GetExecutingAssembly.GetName().Name & ".log"

    Public Enum InfoType
        Information
        Exception
        Critical
        None
    End Enum

    Private Function WriteLog(ByVal Message As String, ByVal InfoType As InfoType) As Boolean
        Dim LocalDate As String = My.Computer.Clock.LocalTime.ToString.Split(" ").First
        Dim LocalTime As String = My.Computer.Clock.LocalTime.ToString.Split(" ").Last
        Dim LogDate As String = "[ " & LocalDate & " ] " & " [ " & LocalTime & " ]  "
        Dim MessageType As String = Nothing

        Select Case InfoType
            Case InfoType.Information : MessageType = "Information: "
            Case InfoType.Exception : MessageType = "Error: "
            Case InfoType.Critical : MessageType = "Critical: "
            Case InfoType.None : MessageType = ""
        End Select

        Try
            My.Computer.FileSystem.WriteAllText(LogFile, vbNewLine & LogDate & MessageType & Message & vbNewLine, True)
            Return True
        Catch ex As Exception
            'Return False
            Throw New Exception(ex.Message)
        End Try

    End Function

#End Region







· Cierra un proceso (No lo mata)

Código (vbnet) [Seleccionar]
#Region " Close Process Function "

    ' [ Close Process Function ]
    '
    ' Examples :
    '
    ' Close_Process(Application.ExecutablePath)
    ' Close_Process("notepad.exe")
    ' Close_Process("notepad", False)

    Private Function Close_Process(ByRef Process_Name As String, _
                                   Optional ByVal OnlyFirstFound As Boolean = True) As Boolean

        If Process_Name.ToLower.EndsWith(".exe") Then Process_Name = Process_Name.Substring(0, Process_Name.Length - 4)
        Dim proc() As Process = Process.GetProcessesByName(Process_Name)

        If Not OnlyFirstFound Then
            For proc_num As Integer = 0 To proc.Length - 1
                Try : proc(proc_num).CloseMainWindow() _
                    : Catch : Return False : End Try ' One of the processes can't be closed
            Next
            Return True
        Else
            Try : proc(0).CloseMainWindow() : Return True ' Close message sent to the process
            Catch : Return False : End Try ' Can't close the process
        End If

        Return Nothing ' ProcessName not found

    End Function

#End Region







· Buscar coincidencias de texto usando expresiones regulares

Código (vbnet) [Seleccionar]
#Region " Find RegEx "

    ' [ Find RegEx Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' If Find_RegEx("abcdef", "^[A-Z]+$") Then MsgBox("Yes") Else MsgBox("No") ' Result: No
    ' If Find_RegEx("abcdef", "^[A-Z]+$", True) Then MsgBox("Yes") Else MsgBox("No") ' Result: Yes

    Private Function Find_RegEx(ByVal str As String, ByVal Pattern As String, _
                                 Optional ByVal Ignorecase As Boolean = False) As Boolean

        Dim RegExCase As System.Text.RegularExpressions.RegexOptions

        If Ignorecase Then _
             RegExCase = System.Text.RegularExpressions.RegexOptions.IgnoreCase _
        Else RegExCase = System.Text.RegularExpressions.RegexOptions.None

        Dim RegEx As New System.Text.RegularExpressions.Regex(Pattern, RegExCase)

        Return RegEx.IsMatch(str)

    End Function

#End Region







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

Código (vbnet) [Seleccionar]
#Region " Read TextFile Libe By Line "

    ' [ Read TextFile Libe By Line ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' Read_TextFile_Libe_By_Line("C:\Test.txt")
    ' Read_TextFile_Libe_By_Line("C:\Test.txt", True)

    Private Sub Read_TextFile_Libe_By_Line(ByVal TextFile As String, _
                                           Optional ByVal Read_Blank_Lines As Boolean = False)
        Dim Line As String = Nothing
        Dim Text As IO.StreamReader = IO.File.OpenText(TextFile)
        Dim RegEx As New System.Text.RegularExpressions.Regex("^\s+$")

        Do Until Text.EndOfStream

            Line = Text.ReadLine()

            If (Not Read_Blank_Lines _
                AndAlso _
               (Not Line = "" _
                And Not RegEx.IsMatch(Line))) _
                OrElse Read_Blank_Lines Then
                ' Do things here...
                MsgBox(Line)
            End If

        Loop

        Text.Close() : Text.Dispose()

    End Sub

#End Region








Eleкtro

· Devuelve el valor de un nombre de un Enum

Código (vbnet) [Seleccionar]
#Region " Get Enum Value "

    ' [ Get Enum Value Function ]
    '
    ' Examples :
    ' MsgBox(Get_Enum_Value(DayOfWeek.Sunday)) ' Result: 0
    ' MsgBox(Get_Enum_Value(DayOfWeek.Monday)) ' Result: 1

    Function Get_Enum_Value(Of T)(Byval ValueName As T) As Int32
        Return Convert.ToInt32(ValueName)
    End Function

#End Region






· Devuelve el nombre de un valor de un Enum

Código (vbnet) [Seleccionar]

#Region " Get Enum Name "

    ' [ Get Enum ValueName Function ]
    '
    ' Examples :
    ' MsgBox(Get_Enum_Name(Of DayOfWeek)(0)) ' Result: Sunday
    ' MsgBox(Get_Enum_Name(Of DayOfWeek)(1)) ' Result: Monday

    Private Function Get_Enum_Name(Of T)(EnumValue As Integer) As String
        Return [Enum].GetName(GetType(T), EnumValue)
    End Function

#End Region







· Comparar dos archivos:

Código (vbnet) [Seleccionar]
#Region " Compare Files "

    ' [ Compare Files Function ]
    '
    ' Examples :
    ' MsgBox(Compare_Files("C:\File1.txt", "C:\File2.txt"))

    Private Function Compare_Files(ByVal File1 As String, ByVal File2 As String) As Boolean

        ' Set to true if the files are equal; false otherwise
        Dim FilesAreEqual As Boolean = False

        With My.Computer.FileSystem

            ' Ensure that the files are the same length before comparing them line by line.
            If .GetFileInfo(File1).Length = .GetFileInfo(File2).Length Then
                Using file1Reader As New FileStream(File1, FileMode.Open), _
                      file2Reader As New FileStream(File2, FileMode.Open)
                    Dim byte1 As Integer = file1Reader.ReadByte()
                    Dim byte2 As Integer = file2Reader.ReadByte()

                    ' If byte1 or byte2 is a negative value, we have reached the end of the file.
                    While byte1 >= 0 AndAlso byte2 >= 0
                        If (byte1 <> byte2) Then
                            FilesAreEqual = False
                            Exit While
                        Else
                            FilesAreEqual = True
                        End If

                        ' Read the next byte.
                        byte1 = file1Reader.ReadByte()
                        byte2 = file2Reader.ReadByte()
                    End While

                End Using
            End If
        End With

        Return FilesAreEqual
    End Function

#End Region