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

[Eleкtro]

Crear hotkeys globales fuera del form, usando ComboBoxes.

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

Código (vbnet) [Seleccionar] Expandir

#Region " Set Global Hotkeys using ComboBoxes "

   ' [ Set Global Hotkeys using ComboBoxes Example ]
   '
   ' // By Elektro H@cker
   '
   ' Instructions :
   ' Instructions:
   ' 1. Add the "GlobalHotkeys Class" Class to the project.
   ' 2. Add a ComboBox in the Form with the name "ComboBox_SpecialKeys", with DropDownStyle property.
   ' 3. Add a ComboBox in the Form with the name "ComboBox_NormalKeys", with DropDownStyle property.

   Dim SpecialKeys As String() = {"NONE", "ALT", "CTRL", "SHIFT"}

   Dim NormalKeys As String() = { _
   "A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", _
   "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z", _
   "0", "1", "2", "3", "4", "5", "6", "7", "8", "9", _
   "F1", "F2", "F3", "F4", "F5", "F6", "F7", "F8", "F9", "F10", "F11", "F12"}

   Dim SpecialKey As String = SpecialKeys(0)
   Dim NormalKey As System.Windows.Forms.Keys
   Dim WithEvents HotKey_Global As Shortcut

   ' Form load
   Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load

       For Each Item In SpecialKeys
           ComboBox_SpecialKeys.Items.Add(Item)
           Application.DoEvents()
       Next

       For Each Item In NormalKeys
           ComboBox_NormalKeys.Items.Add(Item)
           Application.DoEvents()
       Next

       ComboBox_SpecialKeys.SelectedItem = SpecialKeys(0)
       ' ComboBox_NormalKeys.SelectedItem = NormalKeys(0)

   End Sub

   ' ComboBoxes SelectedKeys
   Private Sub ComboBoxes_SelectedIndexChanged(sender As Object, e As EventArgs) Handles _
       ComboBox_SpecialKeys.SelectedIndexChanged, _
       ComboBox_NormalKeys.SelectedIndexChanged

       SpecialKey = ComboBox_SpecialKeys.Text

       Try : Select Case ComboBox_SpecialKeys.Text
               Case "ALT"
                   NormalKey = [Enum].Parse(GetType(System.Windows.Forms.Keys), ComboBox_NormalKeys.Text, True)
                   HotKey_Global = Shortcut.Create(Shortcut.Modifier.Alt, NormalKey)
               Case "CTRL"
                   NormalKey = [Enum].Parse(GetType(System.Windows.Forms.Keys), ComboBox_NormalKeys.Text, True)
                   HotKey_Global = Shortcut.Create(Shortcut.Modifier.Ctrl, NormalKey)
               Case "SHIFT"
                   NormalKey = [Enum].Parse(GetType(System.Windows.Forms.Keys), ComboBox_NormalKeys.Text, True)
                   HotKey_Global = Shortcut.Create(Shortcut.Modifier.Shift, NormalKey)
               Case "NONE"
                   Dim Number_RegEx As New System.Text.RegularExpressions.Regex("\D")
                   If Number_RegEx.IsMatch(ComboBox_NormalKeys.Text) Then
                       NormalKey = [Enum].Parse(GetType(System.Windows.Forms.Keys), ComboBox_NormalKeys.Text, True)
                   Else
                       NormalKey = [Enum].Parse(GetType(System.Windows.Forms.Keys), (ComboBox_NormalKeys.Text + 96), False)
                   End If
                   HotKey_Global = Shortcut.Create(Shortcut.Modifier.None, NormalKey)

           End Select
       Catch : End Try

   End Sub

   ' Hotkey is pressed
   Private Sub HotKey_Press(ByVal s As Object, ByVal e As Shortcut.HotKeyEventArgs) Handles HotKey_Global.Press
       MsgBox("hotkey clicked: " & SpecialKey & "+" & NormalKey.ToString)
   End Sub

#End Region

#Region " GlobalHotkeys Class "

   Class Shortcut

       Inherits NativeWindow
       Implements IDisposable

       Protected Declare Function UnregisterHotKey Lib "user32.dll" (ByVal handle As IntPtr, ByVal id As Integer) As Boolean
       Protected Declare Function RegisterHotKey Lib "user32.dll" (ByVal handle As IntPtr, ByVal id As Integer, ByVal modifier As Integer, ByVal vk As Integer) As Boolean

       Event Press(ByVal sender As Object, ByVal e As HotKeyEventArgs)
       Protected EventArgs As HotKeyEventArgs, ID As Integer

       Enum Modifier As Integer
           None = 0
           Alt = 1
           Ctrl = 2
           Shift = 4
       End Enum

       Class HotKeyEventArgs

           Inherits EventArgs
           Property Modifier As Shortcut.Modifier
           Property Key As Keys

       End Class

       Class RegisteredException

           Inherits Exception
           Protected Const s As String = "Shortcut combination is in use."

           Sub New()
               MyBase.New(s)
           End Sub

       End Class

       Private disposed As Boolean

       Protected Overridable Sub Dispose(ByVal disposing As Boolean)
           If Not disposed Then UnregisterHotKey(Handle, ID)
           disposed = True
       End Sub

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

       Sub Dispose() Implements IDisposable.Dispose
           Dispose(True)
           GC.SuppressFinalize(Me)
       End Sub

       <DebuggerStepperBoundary()>
       Sub New(ByVal modifier As Modifier, ByVal key As Keys)
           CreateHandle(New CreateParams)
           ID = GetHashCode()
           EventArgs = New HotKeyEventArgs With {.Key = key, .Modifier = modifier}
           If Not RegisterHotKey(Handle, ID, modifier, key) Then Throw New RegisteredException
       End Sub

       Shared Function Create(ByVal modifier As Modifier, ByVal key As Keys) As Shortcut
           Return New Shortcut(modifier, key)
       End Function

       Protected Sub New()
       End Sub

       Protected Overrides Sub WndProc(ByRef m As Message)
           Select Case m.Msg
               Case 786
                   RaiseEvent Press(Me, EventArgs)
               Case Else
                   MyBase.WndProc(m)
           End Select
       End Sub

   End Class

#End Region

[Eleкtro]

Detectar que botón del mouse se ha pinchado:

Código (vbnet) [Seleccionar] Expandir

    Private Sub Form1_MouseClick(sender As Object, e As MouseEventArgs) Handles MyBase.MouseClick
        Select Case e.Button().ToString.ToLower
            Case "left" ' Left mouse clicked
                MsgBox("Left mouse clicked")
            Case "right" ' Right mouse clicked
                MsgBox("Right mouse clicked")
            Case "middle" ' Middle mouse clicked
                MsgBox("Middle mouse clicked")
        End Select
    End Sub





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

Código (vbnet) [Seleccionar] Expandir

    ' Set opacity when moving the form from the TitleBar
    Protected Overrides Sub DefWndProc(ByRef message As System.Windows.Forms.Message)
        ' -- Trap left mouse click down on titlebar
        If CLng(message.Msg) = &HA1 Then
            If Me.Opacity <> 0.5 Then Me.Opacity = 0.5
            ' -- Trap left mouse click up on titlebar
        ElseIf CLng(message.Msg) = &HA0 Then
            If Me.Opacity <> 1.0 Then Me.Opacity = 1.0
        End If
        MyBase.DefWndProc(message)
    End Sub




Convertir "&H" a entero:

Código (vbnet) [Seleccionar] Expandir


#Region " Win32Hex To Int "

    ' [ Win32Hex To Int Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples:
    ' MsgBox(Win32Hex_To_Int(&H2S))  ' Result: 2
    ' MsgBox(Win32Hex_To_Int(&HFF4)) ' 4084

    Private Function Win32Hex_To_Int(ByVal Win32Int As Int32) As Int32
        Return CInt(Win32Int)
    End Function

#End Region





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

Código (vbnet) [Seleccionar] Expandir

#Region " Get SID UserName "

    ' [ Get SID UserName ]
    '
    ' Examples:
    ' MsgBox(Get_SID_UserName("S-1-5-21-148789306-3749789949-2179752015-500")) ' Result: UserName
    ' MsgBox(Get_SID_UserName("S-1-5-21-148789306-3749789949-2179752015-500")) ' Result: DomainName\UserName

    Private Declare Unicode Function ConvertStringSidToSidW Lib "advapi32.dll" (ByVal StringSID As String, ByRef SID As IntPtr) As Boolean
    Private Declare Unicode Function LookupAccountSidW Lib "advapi32.dll" (ByVal lpSystemName As String, ByVal SID As IntPtr, ByVal Name As System.Text.StringBuilder, ByRef cbName As Long, ByVal DomainName As System.Text.StringBuilder, ByRef cbDomainName As Long, ByRef psUse As Integer) As Boolean

    Shared Function Get_SID_UserName(ByVal SID As String, Optional ByVal Get_Domain_Name As Boolean = False) As String

        Const size As Integer = 255
        Dim domainName As String
        Dim userName As String
        Dim cbUserName As Long = size
        Dim cbDomainName As Long = size
        Dim ptrSID As New IntPtr(0)
        Dim psUse As Integer = 0
        Dim bufName As New System.Text.StringBuilder(size)
        Dim bufDomain As New System.Text.StringBuilder(size)

        If ConvertStringSidToSidW(SID, ptrSID) Then
            If LookupAccountSidW(String.Empty, _
            ptrSID, bufName, _
            cbUserName, bufDomain, _
            cbDomainName, psUse) Then
                userName = bufName.ToString
                domainName = bufDomain.ToString
                If Get_Domain_Name Then
                    Return String.Format("{0}\{1}", domainName, userName)
                Else
                    Return userName
                End If
            Else
                Return ""
            End If
        Else
            Return ""
        End If

    End Function

