#Region " Get Drives Info Function "
 
    ' [ Get Drives Info Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    '
    ' Dim CDROMS = Get_Drives_Info(DriveType.CDRom, True)
    ' For Each Drive_Info In Get_Drives_Info(DriveType.ALL, True, True, True, True, True, True) : MsgBox(Drive_Info) : Next
 
    Private Enum DriveType
        ALL
        CDRom = IO.DriveType.CDRom
        Fixed = IO.DriveType.Fixed
        Network = IO.DriveType.Network
        Ram = IO.DriveType.Ram
        Removable = IO.DriveType.Removable
        Unknown = IO.DriveType.Unknown
    End Enum
 
    Private Function Get_Drives_Info( _
       ByVal DriveType As DriveType, _
       ByVal Name As Boolean, _
       Optional ByVal Label As Boolean = False, _
       Optional ByVal Type As Boolean = False, _
       Optional ByVal Format As Boolean = False, _
       Optional ByVal Size As Boolean = False, _
       Optional ByVal FreeSpace As Boolean = False) As List(Of String)
 
        Dim Drive_Info_List As New List(Of String)
        Dim Drive_Info As String = Nothing
 
        For Each Drive In Microsoft.VisualBasic.FileIO.FileSystem.Drives
            If (DriveType = DriveType.ALL Or Drive.DriveType = DriveType) And (Drive.IsReady) Then
                If Drive.IsReady = True Then
                    If Name Then Drive_Info += Drive.Name & ";"
                    If Label Then Drive_Info += Drive.VolumeLabel & ";"
                    If Type Then Drive_Info += Drive.DriveType.ToString & ";"
                    If Format Then Drive_Info += Drive.DriveFormat & ";"
                    If Size Then Drive_Info += Drive.TotalSize.ToString & ";"
                    If FreeSpace Then Drive_Info += Drive.TotalFreeSpace & ";"
                End If
            End If
            If Drive_Info IsNot Nothing Then Drive_Info_List.Add(Drive_Info) : Drive_Info = Nothing
        Next
 
        Return Drive_Info_List
 
    End Function
 
#End Region

#Region " Monitorize Drives "
 
    ' Diccionario para guardar información (letra, información)
    Public CurrentDrives As New Dictionary(Of Char, DriveInfoGhost)
 
    Public Event DriveConnected(ByVal e As IO.DriveInfo)
    Public Event DriveDisconnected(ByVal e As DriveInfoGhost)
 
    ' Estructura que replica el contenido de DriveInfo
    Public Structure DriveInfoGhost
 
        Public Name As String
        Public AvailableFreeSpace As Long
        Public DriveFormat As String
        Public DriveType As IO.DriveType
        Public RootDirectory As String
        Public TotalFreeSpace As Long
        Public TotalSize As Long
        Public VolumeLabel As String
 
        Public Sub New(ByVal e As IO.DriveInfo)
            Name = e.Name
            AvailableFreeSpace = e.AvailableFreeSpace
            DriveFormat = e.DriveFormat
            DriveType = e.DriveType
            RootDirectory = e.RootDirectory.FullName
            TotalFreeSpace = e.TotalFreeSpace
            TotalSize = e.TotalSize
            VolumeLabel = e.VolumeLabel
        End Sub
 
    End Structure
 
    ' Estructura nativa de Windows para almacenar información de dispositivos
    Public Structure WindowsDrive
        Public Size As Integer
        Public Type As Integer
        Public Reserved As Integer
        Public Mask As Integer
    End Structure
 
    ' Constantes que necesitamos
    Public Enum ConstWindowsDrivers As Integer
        Change = &H219
        Arrival = &H8000
        QueryRemove = &H8001
        QueryRemoveFailed = &H8002
        RemovePending = &H8003
        RemoveComplete = &H8004
        TypeVolume = &H2
    End Enum
 
    Protected Overrides Sub WndProc(ByRef [Message] As Message)
 
        Select Case [Message].Msg ' Filtramos los mensajes
            Case ConstWindowsDrivers.Change ' Si el Hardware cambió
                ' Transformamos el puntero del primer parametro en una estructura de datos
                Dim CurrentWDrive As WindowsDrive = CType(System.Runtime.InteropServices.Marshal.PtrToStructure([Message].LParam, GetType(WindowsDrive)), WindowsDrive)
                ' Transformamos la estructura en información de la unidad
                Dim CurrentDrive As IO.DriveInfo = New IO.DriveInfo(GetDriveLetter(CurrentWDrive.Mask))
                ' El segundo parametros nos indica si se esta desconectando o conectando
                Select Case [Message].WParam.ToInt32
                    ' Se esta conectando...
                    Case ConstWindowsDrivers.Arrival
                        ' Si es un dispositivo de almacenamiento
                        If System.Runtime.InteropServices.Marshal.ReadInt32([Message].LParam, 4) = ConstWindowsDrivers.TypeVolume Then
                            ' Llamamos un evento que controla la conexión
                            RaiseEvent DriveConnected(CurrentDrive)
                            ' Guardamos la información del dispositivo en un diccionario fantasma (letra, información),
                            ' ya que cuando se desconecte habremos perdido toda la información,
                            ' sólamente nos quedara la letra de la unidad, con ella podremos volver a obtener la información a traves del diccionario'
                            CurrentDrives.Add(GetDriveLetter(CurrentWDrive.Mask), New DriveInfoGhost(CurrentDrive))
                        End If
                        ' Si es desconectado...
                    Case ConstWindowsDrivers.RemoveComplete
                        ' Llamamos al evento de desconexión con la información en el diccionario fantasma,
                        ' ya que no tenemos acceso a la información, porque el hardware ha sido desconectado
                        RaiseEvent DriveDisconnected(CurrentDrives(GetDriveLetter(CurrentWDrive.Mask)))
                        ' Removemos el hardware del diccionario
                        CurrentDrives.Remove(GetDriveLetter(CurrentWDrive.Mask))
                End Select
        End Select
 
        MyBase.WndProc([Message])
 
    End Sub
 
    ' Nos traduce el código de los parametros a letras
    Private Function GetDriveLetter(ByVal Mask As Integer) As Char
 
        Dim Names() As Char = {"A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z"}
        Dim Devices As New BitArray(System.BitConverter.GetBytes(Mask))
 
        For x As Integer = 0 To Devices.Length
            If Devices(x) Then
                Return Names(x)
            End If
        Next
 
    End Function
 
    ' Eventos
 
    Private Sub Main_DriveConnected(ByVal e As System.IO.DriveInfo) Handles Me.DriveConnected
        MessageBox.Show(String.Format("Se ha conectado la unidad {0}", e.Name))
    End Sub
 
    Private Sub Main_DriveDisconnected(ByVal e As DriveInfoGhost) Handles Me.DriveDisconnected
        MessageBox.Show(String.Format("Se ha desconectado la unidad {0}", e.Name))
    End Sub
 
#End Region

Imports System.IO
Imports System.Threading
 