#End Region





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

Código (vbnet) [Seleccionar] Expandir

#Region " Reg Copy Key "

    ' [ Reg Copy Key Function ]
    '
    ' // By Elektro H@cker
    '
    ' Reg_Copy_Key("HKCU", "Software", "7-Zip", "HKLM", "Software", "7-zip")  ' Copies "HKCU\Software\7-Zip" to "HKLM\Software\7-Zip"
    ' Reg_Copy_Key("HKCU", "Software", "7-Zip", Nothing, "Software", "7-zip") ' Copies "HKCU\Software\7-Zip" to "HKCU\Software\7-Zip"
    ' Reg_Copy_Key("HKCU", "Software", "7-Zip", "HKLM", "Software", Nothing)  ' Copies "HKCU\Software\7-Zip" to "HKLM\Software\"
    ' Reg_Copy_Key("HKCU", "Software", "7-Zip", "HKLM", Nothing, Nothing)     ' Copies "HKCU\Software\7-Zip" to "HKLM\"
    ' Reg_Copy_Key("HKCU", "\Software\", "\7-Zip\", "HKLM", "\Software\", "\7-zip\")  ' (Detects bad syntax) Copies "HKCU\Software\7-Zip" to "HKLM\Software\7-Zip"

    Private Function Reg_Copy_Key(ByVal OldRootKey As String, _
                        ByVal OldPath As String, _
                        ByVal OldName As String, _
                        ByVal NewRootKey As String, _
                        ByVal NewPath As String, _
                        ByVal NewName As String) As Boolean

        If OldPath Is Nothing Then OldPath = ""
        If NewRootKey Is Nothing Then NewRootKey = OldRootKey
        If NewPath Is Nothing Then NewPath = ""
        If NewName Is Nothing Then NewName = ""

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

        If OldPath.StartsWith("\") Then OldPath = OldPath.Substring(1, OldPath.Length - 1)
        If OldPath.EndsWith("\") Then OldPath = OldPath.Substring(0, OldPath.Length - 1)
        If NewPath.StartsWith("\") Then NewPath = NewPath.Substring(1, NewPath.Length - 1)
        If NewPath.EndsWith("\") Then NewPath = NewPath.Substring(0, NewPath.Length - 1)

        If OldName.StartsWith("\") Then OldName = OldName.Substring(1, OldName.Length - 1)
        If OldName.EndsWith("\") Then OldName = OldName.Substring(0, OldName.Length - 1)
        If NewName.StartsWith("\") Then NewName = NewName.Substring(1, NewName.Length - 1)
        If NewName.EndsWith("\") Then NewName = NewName.Substring(0, NewName.Length - 1)

        Dim OrigRootKey As Microsoft.Win32.RegistryKey = Nothing
        Dim DestRootKey As Microsoft.Win32.RegistryKey = Nothing

        Select Case OldRootKey.ToUpper
            Case "HKCR", "HKEY_CLASSES_ROOT" : OrigRootKey = Microsoft.Win32.Registry.ClassesRoot
            Case "HKCC", "HKEY_CURRENT_CONFIG" : OrigRootKey = Microsoft.Win32.Registry.CurrentConfig
            Case "HKCU", "HKEY_CURRENT_USER" : OrigRootKey = Microsoft.Win32.Registry.CurrentUser
            Case "HKLM", "HKEY_LOCAL_MACHINE" : OrigRootKey = Microsoft.Win32.Registry.LocalMachine
            Case "HKEY_PERFORMANCE_DATA" : OrigRootKey = Microsoft.Win32.Registry.PerformanceData
            Case Else : Return False
        End Select

        Select Case NewRootKey.ToUpper
            Case "HKCR", "HKEY_CLASSES_ROOT" : DestRootKey = Microsoft.Win32.Registry.ClassesRoot
            Case "HKCC", "HKEY_CURRENT_CONFIG" : DestRootKey = Microsoft.Win32.Registry.CurrentConfig
            Case "HKCU", "HKEY_CURRENT_USER" : DestRootKey = Microsoft.Win32.Registry.CurrentUser
            Case "HKLM", "HKEY_LOCAL_MACHINE" : DestRootKey = Microsoft.Win32.Registry.LocalMachine
            Case "HKEY_PERFORMANCE_DATA" : DestRootKey = Microsoft.Win32.Registry.PerformanceData
            Case Else : Return False
        End Select

        Dim oldkey As Microsoft.Win32.RegistryKey = OrigRootKey.OpenSubKey(OldPath + "\" + OldName, True)
        Dim newkey As Microsoft.Win32.RegistryKey = DestRootKey.OpenSubKey(NewPath, True).CreateSubKey(NewName)
        Reg_Copy_SubKeys(oldkey, newkey)
        Return True
    End Function

    Private Sub Reg_Copy_SubKeys(OrigKey As Microsoft.Win32.RegistryKey, DestKey As Microsoft.Win32.RegistryKey)

        Dim ValueNames As String() = OrigKey.GetValueNames()
        Dim SubKeyNames As String() = OrigKey.GetSubKeyNames()

        For i As Integer = 0 To ValueNames.Length - 1
            Application.DoEvents()
            DestKey.SetValue(ValueNames(i), OrigKey.GetValue(ValueNames(i)))
        Next

        For i As Integer = 0 To SubKeyNames.Length - 1
            Application.DoEvents()
            Reg_Copy_SubKeys(OrigKey.OpenSubKey(SubKeyNames(i), True), DestKey.CreateSubKey(SubKeyNames(i)))
        Next

    End Sub

#End Region

[Eleкtro]

Ejemplo de un comentário de sumário (o Method description):

Código (vbnet) [Seleccionar] Expandir

Public Class MyClass

   ''' <summary>
   ''' A description for this variable [Default: False].
   ''' </summary>
   Public Shared MyVariable As Boolean = False
   
End class





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

Código (vbnet) [Seleccionar] Expandir

       Select Case Variable.ToUpper
           Case "HELLO"
               MsgBox("You said HELLO.")
           Case "BYE", "HASTALAVISTA"
               MsgBox("You said BYE or HASTALAVISTA.")
           Case Else
               MsgBox("You said nothing.")
       End Select





Concatenar texto en varios colores en la consola

Código (vbnet) [Seleccionar] Expandir

#Region " Write Color Text "

   ' [ Write Color Text ]
   '
   ' // By Elektro H@cker
   '
   ' Examples:
   ' Write_Color_Text("TestString A", ConsoleColor.Cyan)
   ' Write_Color_Text(" + ", ConsoleColor.Green)
   ' Write_Color_Text("TestString B" & vbNewLine, ConsoleColor.White, ConsoleColor.DarkRed)
   ' Console.ReadLine()

   Private Sub Write_Color_Text(ByVal Text As String, _
                                Optional ByVal ForeColor As System.ConsoleColor = ConsoleColor.White, _
                                Optional ByVal BackColor As System.ConsoleColor = ConsoleColor.Black)

       Console.ForegroundColor = ForeColor
       Console.BackgroundColor = BackColor
       Console.Write(Text)
       Console.ForegroundColor = ConsoleColor.White
       Console.BackgroundColor = ConsoleColor.Black

   End Sub

#End Region





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

Código (vbnet) [Seleccionar] Expandir

#Region " Add Application To Startup "

   ' [ Add Application To Startup Function ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   ' Add_Application_To_Startup(Startup_User.All_Users)
   ' Add_Application_To_Startup(Startup_User.Current_User)
   ' Add_Application_To_Startup(Startup_User.Current_User, "Application Name", """C:\ApplicationPath.exe""" & " -Arguments")

   Public Enum Startup_User
       Current_User
       All_Users
   End Enum

   Private Function Add_Application_To_Startup(ByVal Startup_User As Startup_User, _
                                           Optional ByVal Application_Name As String = Nothing, _
                                           Optional ByVal Application_Path As String = Nothing) As Boolean

       If Application_Name Is Nothing Then Application_Name = Process.GetCurrentProcess().MainModule.ModuleName
       If Application_Path Is Nothing Then Application_Path = Application.ExecutablePath

       Try
           Select Case Startup_User
               Case Startup_User.All_Users
                   My.Computer.Registry.SetValue("HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run", Application_Name, Application_Path, Microsoft.Win32.RegistryValueKind.String)
               Case Startup_User.Current_User
                   My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run", Application_Name, Application_Path, Microsoft.Win32.RegistryValueKind.String)
           End Select
       Catch ex As Exception
           ' Throw New Exception(ex.Message)
           Return False
       End Try
       Return True

   End Function

#End Region





Convierte un array de bytes a string

Código (vbnet) [Seleccionar] Expandir

   #Region " Byte-Array To String "
   
   ' [  Byte-Array To String Function ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   ' Dim Bytes() As Byte = {84, 101, 115, 116} ' T, e, s, t
   ' MsgBox(Byte_Array_To_String(Bytes))       ' Result: Test

   Private Function Byte_Array_To_String(ByVal Byte_Array As Byte()) As String
       Return System.Text.Encoding.ASCII.GetString(Byte_Array)
   End Function

   #End Region





Convierte un string a aray de bytes

Código (vbnet) [Seleccionar] Expandir

   #Region " String to Byte-Array "
   
   ' [ String to Byte-Array Function ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   ' Dim Bytes() As Byte = String_to_Byte_Array("Test") ' Byte = {84, 101, 115, 116}

   Private Function String_to_Byte_Array(ByVal Text As String) As Byte()
       Return System.Text.Encoding.ASCII.GetBytes(Text)
   End Function

   #End Region





Añade una cuenta de usuario al sistema:

Código (vbnet) [Seleccionar] Expandir

#Region " Add User Account "

   ' [ Add User Account Function ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   ' MsgBox(Add_User_Account("New User"))
   ' Add_User_Account("New User", "MyPass")

   Private Function Add_User_Account(ByVal UserName As String, Optional ByVal Password As String = Nothing) As Boolean
       Dim Net_User As New Process()
       Dim Net_User_Info As New ProcessStartInfo()

       Net_User_Info.FileName = "CMD.exe"
       Net_User_Info.Arguments = "/C NET User " & "" & UserName & "" & " " & "" & Password & "" & " /ADD"
       Net_User_Info.WindowStyle = ProcessWindowStyle.Hidden
       Net_User.StartInfo = Net_User_Info
       Net_User.Start()
       Net_User.WaitForExit()

       Select Case Net_User.ExitCode
           Case 0 : Return True     ' Account created
           Case 2 : Return False    ' Account already exist
           Case Else : Return False ' Unknown error
       End Select

   End Function

#End Region

[Eleкtro]

Devuelve el formato de una URL de una localización de Google Maps

Código (vbnet) [Seleccionar] Expandir

#Region " Get Google Maps URL "

    ' [ Get Google Maps URL Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    '
    ' MsgBox(Get_Google_Maps_URL("Valencia", "España")) ' Result: "http://Maps.google.com/?q=Valencia,+España,+"
    ' WebBrowser1.Navigate(Get_Google_Maps_URL("Valencia", "Spain"))

    Private Function Get_Google_Maps_URL(Optional ByVal City As String = Nothing, _
                                Optional ByVal State As String = Nothing, _
                                Optional ByVal Street As String = Nothing, _
                                Optional ByVal Zipcode As String = Nothing) As String

        Dim queryAddress As New System.Text.StringBuilder()
        queryAddress.Append("http://Maps.google.com/?q=")

        ' Build street part of query string
        If Street IsNot Nothing Then
            Street = Street.Replace(" ", "+")
            queryAddress.Append(Street + "," & "+")
        End If

        ' Build city part of query string
        If City IsNot Nothing Then
            City = City.Replace(" ", "+")
            queryAddress.Append(City + "," & "+")
        End If

        ' Build state part of query string
        If State IsNot Nothing Then
            State = State.Replace(" ", "+")
            queryAddress.Append(State + "," & "+")
        End If

        ' Build zip code part of query string
        If Zipcode IsNot Nothing Then
            queryAddress.Append(Zipcode)
        End If

        ' Return the URL
        Return queryAddress.ToString

    End Function

#End Region





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

Código (vbnet) [Seleccionar] Expandir

#Region " Get Google Maps Coordinates URL "

       ' [ Get Google Maps Coordinates URL Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(Get_Google_Maps_Coordinates_URL(39.4767, 0.3744)) ' Result: http://Maps.google.com/?q=39.4767%2C0.3744
    ' webBrowser1.Navigate(Get_Google_Maps_Coordinates_URL(39.4767, 0.3744))

    Private Function Get_Google_Maps_Coordinates_URL(ByVal Latitude As Double, ByVal Longitude As Double) As String

        Dim queryAddress As New System.Text.StringBuilder()
        queryAddress.Append("http://Maps.google.com/?q=")

        ' Build latitude part of query string
        queryAddress.Append(Latitude.ToString.Replace(",", ".") + "%2C")

        ' Build longitude part of query string
        queryAddress.Append(Longitude.ToString.Replace(",", "."))

        ' Return the URL
        Return queryAddress.ToString

    End Function



Crear un archivo Dummy

Código (vbnet) [Seleccionar] Expandir

#Region " Make Dummy File "

    ' [ Make Dummy File Function ]
    '
    ' Examples :
    ' Make_Dummy_File("C:\Test.dummy", 100) ' Creates a dummy file of 100 bytes

    Private Function Make_Dummy_File(ByVal File As String, ByVal Size As Int64) As Boolean
        Try
            Using DummyFile As New IO.FileStream(File, IO.FileMode.Create)
                DummyFile.SetLength(Size)
            End Using
        Catch ex As Exception
            ' MsgBox(ex.Message)
            Return False
        End Try
        Return True
    End Function

#End Region





Cambiar el fondo de pantalla

Código (vbnet) [Seleccionar] Expandir

#Region " Set Desktop Wallpaper "

    ' [ Set Desktop Wallpaper Function ]
    '
    ' Examples :
    ' MsgBox(Wallpaper.SupportFitFillWallpaperStyles)
    ' MsgBox(Wallpaper.SupportJpgAsWallpaper)
    ' Set_Desktop_Wallpaper("C:\Image.jpg", WallpaperStyle.Fill)

    Private Function Set_Desktop_Wallpaper(ByVal Image As String, ByVal Style As WallpaperStyle) As Boolean
        Try
            If Wallpaper.SupportFitFillWallpaperStyles AndAlso Wallpaper.SupportJpgAsWallpaper Then
                Wallpaper.SetDesktopWallpaper(Image, Style)
            End If
        Catch ex As Exception
            MsgBox(ex.Message)
            Return False
        End Try
        Return True
    End Function

    ' Wallpaper.vb Class
#Region " Wallpaper Class "

    '*********************************** Module Header ***********************************'
    ' Module Name:  Wallpaper.vb
    ' Project:      VBSetDesktopWallpaper
    ' Copyright (c) Microsoft Corporation.
    '
    ' Wallpaper.SetDesktopWallpaper(ByVal path As String, ByVal style As WallpaperStyle)
    '
    ' This is the key method that sets the desktop wallpaper. The method body is composed
    ' of configuring the wallpaper style in the registry and setting the wallpaper with
    ' SystemParametersInfo.
    '
    '*************************************************************************************'

Imports Microsoft.Win32
Imports System.Environment
Imports System.Drawing.Imaging
Imports System.ComponentModel
Imports System.Runtime.InteropServices


    Public Class Wallpaper

        ''' <summary>
        ''' Determine if .jpg files are supported as wallpaper in the current
        ''' operating system. The .jpg wallpapers are not supported before
        ''' Windows Vista.
        ''' </summary>
        Public Shared ReadOnly Property SupportJpgAsWallpaper()
            Get
                Return (Environment.OSVersion.Version >= New Version(6, 0))
            End Get
        End Property


        ''' <summary>
        ''' Determine if the fit and fill wallpaper styles are supported in the
        ''' current operating system. The styles are not supported before
        ''' Windows 7.
        ''' </summary>
        Public Shared ReadOnly Property SupportFitFillWallpaperStyles()
            Get
                Return (Environment.OSVersion.Version >= New Version(6, 1))
            End Get
        End Property


        ''' <summary>
        ''' Set the desktop wallpaper.
        ''' </summary>
        ''' <param name="path">Path of the wallpaper</param>
        ''' <param name="style">Wallpaper style</param>
        Public Shared Sub SetDesktopWallpaper(ByVal path As String, ByVal style As WallpaperStyle)

            ' Set the wallpaper style and tile.
            ' Two registry values are set in the Control Panel\Desktop key.
            ' TileWallpaper
            '  0: The wallpaper picture should not be tiled
            '  1: The wallpaper picture should be tiled
            ' WallpaperStyle
            '  0:  The image is centered if TileWallpaper=0 or tiled if TileWallpaper=1
            '  2:  The image is stretched to fill the screen
            '  6:  The image is resized to fit the screen while maintaining the aspect
            '      ratio. (Windows 7 and later)
            '  10: The image is resized and cropped to fill the screen while
            '      maintaining the aspect ratio. (Windows 7 and later)
            Dim key As RegistryKey = Registry.CurrentUser.OpenSubKey("Control Panel\Desktop", True)

            Select Case style
                Case WallpaperStyle.Tile
                    key.SetValue("WallpaperStyle", "0")
                    key.SetValue("TileWallpaper", "1")
                    Exit Select
                Case WallpaperStyle.Center
                    key.SetValue("WallpaperStyle", "0")
                    key.SetValue("TileWallpaper", "0")
                    Exit Select
                Case WallpaperStyle.Stretch
                    key.SetValue("WallpaperStyle", "2")
                    key.SetValue("TileWallpaper", "0")
                    Exit Select
                Case WallpaperStyle.Fit ' (Windows 7 and later)
                    key.SetValue("WallpaperStyle", "6")
                    key.SetValue("TileWallpaper", "0")
                    Exit Select
                Case WallpaperStyle.Fill ' (Windows 7 and later)
                    key.SetValue("WallpaperStyle", "10")
                    key.SetValue("TileWallpaper", "0")
                    Exit Select
            End Select

            key.Close()


            ' If the specified image file is neither .bmp nor .jpg, - or -
            ' if the image is a .jpg file but the operating system is Windows Server
            ' 2003 or Windows XP/2000 that does not support .jpg as the desktop
            ' wallpaper, convert the image file to .bmp and save it to the
            '  %appdata%\Microsoft\Windows\Themes folder.
            Dim ext As String = System.IO.Path.GetExtension(path)
            If ((Not ext.Equals(".bmp", StringComparison.OrdinalIgnoreCase) AndAlso _
                 Not ext.Equals(".jpg", StringComparison.OrdinalIgnoreCase)) _
                OrElse _
                (ext.Equals(".jpg", StringComparison.OrdinalIgnoreCase) AndAlso _
                (Not SupportJpgAsWallpaper))) Then

                Using image As Image = image.FromFile(path)
                    path = String.Format("{0}\Microsoft\Windows\Themes\{1}.bmp", _
                        Environment.GetFolderPath(SpecialFolder.ApplicationData), _
                        System.IO.Path.GetFileNameWithoutExtension(path))
                    image.Save(path, ImageFormat.Bmp)
                End Using

            End If

            ' Set the desktop wallpapaer by calling the Win32 API SystemParametersInfo
            ' with the SPI_SETDESKWALLPAPER desktop parameter. The changes should
            ' persist, and also be immediately visible.
            If Not Wallpaper.SystemParametersInfo(20, 0, path, 3) Then
                Throw New Win32Exception
            End If
        End Sub


        <DllImport("user32.dll", CharSet:=CharSet.Unicode, SetLastError:=True)> _
        Private Shared Function SystemParametersInfo( _
        ByVal uiAction As UInt32, _
        ByVal uiParam As UInt32, _
        ByVal pvParam As String, _
        ByVal fWinIni As UInt32) _
        As <MarshalAs(UnmanagedType.Bool)> Boolean
        End Function

        Private Const SPI_SETDESKWALLPAPER As UInt32 = 20
        Private Const SPIF_SENDWININICHANGE As UInt32 = 2
        Private Const SPIF_UPDATEINIFILE As UInt32 = 1
    End Class


    Public Enum WallpaperStyle
        Tile
        Center
        Stretch
        Fit
        Fill
    End Enum
#End Region

#End Region





Centrar el Form a la pantalla del escritorio

Código (vbnet) [Seleccionar] Expandir

#Region " Center Form To Desktop "

    ' [ Center Form To Desktop ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' Center_Form_To_Desktop(Me)

    Private Sub Center_Form_To_Desktop(ByVal Form As Form)
        Dim Desktop_RES As System.Windows.Forms.Screen = System.Windows.Forms.Screen.PrimaryScreen
        Me.Location = New Point((Desktop_RES.Bounds.Width - Form.Width) / 2, (Desktop_RES.Bounds.Height - Form.Height) / 2)
    End Sub

#End Region





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

Código (vbnet) [Seleccionar] Expandir

#Region " My Application Is Already Running "

    ' [ My Application Is Already Running Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(My_Application_Is_Already_Running)
    ' If My_Application_Is_Already_Running() Then Application.Exit()

    Public Declare Function CreateMutexA Lib "Kernel32.dll" (ByVal lpSecurityAttributes As Integer, ByVal bInitialOwner As Boolean, ByVal lpName As String) As Integer
    Public Declare Function GetLastError Lib "Kernel32.dll" () As Integer

    Public Function My_Application_Is_Already_Running() As Boolean
        'Attempt to create defualt mutex owned by process
        CreateMutexA(0, True, Process.GetCurrentProcess().MainModule.ModuleName.ToString)
        Return (GetLastError() = 183) ' 183 = ERROR_ALREADY_EXISTS
    End Function

#End Region

[Eleкtro]

Los snippets que posteé hace tiempo para hacer modificaciones en el registro, los he optimizado para simplificar su uso y evitar errores de sintaxis.
PD: Ahora permite añadir datos binários.

Código (vbnet) [Seleccionar] Expandir

#Region " Reg Create Key "

   ' [ Reg Create Key Function ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   '
   ' Reg_Create_Key("HKCU\Software\MyProgram")                        ' Creates "HKCU\Software\MyProgram"
   ' Reg_Create_Key("HKEY_CURRENT_USER\Software\MyProgram\Settings\") ' Creates "HKCU\Software\MyProgram\Settings"

   Public Function Reg_Create_Key(ByVal RegKey As String) As Boolean

       Dim RootKey As Microsoft.Win32.RegistryKey = Nothing
       Dim KeyPath As String = Nothing

       ' Gets the RootKey
       Select Case RegKey.ToUpper.Split("\").First
           Case "HKCR", "HKEY_CLASSES_ROOT" : RootKey = Microsoft.Win32.Registry.ClassesRoot
           Case "HKCC", "HKEY_CURRENT_CONFIG" : RootKey = Microsoft.Win32.Registry.CurrentConfig
           Case "HKCU", "HKEY_CURRENT_USER" : RootKey = Microsoft.Win32.Registry.CurrentUser
           Case "HKLM", "HKEY_LOCAL_MACHINE" : RootKey = Microsoft.Win32.Registry.LocalMachine
           Case "HKEY_PERFORMANCE_DATA" : RootKey = Microsoft.Win32.Registry.PerformanceData
           Case Else : Return False
       End Select

       ' Gets the KeyPath
       For i As Integer = 1 To RegKey.Split("\").Length - 1 : KeyPath += RegKey.Split("\")(i) & "\" : Next
       KeyPath = KeyPath.Substring(0, KeyPath.LastIndexOf("\"))

       Try
           RootKey.CreateSubKey(KeyPath)
           RootKey.Close()
           Return True
       Catch ex As Exception
           Throw New Exception(ex.Message)
       End Try

   End Function

#End Region

Código (vbnet) [Seleccionar] Expandir

#Region " Reg Delete Key "

   ' [ Reg Delete Key Function ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   ' Reg_Delete_Key("HKLM\Software\7-zip")                ' Deletes the "7-zip" tree including subkeys
   ' Reg_Delete_Key("HKEY_LOCAL_MACHINE\Software\7-zip\") ' Deletes the "7-zip" tree including subkeys

   Public Function Reg_Delete_Key(ByVal RegKey As String) As Boolean

       Dim RootKey As Microsoft.Win32.RegistryKey = Nothing
       Dim KeyPath As String = Nothing

       ' Gets the RootKey
       Select Case RegKey.ToUpper.Split("\").First
           Case "HKCR", "HKEY_CLASSES_ROOT" : RootKey = Microsoft.Win32.Registry.ClassesRoot
           Case "HKCC", "HKEY_CURRENT_CONFIG" : RootKey = Microsoft.Win32.Registry.CurrentConfig
           Case "HKCU", "HKEY_CURRENT_USER" : RootKey = Microsoft.Win32.Registry.CurrentUser
           Case "HKLM", "HKEY_LOCAL_MACHINE" : RootKey = Microsoft.Win32.Registry.LocalMachine
           Case "HKEY_PERFORMANCE_DATA" : RootKey = Microsoft.Win32.Registry.PerformanceData
           Case Else : Return False
       End Select

       ' Gets the KeyPath
       For i As Integer = 1 To RegKey.Split("\").Length - 1 : KeyPath += RegKey.Split("\")(i) & "\" : Next
       KeyPath = KeyPath.Substring(0, KeyPath.LastIndexOf("\"))

       Try
           RootKey.DeleteSubKeyTree(KeyPath)
           RootKey.Close()
           Return True
       Catch ex As Exception
           ' Throw New Exception(ex.Message)
           Return False
       End Try

   End Function

#End Region

Código (vbnet) [Seleccionar] Expandir

#Region " Reg Delete Value "

   ' [ Reg Delete Value Function ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   ' Reg_Delete_Value("HKCU\Software\7-Zip", "Lang")               ' Deletes "Lang" Value
   ' Reg_Delete_Value("HKEY_CURRENT_USER\Software\7-Zip\", "Lang") ' Deletes "Lang" Value

   Public Function Reg_Delete_Value(ByVal RegKey As String, ByVal RegValue As String) As Boolean

       Dim RootKey As Microsoft.Win32.RegistryKey = Nothing
       Dim KeyPath As String = Nothing

       ' Gets the RootKey
       Select Case RegKey.ToUpper.Split("\").First
           Case "HKCR", "HKEY_CLASSES_ROOT" : RootKey = Microsoft.Win32.Registry.ClassesRoot
           Case "HKCC", "HKEY_CURRENT_CONFIG" : RootKey = Microsoft.Win32.Registry.CurrentConfig
           Case "HKCU", "HKEY_CURRENT_USER" : RootKey = Microsoft.Win32.Registry.CurrentUser
           Case "HKLM", "HKEY_LOCAL_MACHINE" : RootKey = Microsoft.Win32.Registry.LocalMachine
           Case "HKEY_PERFORMANCE_DATA" : RootKey = Microsoft.Win32.Registry.PerformanceData
           Case Else : Return False
       End Select

       ' Gets the KeyPath
       For i As Integer = 1 To RegKey.Split("\").Length - 1 : KeyPath += RegKey.Split("\")(i) & "\" : Next
       KeyPath = KeyPath.Substring(0, KeyPath.LastIndexOf("\"))

       Try
           RootKey.OpenSubKey(KeyPath, True).DeleteValue(RegValue)
           RootKey.Close()
           Return True
       Catch ex As Exception
           ' Throw New Exception(ex.Message)
           Return False
       End Try

   End Function

#End Region

Código (vbnet) [Seleccionar] Expandir

#Region " Reg Set Value "

   ' [ Reg Set Value Function ]
   '
   ' // By Elektro H@cker
   '
   ' Examples :
   ' Reg_Set_Value("HKCU\Software\MyProgram", "Value name", "Data", Microsoft.Win32.RegistryValueKind.String)              ' Create/Replace "Value Name" with "Data" as string data
   ' Reg_Set_Value("HKEY_CURRENT_USER\Software\MyProgram\", "Value name", "Data", Microsoft.Win32.RegistryValueKind.String) ' Create/Replace "Value Name" with "Data" as string data


   Public Function Reg_Set_Value(ByVal RegKey As String, _
                                 ByVal RegValue As String, _
                                 ByVal RegData As String, _
                                 ByVal RegDataType As Microsoft.Win32.RegistryValueKind) As Boolean

       Dim RootKey As String = Nothing
       Dim KeyPath As String = Nothing

       ' Gets the RootKey
       Select Case RegKey.ToUpper.Split("\").First
           Case "HKCR", "HKEY_CLASSES_ROOT" : RootKey = "HKEY_CLASSES_ROOT"""
           Case "HKCC", "HKEY_CURRENT_CONFIG" : RootKey = "HKEY_CURRENT_CONFIG"
           Case "HKCU", "HKEY_CURRENT_USER" : RootKey = "HKEY_CURRENT_USER"
           Case "HKLM", "HKEY_LOCAL_MACHINE" : RootKey = "HKEY_LOCAL_MACHINE"
           Case "HKEY_PERFORMANCE_DATA" : RootKey = "HKEY_PERFORMANCE_DATA"
           Case Else : Return False
       End Select

       ' Gets the KeyPath
       For i As Integer = 1 To RegKey.Split("\").Length - 1 : KeyPath += RegKey.Split("\")(i) & "\" : Next
       KeyPath = KeyPath.Substring(0, KeyPath.LastIndexOf("\"))
       KeyPath = RootKey & "\" & KeyPath

       Try
           If RegDataType = Microsoft.Win32.RegistryValueKind.Binary Then
               My.Computer.Registry.SetValue(KeyPath, RegValue, System.Text.Encoding.ASCII.GetBytes(RegData), Microsoft.Win32.RegistryValueKind.Binary)
           Else
               My.Computer.Registry.SetValue(KeyPath, RegValue, RegData, RegDataType)
           End If
           Return True
       Catch ex As Exception
           ' Throw New Exception(ex.Message)
           Return False
       End Try

   End Function

#End Region

[Eleкtro]

Una class para compilar otros proyectos en tiempo de ejecución.

Código [Seleccionar] Expandir

#Region " FrameWork Compiler "

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

#Region " FrameWork Compiler Class "

Public Class FrameWorkCompiler

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

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

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

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

        Try

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

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

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

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

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

    End Function

End Class

#End Region

#End Region

[ABDERRAMAH]

Mother of god, que bueno ese último. Seguro que se me ocurre alguna aplicación...

[Eleкtro]

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

Código (vbnet) [Seleccionar] Expandir


#Region " SevenZipSharp Class "

' [ SevenZipSharp Functions ]
'
' // 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. Add the "7z.sfx" and "7zCon.sfx" files to the project for SFX compression.
'
' Examples :
'
' --------
' Extract:
' --------
' 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.
'
' --------
' Compress:
' ---------
' 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:\Compressed\".
' SevenZipSharp.Compress("C:\Folder\", , , , , , "Password")     ' Folder will be compressed with the given password.
' SevenZipSharp.Compress("C:\File.txt", , OutArchiveFormat.Zip, , CompressionMethod.Lzma, CompressionLevel.Ultra)
'
' --------
' Compress SFX:
' -------------
' SevenZipSharp.Compress_SFX("C:\File.txt")                           ' File will be compressed in the same dir.
' SevenZipSharp.Compress_SFX("C:\File.txt", "C:\Compressed\File.exe") ' File will be compressed in "C:\Compressed\".
' SevenZipSharp.Compress_SFX("C:\Folder\", , , , , , , "Password")    ' Folder will be compressed with the given password.
' SevenZipSharp.Compress_SFX("C:\File.txt", , SevenZipSharp_SFX_Module.Console, CompressionLevel.Fast)
'
' --------
' File Info:
' ----------
' 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
'
' ------------
' * Progress *
' ------------
' Dim WithEvents SevenZipProgress_Timer As New Timer
' Private Sub SevenZipProgress_Timer_Tick(sender As Object, e As EventArgs) Handles SevenZipProgress_Timer.Tick
'     ProgressBar1.Value = SevenZipSharp.SevenZip_Current_Progress
'     If ProgressBar1.Value = 100 Then
'         ' ...
'     End If
' End Sub

Imports SevenZip

Public Class SevenZipSharp

   Public Shared SevenZipDLL As String = "7z.dll"
   Public Shared SevenZip_Current_Progress As Short = 0

#Region " SevenZipSharp Extract "

   Public Shared Function Extract(ByVal InputFile As String, _
                                          Optional ByVal OutputDir As String = Nothing, _
                                          Optional ByVal Password As String = "Nothing") As Boolean
       SevenZip_Current_Progress = 0

       Try
           ' Set library path
           SevenZipExtractor.SetLibraryPath(SevenZipDLL)

           ' 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

   Private Shared Sub SevenZipSharp_Extract_Progress(ByVal sender As Object, ByVal e As ProgressEventArgs)
       SevenZip_Current_Progress = e.PercentDone
       ' If e.PercentDone = 100 Then SevenZip_Current_Progress = 0
   End Sub

#End Region

#Region " SevenZipSharp Compress "

   Public Shared Function 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 VolumeSize As Long = Nothing, _
                                      Optional ByVal Password As String = Nothing) As Boolean
       SevenZip_Current_Progress = 0

       Try
           ' Set library path
           SevenZipCompressor.SetLibraryPath(SevenZipDLL)

           ' Create compressor
           Dim Compressor As SevenZipCompressor = New SevenZipCompressor()

           ' Set compression parameters
           Compressor.CompressionLevel = CompressionLevel ' Archiving compression level.
           Compressor.CompressionMethod = CompressionMethod ' Compression method
           Compressor.ArchiveFormat = Format ' Compression file format
           Compressor.CompressionMode = CompressionMode ' Append files to compressed file or overwrite the compressed file.
           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

           If Not VolumeSize = Nothing Then
               If Format = OutArchiveFormat.SevenZip Then Compressor.VolumeSize = VolumeSize _
               Else Throw New Exception("Multi volume option is only avaliable for 7zip format")
           End If

           ' 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

   Private Shared Sub SevenZipSharp_Compress_Progress(ByVal sender As Object, ByVal e As ProgressEventArgs)
       SevenZip_Current_Progress = e.PercentDone
       ' If e.PercentDone = 100 Then SevenZip_Current_Progress = 0
   End Sub

#End Region

#Region " SevenZipSharp Compress SFX "

   Enum SevenZipSharp_SFX_Module
       Normal
       Console
   End Enum

   Public Shared Function Compress_SFX(ByVal Input_DirOrFile As String, _
                                      Optional ByVal OutputFileName As String = Nothing, _
                                      Optional ByVal SFX_Module As SevenZipSharp_SFX_Module = SevenZipSharp_SFX_Module.Normal, _
                                      Optional ByVal CompressionLevel As CompressionLevel = CompressionLevel.Normal, _
                                      Optional ByVal Password As String = Nothing) As Boolean
       SevenZip_Current_Progress = 0

       ' Create the .7z file
       Try
           ' Set library path
           SevenZipCompressor.SetLibraryPath(SevenZipDLL)

           ' Create compressor
           Dim Compressor As SevenZipCompressor = New SevenZipCompressor()

           ' Set compression parameters
           Compressor.CompressionLevel = CompressionLevel ' Archiving compression level.
           Compressor.CompressionMethod = CompressionMethod.Lzma ' Compression Method
           Compressor.ArchiveFormat = OutArchiveFormat.SevenZip ' Compression file format
           Compressor.CompressionMode = CompressionMode.Create ' Append files to compressed file or overwrite the compressed file.
           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

           ' 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) & ".tmp").Replace("\\", "\")
           Else
               OutputFileName = OutputFileName & ".tmp"
           End If

           ' 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

           ' Create the SFX file
           ' Create the SFX compressor
           Dim compressorSFX As SevenZipSfx = New SevenZipSfx(SfxModule.Default)
           ' Set SFX Module path
           If SFX_Module = SevenZipSharp_SFX_Module.Normal Then
               compressorSFX.ModuleFileName = ".\7z.sfx"
           ElseIf SFX_Module = SevenZipSharp_SFX_Module.Console Then
               compressorSFX.ModuleFileName = ".\7zCon.sfx"
           End If
           ' Start the compression
           ' Generate the OutputFileName if any is given.
           Dim SFXOutputFileName As String
           If OutputFileName.ToLower.EndsWith(".exe.tmp") Then
               SFXOutputFileName = OutputFileName.Substring(0, OutputFileName.Length - 4)
           Else
               SFXOutputFileName = OutputFileName.Substring(0, OutputFileName.Length - 4) & ".exe"
           End If

           compressorSFX.MakeSfx(OutputFileName, SFXOutputFileName)
           ' Delete the 7z tmp file
           Try : IO.File.Delete(OutputFileName) : Catch : End Try

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

       Return True ' File compressed

   End Function

   Private Shared Sub SevenZipSharp_Compress_SFX_Progress(ByVal sender As Object, ByVal e As ProgressEventArgs)
       SevenZip_Current_Progress = e.PercentDone
       ' If e.PercentDone = 100 Then SevenZip_Current_Progress = 0
   End Sub

#End Region

#Region " SevenZipSharp FileInfo "

   Enum File_Info
       FileName
       Format
       Size_In_Bytes
       Internal_Files_FileNames
       Total_Internal_Files
   End Enum

   Public Shared Function FileInfo(ByVal InputFile As String, ByVal Info As File_Info)

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

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

           ' Return info
           Select Case Info

               Case File_Info.FileName
                   Return Extractor.FileName

               Case File_Info.Format
                   Return Extractor.Format

               Case File_Info.Size_In_Bytes
                   Return Extractor.PackedSize

               Case File_Info.Total_Internal_Files
                   Return Extractor.FilesCount

               Case File_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

End Class

#End Region








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

Código (vbnet) [Seleccionar] Expandir

#Region " DotNetZip Class "

' [ DotNetZip Functions ]
'
' // By Elektro H@cker
'
' Instructions :
' 1. Add a reference to "Ionic.Zip.dll".
'
' Examples :
'
' --------
' Extract:
' --------
' DotNetZip_Extract("C:\File.zip")
' DotNetZip_Extract("C:\File.zip", "C:\Folder\Test\", , "MyPassword")
'
' ---------
' Compress:
' ---------
' DotNetZip_Compress("C:\File.txt")
' DotNetZip_Compress("C:\Folder")
' DotNetZip_Compress("C:\Folder", "C:\Folder\Test.zip", , CompressionLevel.BestCompression, "Password", EncryptionAlgorithm.WinZipAes256)
'
' -------------
' Compress SFX:
' -------------
' DotNetZip_Compress_SFX("C:\File.txt")
' DotNetZip_Compress_SFX("C:\Folder")
'
' DotNetZip_Compress_SFX( _
'    "C:\File.txt", "C:\Test.exe", , CompressionLevel.BestCompression, _
'    "MyPassword", EncryptionAlgorithm.WinZipAes256, , , _
'    ExtractExistingFileAction.OverwriteSilently, , , , _
'    System.IO.Path.GetFileName("notepad.exe") _
' )
'
' ------------
' * Progress *
' ------------
' Dim WithEvents DotNetZip_Progress_Timer As New Timer
' Private Sub DotNetZip_Progress_Timer_Tick(sender As Object, e As EventArgs) Handles DotNetZip_Progress_Timer.Tick
'    Label1.Text = DotNetZip.CurrentFileName
'    ProgressBar1.Value = DotNetZip.DotNetZip_Current_Progress
'    If ProgressBar1.Value = 100 Then
'       ' ...
'   End If
' End Sub

Imports Ionic.Zip
Imports Ionic.Zlib

Public Class DotNetZip

#Region " DotNetZip Extract "

   Public Shared DotNetZip_Current_Progress As Short = 0
   Public Shared ZipFileCount As Long = 0
   Public Shared ExtractedFileCount As Long = 0
   Public Shared CurrentFileName As String = String.Empty

   Public Shared Function Extract(ByVal InputFile As String, _
                                      Optional ByVal OutputDir As String = Nothing, _
                                      Optional ByVal Overwrite As ExtractExistingFileAction = ExtractExistingFileAction.DoNotOverwrite, _
                                      Optional ByVal Password As String = "Nothing" _
                                    ) As Boolean

       DotNetZip_Current_Progress = 0
       ZipFileCount = 0
       ExtractedFileCount = 0
       CurrentFileName = String.Empty

       Try
           ' Create Extractor
           Dim Extractor As ZipFile = ZipFile.Read(InputFile)

           ' Set Extractor parameters
           Extractor.Password = Password ' Zip Password
           Extractor.TempFileFolder = System.IO.Path.GetTempPath() ' Temp folder for operations
           Extractor.ZipErrorAction = ZipErrorAction.Throw

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

           ' Add Progress
           AddHandler Extractor.ExtractProgress, AddressOf DotNetZip_Extract_Progress ' Progress Handler
           For Each Entry As ZipEntry In Extractor.Entries
               Application.DoEvents()
               ZipFileCount += 1
           Next ' Total bytes size of Zip
           ZipFileCount = Extractor.Entries.Count ' Total files inside Zip

           ' Start the extraction
           For Each Entry As ZipEntry In Extractor.Entries
               Application.DoEvents()
               Entry.Extract(OutputDir, Overwrite)
           Next

           ZipFileCount = 0 : ExtractedFileCount = 0 ' Reset vars
           Extractor.Dispose()
           Return True ' File Extracted

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

   End Function

   Private Shared Sub DotNetZip_Extract_Progress(ByVal sender As Object, ByVal e As ExtractProgressEventArgs)

       If e.EventType = ZipProgressEventType.Extracting_BeforeExtractEntry Then
           CurrentFileName = e.CurrentEntry.FileName
           ExtractedFileCount += 1
           DotNetZip_Current_Progress = ((100 / ZipFileCount) * ExtractedFileCount)
       ElseIf e.EventType = ZipProgressEventType.Extracting_AfterExtractEntry Then
           If ExtractedFileCount = ZipFileCount Then
               'MessageBox.Show("Extraction Done: " & vbNewLine & _
               '                             e.ArchiveName) ' Uncompression finished
           End If
       End If

   End Sub

#End Region

#Region " DotNetZip Compress "

   Public Shared Function Compress(ByVal Input_DirOrFile As String, _
                                     Optional ByVal OutputFileName As String = Nothing, _
                                     Optional ByVal CompressionMethod As CompressionMethod = CompressionMethod.None, _
                                     Optional ByVal CompressionLevel As CompressionLevel = CompressionLevel.Default, _
                                     Optional ByVal Password As String = Nothing, _
                                     Optional ByVal Encrypt_Password As EncryptionAlgorithm = EncryptionAlgorithm.None _
                                   ) As Boolean

       DotNetZip_Current_Progress = 0
       ZipFileCount = 0
       ExtractedFileCount = 0
       CurrentFileName = String.Empty

       Try
           ' Create compressor
           Dim Compressor As ZipFile = New ZipFile

           ' Set compression parameters
           Compressor.CompressionLevel = CompressionLevel ' Archiving compression level.
           Compressor.CompressionMethod = CompressionMethod ' Compression method
           Compressor.Password = Password ' Zip Password
           Compressor.TempFileFolder = System.IO.Path.GetTempPath() ' Temp folder for operations

           If Password Is Nothing AndAlso Not Encrypt_Password = EncryptionAlgorithm.None Then _
                Compressor.Encryption = EncryptionAlgorithm.None _
           Else Compressor.Encryption = Encrypt_Password ' Encryption for Zip password.

           ' Add Progress Handler
           AddHandler Compressor.SaveProgress, AddressOf DotNetZip_Compress_Progress

           ' Removes the end slash ("\") if is 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) & ".zip").Replace("\\", "\")

           ' Check if given argument is Dir or File ...then start the compression
           If IO.Directory.Exists(Input_DirOrFile) Then ' It's a Dir
               Compressor.AddDirectory(Input_DirOrFile)
           ElseIf IO.File.Exists(Input_DirOrFile) Then ' It's a File
               Compressor.AddFile(Input_DirOrFile)
           End If

           Compressor.Save(OutputFileName)
           Compressor.Dispose()

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

       Return True ' File compressed

   End Function

   Private Shared Sub DotNetZip_Compress_Progress(ByVal sender As Object, ByVal e As SaveProgressEventArgs)
       Application.DoEvents()

       If e.EventType = ZipProgressEventType.Saving_Started Then
       ElseIf e.EventType = ZipProgressEventType.Saving_BeforeWriteEntry Then
           CurrentFileName = e.CurrentEntry.FileName ' Input filename to be compressed
           DotNetZip_Current_Progress = ((100 / e.EntriesTotal) * e.EntriesSaved + 1)
       ElseIf e.EventType = ZipProgressEventType.Saving_Completed Then
           DotNetZip_Current_Progress = 100
       End If

   End Sub

#End Region

#Region " DotNetZip Compress SFX "

   Public Shared Function Compress_SFX(ByVal Input_DirOrFile As String, _
                                     Optional ByVal OutputFileName As String = Nothing, _
                                     Optional ByVal CompressionMethod As CompressionMethod = CompressionMethod.None, _
                                     Optional ByVal CompressionLevel As CompressionLevel = CompressionLevel.Default, _
                                     Optional ByVal Password As String = Nothing, _
                                     Optional ByVal Encrypt_Password As EncryptionAlgorithm = EncryptionAlgorithm.None, _
                                     Optional ByVal Extraction_Directory As String = ".\", _
                                     Optional ByVal Silent_Extraction As Boolean = False, _
                                     Optional ByVal Overwrite_Files As ExtractExistingFileAction = ExtractExistingFileAction.InvokeExtractProgressEvent, _
                                     Optional ByVal Delete_Extracted_Files_After_Extraction As Boolean = False, _
                                     Optional ByVal Icon As String = Nothing, _
                                     Optional ByVal Window_Title As String = Nothing, _
                                     Optional ByVal Window_Style As SelfExtractorFlavor = SelfExtractorFlavor.WinFormsApplication, _
                                     Optional ByVal Command_Line_Argument As String = Nothing _
                                   ) As Boolean

       DotNetZip_Current_Progress = 0
       ZipFileCount = 0
       ExtractedFileCount = 0
       CurrentFileName = String.Empty

       Try
           ' Create compressor
           Dim Compressor As ZipFile = New ZipFile

           ' Set compression parameters
           Compressor.CompressionLevel = CompressionLevel ' Archiving compression level.
           ' Compression method
           Compressor.Password = Password ' Zip Password
           Compressor.TempFileFolder = System.IO.Path.GetTempPath() ' Temp folder for operations

           If Password Is Nothing AndAlso Not Encrypt_Password = EncryptionAlgorithm.None Then
               Compressor.Encryption = EncryptionAlgorithm.None ' No encryption because no password.
               Compressor.CompressionMethod = CompressionMethod ' Set any compression method.
           Else
               Compressor.Encryption = Encrypt_Password ' Set Encryption for Zip password.
               Compressor.CompressionMethod = CompressionMethod.Deflate ' Set deflate method to don't destroy the SFX if AES encryption.
           End If

           Dim SFX_Options As New SelfExtractorSaveOptions()
           SFX_Options.DefaultExtractDirectory = Extraction_Directory
           SFX_Options.Quiet = Silent_Extraction
           SFX_Options.ExtractExistingFile = ExtractExistingFileAction.OverwriteSilently
           SFX_Options.RemoveUnpackedFilesAfterExecute = Delete_Extracted_Files_After_Extraction
           SFX_Options.Flavor = Window_Style
           SFX_Options.PostExtractCommandLine = Command_Line_Argument
           If Not Icon Is Nothing Then SFX_Options.IconFile = Icon
           If Not Window_Title Is Nothing Then SFX_Options.SfxExeWindowTitle = Window_Title

           ' Add Progress Handler
           AddHandler Compressor.SaveProgress, AddressOf DotNetZip_Compress_SFX_Progress

           ' Removes the end slash ("\") if is 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) & ".exe").Replace("\\", "\")

           ' Check if given argument is Dir or File ...then start the compression
           If IO.Directory.Exists(Input_DirOrFile) Then ' It's a Dir
               Compressor.AddDirectory(Input_DirOrFile)
           ElseIf IO.File.Exists(Input_DirOrFile) Then ' It's a File
               Compressor.AddFile(Input_DirOrFile)
           End If

           Compressor.SaveSelfExtractor(OutputFileName, SFX_Options)
           Compressor.Dispose()

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

       Return True ' File compressed

   End Function

   Private Shared Sub DotNetZip_Compress_SFX_Progress(ByVal sender As Object, ByVal e As SaveProgressEventArgs)
       Application.DoEvents()

       If e.EventType = ZipProgressEventType.Saving_Started Then
       ElseIf e.EventType = ZipProgressEventType.Saving_BeforeWriteEntry Then
           CurrentFileName = e.CurrentEntry.FileName ' Input filename to be compressed
           DotNetZip_Current_Progress = ((100 / e.EntriesTotal) * e.EntriesSaved + 1)
       ElseIf e.EventType = ZipProgressEventType.Saving_Completed Then
           DotNetZip_Current_Progress = 100
       End If

   End Sub

#End Region

End Class

#End Region

[Eleкtro]

Mi versión modificada del "FileInfo"

Código (vbnet) [Seleccionar] Expandir

#Region " Get File Info "

    ' [ Get File Info Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples:
    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Name))
    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Extension))
    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.FileName))
    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Directory))
    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.DriveLetter))
    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.FullName))
    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.ShortName))
    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.ShortPath))
    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Name_Length))
    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Extension_Length))
    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.FileName_Length))
    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Directory_Length))
    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.FullName_Length))
    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.FileSize))
    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.FileVersion))
    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Attributes_Enum))
    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Attributes_String))
    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.CreationTime))
    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.LastAccessTime))
    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.LastModifyTime))
    ' MsgBox(Get_File_Info("C:\Test.txt", FileInfo.Has_Extension))

    Public Enum FileInfo

        Name                  ' Filename without extension
        Extension_With_Dot    ' File-Extension (with dot included)
        Extension_Without_Dot ' File-Extension (without dot)
        FileName              ' Filename.extension
        Directory             ' Directory name
        DriveLetter           ' Drive letter (only 1 letter)
        FullName              ' Directory path + Filename

        ShortName ' DOS8.3 Filename
        ShortPath ' DOS8.3 Path Name

        Name_Length                  ' Length of Filename without extension
        Extension_With_Dot_Length    ' Length of File-Extension (with dot included)
        Extension_Without_Dot_Length ' Length of File-Extension (without dot)
        FileName_Length              ' Length of Filename.extension
        Directory_Length             ' Length of Directory name
        FullName_Length              ' Length of Directory path + Filename

        FileSize    ' Size in Bytes

        FileVersion ' Version for DLL or EXE files

        Attributes_Enum   ' Attributes in Integer format
        Attributes_String ' Attributes in String format

        CreationTime   ' Date Creation time
        LastAccessTime ' Date Last Access time
        LastModifyTime ' Date Last Modify time

        Has_Extension  ' Checks if file have a file-extension.

    End Enum

    Private Function Get_File_Info(ByVal File As String, ByVal Information As FileInfo)

        Dim File_Info = My.Computer.FileSystem.GetFileInfo(File)

        Select Case Information

            Case FileInfo.Name : Return File_Info.Name.Substring(0, File_Info.Name.LastIndexOf("."))
            Case FileInfo.Extension_With_Dot : Return File_Info.Extension
            Case FileInfo.Extension_Without_Dot : Return File_Info.Extension.Split(".").Last
            Case FileInfo.FileName : Return File_Info.Name
            Case FileInfo.Directory : Return File_Info.DirectoryName
            Case FileInfo.DriveLetter : Return File_Info.Directory.Root.ToString.Substring(0, 1)
            Case FileInfo.FullName : Return File_Info.FullName

            Case FileInfo.ShortName : Return CreateObject("Scripting.FileSystemObject").GetFile(File).ShortName
            Case FileInfo.ShortPath : Return CreateObject("Scripting.FileSystemObject").GetFile(File).ShortPath

            Case FileInfo.Name_Length : Return File_Info.Name.Length
            Case FileInfo.Extension_With_Dot_Length : Return File_Info.Extension.Length
            Case FileInfo.Extension_Without_Dot_Length : Return File_Info.Extension.Split(".").Last.Length
            Case FileInfo.FileName_Length : Return File_Info.Name.Length
            Case FileInfo.Directory_Length : Return File_Info.DirectoryName.Length
            Case FileInfo.FullName_Length : Return File_Info.FullName.Length

            Case FileInfo.FileSize : Return File_Info.Length

            Case FileInfo.FileVersion : Return CreateObject("Scripting.FileSystemObject").GetFileVersion(File)

            Case FileInfo.Attributes_Enum : Return File_Info.Attributes
            Case FileInfo.Attributes_String : Return File_Info.Attributes.ToString

            Case FileInfo.CreationTime : Return File_Info.CreationTime
            Case FileInfo.LastAccessTime : Return File_Info.LastAccessTime
            Case FileInfo.LastModifyTime : Return File_Info.LastWriteTime

            Case FileInfo.Has_Extension : Return IO.Path.HasExtension(File)

            Case Else : Return Nothing

        End Select

    End Function