Public Class Inicio
 
    Private Drives() As DriveInfo
    Private Delegate Sub ListenToUSB()
    Private Delegate Sub UpdateListBoxText(ByVal Text As String)
    Private Delegate Sub MonitorizeUSB(ByVal Drive As DriveInfo)
 
    Private Sub ListenToRemovableDrives()
        'Mejor crear 1 sola variable que ochocientas mil e ir actualizándola periodicamente
        Dim connectedDrives As DriveInfo() = Nothing
        While True
            connectedDrives = DriveInfo.GetDrives()
            For Each drive As DriveInfo In connectedDrives
                IsRemovableDrive(drive)
            Next
            'Aquí indica el tiempo que quieres que espere el proceso de escucha para después volver a comenzar
            Thread.Sleep(2500)
        End While
    End Sub
    Private Sub IsRemovableDrive(ByVal Drive As DriveInfo)
        If Drive.IsReady And Drive.DriveType = DriveType.Removable Then
            IsDriveMonitorized(Drive)
        End If
    End Sub
    Private Function GetDrivePosInArray(ByVal Drive As DriveInfo) As Int32
        Dim isInList As Boolean = False
        Dim i As Int32 = 0
        Do
            If Not IsNothing(CType(Drives(i), Object)) Then
                If Drives(i).Name = Drive.Name Then
                    isInList = True
                End If
            End If
            i += 1
        Loop Until isInList Or i >= Drives.Length - 1
        Return i - 1
    End Function
    Private Function IsDriveInList(ByVal Drive As DriveInfo) As Boolean
        Dim isInList As Boolean = False
        Dim i As Int32 = 0
        Do
            If Not IsNothing(CType(Drives(i), Object)) Then
                If Drives(i).Name = Drive.Name Then
                    isInList = True
                End If
            End If
            i += 1
        Loop Until isInList Or i >= Drives.Length - 1
        Return isInList
    End Function
    Private Sub IsDriveMonitorized(ByVal Drive As DriveInfo)
        If Not IsDriveInList(Drive) Then
            'Como la unidad USB no está siendo monitorizada por otro subproceso
            'Añadimos sus características al ListBox
            ListBox1.BeginInvoke(New UpdateListBoxText(AddressOf UpdateLstBoxText), _
                                 New Object() {"Se ha conectado una nueva Memoria USB en " & Drive.Name})
            Drives(Drives.Length - 1) = Drive
            Array.Resize(Drives, Drives.Length + 1)
            'Monitorizamos la unidad USB
            Dim delegado As New MonitorizeUSB(AddressOf MonitorizeDrive)
            delegado.BeginInvoke(Drive, Nothing, Nothing)
        End If
    End Sub
    Private Sub MonitorizeDrive(ByVal Drive As DriveInfo)
        Dim Removed As Boolean = False
        While Not Removed
            If Not Drive.IsReady Then
                Removed = True
                Dim pos As Int32 = GetDrivePosInArray(Drive)
                ReOrganizeArray(pos)
                ListBox1.BeginInvoke(New UpdateListBoxText(AddressOf UpdateLstBoxText), _
                     New Object() {"La unidad USB " & Drive.Name & " fue extraída."})
            End If
        End While
    End Sub
    Private Sub ReOrganizeArray(ByVal pos As Int32)
        'Eliminamos el elemento rotando el Array hacia la izquierda
        Drives(pos) = Nothing
        Array.Resize(Drives, Drives.Length - 1)
    End Sub
    Private Sub UpdateLstBoxText(ByVal Text As String)
        ListBox1.Items.Add(Text)
    End Sub
 
    Private Sub Inicio_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        Drives = New DriveInfo(0) {}
        Dim delegado As New ListenToUSB(AddressOf ListenToRemovableDrives)
        delegado.BeginInvoke(Nothing, Nothing)
    End Sub
 
End Class

#Region " Hex to Byte-Array Function "
 
    ' [ Hex to Byte-Array Function ]
    '
    ' Examples :
    ' Dim Byte_Array = Hex_to_Byte_Array("000a42494c4c2047415445535ad50adc4f5ca6f9efc1252aadf9847f")
    ' My.Computer.Registry.SetValue("HKEY_CURRENT_USER\Software\KEYNAME", "VALUENAME", Byte_Array, Microsoft.Win32.RegistryValueKind.Binary)
 
    Private Function Hex_to_Byte_Array(ByVal HEX_String As String) As Byte()
        Dim Bytes_Array((HEX_String.Length \ 2) - 1) As Byte
        For i As Integer = 0 To HEX_String.Length - 1 Step 2
            Dim HEX_Byte As String = HEX_String.Substring(i, 2)
            Dim Byte_Value As Byte = Byte.Parse(HEX_Byte, Globalization.NumberStyles.AllowHexSpecifier)
            Bytes_Array(i \ 2) = Byte_Value
        Next
        Return Bytes_Array
    End Function
 
#End Region

#Region " Set TaskBar Status Function "
 
    ' [ Set TaskBar Status Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' Set_TaskBar_Status(TaskBar_Status.Paused)
 
    Public Enum TaskBar_Status
        Normal = 2     ' Blue
        Stopped = 4    ' Red
        Paused = 8     ' Yellow
        Disabled = 0   ' No colour
        Undefinied = 1 ' Marquee
    End Enum
 
    Private Function Set_TaskBar_Status(ByVal TaskBar_Status As TaskBar_Status) As Boolean
        Try : Microsoft.WindowsAPICodePack.Taskbar.TaskbarManager.Instance.SetProgressState(TaskBar_Status)
            Return True
        Catch ex As Exception : Throw New Exception(ex.Message)
        End Try
    End Function
 
#End Region

#Region " Set TaskBar Value Function "
 
    ' [ Set TaskBar Value Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' Set_TaskBar_Value(50, 100)
 
    Private Function Set_TaskBar_Value(ByVal Current_Value As Integer, ByVal MAX_Value As Integer) As Boolean
        Try : Microsoft.WindowsAPICodePack.Taskbar.TaskbarManager.Instance.SetProgressValue(Current_Value, MAX_Value)
            Return True
        Catch ex As Exception : Throw New Exception(ex.Message)
        End Try
    End Function
 
#End Region

#Region " Get Master Volume Function "
 
    ' [ Get Master Volume Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' Dim Volume As Integer = Get_Master_Volume(Volume_Measure.As_Integer)
    ' Dim Volume As String = Get_Master_Volume(Volume_Measure.As_Percent)
 
    Public Enum Volume_Measure
        As_Integer
        As_Decimal
        As_Single
        As_Percent
    End Enum
 
    Private Function Get_Master_Volume(ByVal Volume_Measure As Volume_Measure)
       Select Case Volume_Measure
            Case Form1.Volume_Measure.As_Integer : Return CInt(Audio_Device.AudioEndpointVolume.MasterVolumeLevelScalar * 100)
            Case Form1.Volume_Measure.As_Decimal : Return (String.Format("{0:n2}", Audio_Device.AudioEndpointVolume.MasterVolumeLevelScalar))
            Case Form1.Volume_Measure.As_Single : Return CSng(Audio_Device.AudioEndpointVolume.MasterVolumeLevelScalar)
            Case Form1.Volume_Measure.As_Percent : Return CInt(Audio_Device.AudioEndpointVolume.MasterVolumeLevelScalar * 100) & "%"
            Case Else : Return Nothing
        End Select
    End Function
 
#End Region

#Region " Set Master Volume Function "
 
    ' [ Set Master Volume Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' Set_Master_Volume(50)
 
    Private Function Set_Master_Volume(ByVal Value As Integer) As Boolean
        Try : Audio_Device.AudioEndpointVolume.MasterVolumeLevelScalar = (Value / 100)
            Return True
        Catch ex As Exception : Throw New Exception(ex.Message)
        End Try
    End Function
 
#End Region

#Region " Mute Master Volume Function "
 
    ' [ Mute Master Volume Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' Mute_Master_Volume(False)
    ' Mute_Master_Volume(True)
 
    Private Function Set_Master_Volume(ByVal Mute As Boolean) As Boolean
        Try : Audio_Device.AudioEndpointVolume.Mute = Mute
            Return True
        Catch ex As Exception : Throw New Exception(ex.Message)
        End Try
    End Function
 
#End Region

Fade_Master_Volume(Desde el volumen, Hasta el volumen, En "X" Milisegundos, Forzar/NoForzar el devanecimiento)