#End Region

[Eleкtro]

Una class para trabajar con StringCases por ejemplo para renombrar archivos de forma masiva a TitleCase,
contiene las funciones que posteé hace un tiempo, y le he añadido el "InvertedCase".

Código (vbnet) [Seleccionar] Expandir

#Region " StringCase Class "

Public Class StringCase

    ' [ StringCase Functions ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' MsgBox(StringCase.Titlecase("THiS is a TeST"))
    ' MsgBox(StringCase.DelimitedCase_Lower("THiS is a TeST", ";"))
    ' MsgBox(StringCase.InvertedCase("HeLLo"))
    ' Var = StringCase.WordCase(Var)

    ''' <summary>
    ''' Convert to LowerCase [Ex: ab cd ef]
    ''' </summary>
    Public Shared Function LowerCase(ByVal Text As String) As String
        Return Text.ToLower
    End Function

    ''' <summary>
    ''' Convert to UpperCase [Ex: AB CD EF]
    ''' </summary>
    Public Shared Function UpperCase(ByVal Text As String) As String
        Return Text.ToUpper
    End Function

    ''' <summary>
    ''' Convert to Titlecase [Ex: Ab cd ef]
    ''' </summary>
    Public Shared Function Titlecase(ByVal Text As String) As String
        Return Char.ToUpper(Text(0)) + StrConv(Text.Substring(1), VbStrConv.Lowercase)
    End Function

    ''' <summary>
    ''' Convert to WordCase [Ex: Ab Cd Ef]
    ''' </summary>
    Public Shared Function WordCase(ByVal Text As String) As String
        Return System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToTitleCase(Text)
    End Function

    ''' <summary>
    ''' Convert to CamelCase (And first letter to Lower) [Ex: abCdEf]
    ''' </summary>
    Public Shared Function CamelCase_First_Lower(ByVal Text As String) As String
        Return Char.ToLower(Text(0)) & System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToTitleCase(Text).Replace(" ", "").Substring(1)
    End Function

    ''' <summary>
    ''' Convert to CamelCase (And first letter to Upper) [Ex: AbCdEf]
    ''' </summary>
    Public Shared Function CamelCase_First_Upper(ByVal Text As String) As String
        Return Char.ToUpper(Text(0)) & System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToTitleCase(Text).Replace(" ", "").Substring(1)
    End Function

    ''' <summary>
    ''' Convert to MixedCase (And first letter to Lower) [Ex: aB Cd eF]
    ''' </summary>
    Public Shared Function MixedCase_First_Lower(ByVal Text As String) As String
        Dim MixedString As String = Nothing
        For X As Integer = 0 To Text.Length - 1
            Application.DoEvents()
            Dim c As Char = Text(X)
            If (X / 2).ToString.Contains(",") Then _
                 MixedString += c.ToString.ToUpper _
            Else MixedString += c.ToString.ToLower
        Next
        Return MixedString
    End Function

    ''' <summary>
    ''' Convert to MixedCase (And first letter to Upper) [Ex: Ab cD Ef]
    ''' </summary>
    Public Shared Function MixedCase_First_Upper(ByVal Text As String) As String
        Dim MixedString As String = Nothing
        For X As Integer = 0 To Text.Length - 1
            Application.DoEvents()
            Dim c As Char = Text(X)
            If (X / 2).ToString.Contains(",") Then _
                 MixedString += c.ToString.ToLower _
            Else MixedString += c.ToString.ToUpper
        Next
        Return MixedString
    End Function

    ''' <summary>
    ''' Convert to MixedCase (And first letter of each word to Lower) [Ex: aB cD eF]
    ''' </summary>
    Public Shared Function MixedCase_Word_Lower(ByVal Text As String) As String
        Dim MixedString As String = Nothing
        Dim Count As Integer = 1
        For X As Integer = 0 To Text.Length - 1
            Application.DoEvents()
            Dim c As Char = Text(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
    End Function

    ''' <summary>
    ''' Convert to MixedCase (And first letter of each word to Upper) [Ex: Ab Cd Ef]
    ''' </summary>
    Public Shared Function MixedCase_Word_Upper(ByVal Text As String) As String
        Dim MixedString As String = Nothing
        Dim Count As Integer = 1
        For X As Integer = 0 To Text.Length - 1
            Application.DoEvents()
            Dim c As Char = Text(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
    End Function

    ''' <summary>
    ''' Convert to DelimitedCase (And All letters to Lower) [Ex: ab-cd-ef]
    ''' </summary>
    Public Shared Function DelimitedCase_Lower(ByVal Text As String, Optional ByVal Delimiter As String = "-") As String
        Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
        Return rgx.Replace(Text.ToLower, Delimiter)
    End Function

    ''' <summary>
    ''' Convert to DelimitedCase (And All letters to Upper) [Ex: AB-CD-EF]
    ''' </summary>
    Public Shared Function DelimitedCase_Upper(ByVal Text As String, Optional ByVal Delimiter As String = "-") As String
        Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
        Return rgx.Replace(Text.ToUpper, Delimiter)
    End Function

    ''' <summary>
    ''' Convert to DelimitedCase (And first letter to Upper) [Ex: Ab-cd-ef]
    ''' </summary>
    Public Shared Function DelimitedCase_Title(ByVal Text As String, Optional ByVal Delimiter As String = "-") As String
        Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
        Return rgx.Replace(Char.ToUpper(Text(0)) + StrConv(Text.Substring(1), VbStrConv.Lowercase), Delimiter)
    End Function

    ''' <summary>
    ''' Convert to DelimitedCase (And first letter of each word to Lower) [Ex: aB-cD-eF]
    ''' </summary>
    Public Shared Function DelimitedCase_Mixed_Word_Lower(ByVal Text As String, Optional ByVal Delimiter As String = "-") As String
        Dim MixedString As String = Nothing
        Dim Count As Integer = 1
        For X As Integer = 0 To Text.Length - 1
            Application.DoEvents()
            Dim c As Char = Text(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)
    End Function

    ''' <summary>
    ''' Convert to DelimitedCase (And first letter of each word to Upper) [Ex: Ab-Cd-Ef]
    ''' </summary>
    Public Shared Function DelimitedCase_Mixed_Word_Upper(ByVal Text As String, Optional ByVal Delimiter As String = "-") As String
        Dim rgx As New System.Text.RegularExpressions.Regex("\s+")
        Return rgx.Replace(System.Globalization.CultureInfo.CurrentCulture.TextInfo.ToTitleCase(Text), Delimiter)
    End Function

    ''' <summary>
    ''' Covert string to InvertedCase [Ex: HeLLo -> hEllO ]
    ''' </summary>
    Public Shared Function InvertedCase(ByVal Text As String) As String
        Dim InvertedString As String = String.Empty

        For Each character In Text
            Application.DoEvents()
            If Char.IsUpper(character) Then
                InvertedString += character.ToString.ToLower
            Else : InvertedString += character.ToString.ToUpper
            End If
        Next

        Return InvertedString
    End Function

End Class

#End Region