#Region " Fade Master Volume Function "
 
    ' [ Fade Master Volume Function ]
    '
    ' // By Elektro H@cker
    '
    ' Examples :
    ' Fade_Master_Volume(0, 100, 5000, Fading_Mode.FadeIN, True)
    ' Fade_Master_Volume(80, 20, 5000, Fading_Mode.FadeOUT, False)
    ' Fade_Master_Volume(10, 50, 5000, Fading_Mode.None, True)
 
    Dim Fade_Value_MIN As Integer
    Dim Fade_Value_MAX As Integer
    Dim Fade_TimeOut As Long
    Dim Fade_Mode As Fading_Mode
    Dim Force_Fading As Boolean
    Dim Fader_Timer As New Timer
 
    Public Enum Fading_Mode
        FadeIN = 0
        FadeOUT = 1
        None = 2
    End Enum
 
    ' Fade Master Volume Function
    Private Function Fade_Master_Volume(ByVal MIN As Integer, ByVal MAX As Integer, ByVal Milliseconds As Long, ByVal Mode As Fading_Mode, ByVal Force As Boolean) As Boolean
 
        If MIN <= 100 And MIN >= 0 And MAX <= 100 And MAX >= 0 Then
 
            Try
 
                Fade_Value_MIN = MIN
                Fade_Value_MAX = MAX
                Fade_TimeOut = Milliseconds
                Fade_Mode = Mode
                Force_Fading = Force
 
                Fader_Timer = New Timer
                AddHandler Fader_Timer.Tick, AddressOf Fade_Master_Volume_Timer_Tick
 
                Select Case Mode
                    Case Fading_Mode.FadeIN : Fader_Timer.Interval = Milliseconds / (MAX - MIN)
                    Case Fading_Mode.FadeOUT : Fader_Timer.Interval = Milliseconds / (MIN - MAX)
                    Case Fading_Mode.None : Fader_Timer.Interval = Milliseconds
                End Select
 
                Fader_Timer.Enabled = True
                Return True
 
            Catch ex As Exception : Throw New Exception(ex.Message)
            End Try
 
        Else
            Throw New Exception("Number is not in range from 0 to 100")
        End If
 
    End Function
 
    ' Fade Master Volume Timer Tick Event
    Private Sub Fade_Master_Volume_Timer_Tick(sender As Object, e As EventArgs)
 
        Dim Current_Vol As Integer = CInt(Audio_Device.AudioEndpointVolume.MasterVolumeLevelScalar * 100)
 
        Select Case Fade_Mode
 
            Case Fading_Mode.FadeOUT
                If Not Force_Fading Then
                    If Not Current_Vol <= Fade_Value_MAX Then : Audio_Device.AudioEndpointVolume.MasterVolumeLevelScalar -= 0.01
                    ElseIf Current_Vol >= Fade_Value_MAX Then : Fader_Timer.Stop() : Fader_Timer.Enabled = False
                    End If
                ElseIf Force_Fading Then
                    If Not Fade_Value_MIN < Fade_Value_MAX Then
                        Audio_Device.AudioEndpointVolume.MasterVolumeLevelScalar = (Fade_Value_MIN / 100)
                        Fade_Value_MIN -= 1
                    Else : Fader_Timer.Stop() : Fader_Timer.Enabled = False
                    End If
                End If
 
            Case Fading_Mode.FadeIN
                If Not Force_Fading Then
                    If Not Current_Vol >= Fade_Value_MAX Then : Audio_Device.AudioEndpointVolume.MasterVolumeLevelScalar += 0.01
                    ElseIf Current_Vol <= Fade_Value_MAX Then : Fader_Timer.Stop() : Fader_Timer.Enabled = False
                    End If
                ElseIf Force_Fading Then
                    If Not Fade_Value_MIN > Fade_Value_MAX Then
                        Audio_Device.AudioEndpointVolume.MasterVolumeLevelScalar = (Fade_Value_MIN / 100)
                        Fade_Value_MIN += 1
                    Else : Fader_Timer.Stop() : Fader_Timer.Enabled = False
                    End If
                End If
 
            Case Fading_Mode.None
                Audio_Device.AudioEndpointVolume.MasterVolumeLevelScalar = Fade_Value_MAX
                Fader_Timer.Stop() : Fader_Timer.Enabled = False
 
        End Select
 
    End Sub
 
#End Region

#Region " Get OS Edition Function "
 
    ' [ Get OS Edition Function ]
    '
    ' Examples :
    ' Dim Edition As String = Get_OS_Edition()
    ' MsgBox("You are running Windows " & Get_OS_Edition() & " Edition")
 
    Private Const STARTER As Integer = &HB
    Private Const HOME_BASIC As Integer = &H2
    Private Const HOME_BASIC_N As Integer = &H5
    Private Const HOME_PREMIUM As Integer = &H3
    Private Const HOME_PREMIUM_N As Integer = &H1A
    Private Const BUSINESS As Integer = &H6
    Private Const BUSINESS_N As Integer = &H10
    Private Const ENTERPRISE As Integer = &H4
    Private Const ENTERPRISE_N As Integer = &H1B
    Private Const ULTIMATE As Integer = &H1
    Private Const ULTIMATE_N As Integer = &H1C
 
    Private Declare Function GetProductInfo Lib "kernel32" (ByVal dwOSMajorVersion As Integer, ByVal dwOSMinorVersion As Integer, ByVal dwSpMajorVersion As Integer, ByVal dwSpMinorVersion As Integer, ByRef pdwReturnedProductType As Integer) As Integer
 
    Public Function Get_OS_Edition() As String
        Dim Edition_Type As Integer
        If GetProductInfo(Environment.OSVersion.Version.Major, Environment.OSVersion.Version.Minor, 0, 0, Edition_Type) Then
            Select Case Edition_Type
                Case STARTER : Return "Starter"
                Case HOME_BASIC : Return "Home Basic"
                Case HOME_BASIC_N : Return "Home Basic N"
                Case HOME_PREMIUM : Return "Home Premium"
                Case HOME_PREMIUM_N : Return "Home Premium N"
                Case BUSINESS : Return "Business"
                Case BUSINESS_N : Return "Business N"
                Case ENTERPRISE : Return "Enterprise"
                Case ENTERPRISE_N : Return "Enterprise N"
                Case ULTIMATE : Return "Ultimate"
                Case ULTIMATE_N : Return "Ultimate N"
                Case Else : Return "Unknown"
            End Select
        End If
        Return Nothing ' Windows is not VISTA or Higher
    End Function
 
#End Region

 Private Function CheckDate(ByVal dateToCheck As Date) As Boolean
        'In reality, CheckDate would get the date (current date) itself and not have it passed in
        Dim retValue As Boolean = False 'Fail safe, default to false
        Dim usageDatesLeft As Int16 = 3 ' set it to 4 just for testing
        'Dim usageDatesLeft As Int16 = 30 ' set this to the number of days of application access
 
        'Hash the date
        Dim hashedDate As String = HashDate(dateToCheck)
        'Check to see if the hash value exists in the UsageDates
 
        'Initialize the container if necessary
        If My.Settings.UsageDates Is Nothing Then
            My.Settings.UsageDates = New System.Collections.Specialized.StringCollection
        End If
 
        If My.Settings.UsageDates.Contains(hashedDate) Then
            'then we are ok...  it's already been checked
            retValue = True
            usageDatesLeft = CShort(usageDatesLeft - My.Settings.UsageDates.Count)
 
            'sanity check... if the system date is backed up to a previous date in the list, but not the last date
            If usageDatesLeft <= 0 AndAlso My.Settings.UsageDates.IndexOf(hashedDate) <> My.Settings.UsageDates.Count - 1 Then
                retValue = False
            End If
        Else
            If My.Settings.UsageDates.Count < usageDatesLeft Then
                My.Settings.UsageDates.Add(hashedDate)
            End If
            usageDatesLeft = CShort(usageDatesLeft - My.Settings.UsageDates.Count)
 
 
            'If not, and the remining count has "slots" open, add it
            If usageDatesLeft > 0 Then
                retValue = True
            Else
                'If not and tree are no more slots, tell user, exit app
                retValue = False
            End If
 
        End If
        'Display to the user how many days are remianing:
        MessageBox.Show(String.Format("You have {0} day(s) remaining.", usageDatesLeft))
 
        Return retValue
    End Function
 
    Private Function HashDate(ByVal dateToHash As Date) As String
        'Get a hash object
        Dim hasher As System.Security.Cryptography.MD5 = System.Security.Cryptography.MD5.Create()
        'Take date, make it a Long date and hash it
        Dim data As Byte() = hasher.ComputeHash(System.Text.Encoding.Default.GetBytes(dateToHash.ToLongDateString()))
        ' Create a new Stringbuilder to collect the bytes
        ' and create a string.
        Dim sBuilder As New System.Text.StringBuilder()
 
        ' Loop through each byte of the hashed data
        ' and format each one as a hexadecimal string.
        Dim idx As Integer
        For idx = 0 To data.Length - 1
            sBuilder.Append(data(idx).ToString("x2"))
        Next idx
 
        Return sBuilder.ToString
 
    End Function

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

#Region " Trial Period Function "
 
    ' [ Trial Period Function ]
    '
    ' Examples :
    ' Trial_Get(Trial_value.As_Boolean)
    ' MsgBox(String.Format("You have {0} day(s) remaining.", Trial_Get(Trial_value.As_LeftDays)))
 
    Public Enum Trial_value
        As_Boolean
        As_LeftDays
        As_CountDays
    End Enum
 
    ' Trial Period [Get]
    Public Function Trial_Get(ByVal Trial_value As Trial_value)
        'My.Settings.Reset() 'If you want to reset the trial period
        Dim TrialCount As Integer = 0
        TrialCount += 1
        Return Trial_CheckDate(Date.Now.AddDays(TrialCount), Trial_value)
    End Function
 
    ' Trial Period [CheckDate]
    Public Function Trial_CheckDate(ByVal Trial_DateToCheck As Date, ByVal Trial_value As Trial_value)
 
        Dim Trial_retValue As Boolean = False ' Fail safe, default to false
        Dim Trial_usageDatesLeft As Int16 = 7 ' Set here the number of days of Trial period
        Dim Trial_hashedDate As String = Trial_HashDate(Trial_DateToCheck)
 
        If My.Settings.Trial_Period Is Nothing Then My.Settings.Trial_Period = New System.Collections.Specialized.StringCollection
 
        If My.Settings.Trial_Period.Contains(Trial_hashedDate) Then
            Trial_retValue = True
            Trial_usageDatesLeft = CShort(Trial_usageDatesLeft - My.Settings.Trial_Period.Count)
            If Trial_usageDatesLeft <= 0 AndAlso My.Settings.Trial_Period.IndexOf(Trial_hashedDate) <> My.Settings.Trial_Period.Count - 1 Then Trial_retValue = False
        Else
            If My.Settings.Trial_Period.Count < Trial_usageDatesLeft Then My.Settings.Trial_Period.Add(Trial_hashedDate)
            Trial_usageDatesLeft = CShort(Trial_usageDatesLeft - My.Settings.Trial_Period.Count)
            If Trial_usageDatesLeft > 0 Then Trial_retValue = True Else Trial_retValue = False
        End If
 
        Select Case Trial_value
            Case Trial_value.As_Boolean : Return Trial_retValue ' If False then Trial Period is expired
            Case Trial_value.As_LeftDays : Return Trial_usageDatesLeft ' Days left
            Case Trial_value.As_CountDays : Return My.Settings.Trial_Period.Count ' Count days
            Case Else : Return Nothing
        End Select
 
    End Function
 
    ' Trial Period [HashDate]
    Public Function Trial_HashDate(ByVal Trial_DateToHash As Date) As String
        Dim Trial_Hasher As System.Security.Cryptography.MD5 = System.Security.Cryptography.MD5.Create()
        Dim Trial_Data As Byte() = Trial_Hasher.ComputeHash(System.Text.Encoding.Default.GetBytes(Trial_DateToHash.ToLongDateString()))
        Dim Trial_StringBuilder As New System.Text.StringBuilder()
        Dim Trial_IDX As Integer
        For Trial_IDX = 0 To Trial_Data.Length - 1 : Trial_StringBuilder.Append(Trial_Data(Trial_IDX).ToString("x2")) : Next Trial_IDX
        Return Trial_StringBuilder.ToString
    End Function
 
#End Region