'RecursiveFolders                   'Returns an arraylist of all subfolders within a specified folder.
'RecursiveFiles                     'Returns an arraylist of all files,(with path), within a folder structure.
'EncryptDecryptFile                 'Encrypts or Decrypts Files.
'EncryptString                      'Returns an encrypted string. 
'DecryptString                      'Returns a decrypted string.
'Right                              'Returns the right portion of a string.
'AppPath                            'Returns the application path as a string.
'FolderBrowser                      'Returns a "browsed to" folder.
'PreviousInstance                   'Returns True if there is a previous instance of the appliation running.
'ReplacePhrase                      'Returns a text string with words or phrases replaced in it.
Imports System.IO

'*** EncrytDecrypt Class **************************
Imports System.Security.Cryptography
Imports System.Text         'for UnicodeEncoding
Imports System.Threading    'for Thread.Sleep
'**************************************************

'********** FolderBrowser Class *************
Imports System.Runtime.InteropServices
Imports System.Diagnostics
'*******************************************


Module FunctionsAndSubs

    '*******************************************************************************************************
    Function RecursiveFolders(ByVal vPath As String) As ArrayList
        'Sample: 
        '      Dim myAL As New ArrayList()
        '      myAL = RecursiveFolders("c:\program files\")
        '      Dim i As Integer
        '      For i = 0 To myAL.Count - 1
        '        MsgBox(myAL(i))
        '      Next
        '*****************************************************
        Dim strSourcePath As String = vPath
        Dim intCounter As Integer = 0
        'for string list
        Dim lstStringFolders As New ArrayList()
        Dim strSubFolders As String()
        'for sorted object list
        Dim lstSortedFolders As New ArrayList()
        'seed string list
        lstStringFolders.Add(strSourcePath)
        'as a string list - just gives you a list of the folders that exist in the path
        Do Until intCounter = lstStringFolders.Count
            strSubFolders = System.IO.Directory.GetDirectories(lstStringFolders.Item(intCounter))
            lstStringFolders.AddRange(strSubFolders)
            intCounter += 1
        Loop
        'sorts the folders so that related folders (parent/child) are together
        lstStringFolders.Sort()
        RecursiveFolders = lstStringFolders
        Return RecursiveFolders
    End Function
    '*****************************************************************************************************

    '*******************************************************************************************************
    Function RecursiveFiles(ByVal vPath As String) As ArrayList
        'Sample: 
        '        Dim alst As ArrayList
        '        alst = RecursiveFiles("c:\program files\")
        '        Dim i As Integer
        '        For i = 0 To alst.Count - 1
        '         If InStr(UCase(alst(i)), "EXCEL.EXE") > 0 Then
        '            MsgBox("Found " & alst(i))
        '         End If
        '        Next
        '*****************************************************
        Dim strSourcePath As String = vPath
        Dim intCounter As Integer = 0
        Dim lstFiles As New ArrayList()
        'for string list
        Dim lstStringFolders As New ArrayList()
        Dim strSubFolders As String()
        'for sorted object list
        Dim lstSortedFolders As New ArrayList()
        'seed string list
        lstStringFolders.Add(strSourcePath)
        'as a string list - just gives you a list of the folders that exist in the path
        Do Until intCounter = lstStringFolders.Count
            Try
                strSubFolders = System.IO.Directory.GetDirectories(lstStringFolders.Item(intCounter))
                lstStringFolders.AddRange(strSubFolders)
            Catch
                'Skipt
            End Try

            intCounter += 1
        Loop

        'sorts the folders so that related folders (parent/child) are together
        lstStringFolders.Sort()

        For intCounter = 0 To lstStringFolders.Count - 1
            Try
                lstFiles.AddRange(System.IO.Directory.GetFiles(lstStringFolders(intCounter)))
            Catch
                'Do nothing
            End Try
        Next
        Return lstFiles
    End Function
    '*****************************************************************************************************


    '*****************************************************************************************************
    '===  Class Name:   EncryptDecrypt  =============================================
    '    Description:   Cryptography class for encrypting Files, Strings, Streams
    '        Project:   Cryptography Component - VSM Getting Started, January 2003
    '   Date Created:   2002.08.28
    '	Code Copyright © 2002 by Stan Schultes, All Rights Reserved.
    '
    '      Revision History
    '   Who     Date		CodeVersion - Comments
    '
    '   Discussion:
    '- This VB.NET component encrypts/decrypts files, strings, and streams, and 
    '   provides password validation via hashing.
    '- Crypto Service Providers for Encryption/Decryption:
    '   . DES: blocksize=64, keysize=64, IV=64 bits=8 bytes
    '   . RC2: blocksize=64, keysize=40-128 x8 def=128, IV=64 bits
    '   . TripleDES: blocksize=64, keysize=128-192 x64 def=192, IV=64 bits
    '   . Rijndael: blocksize=128-256 x64 def=128, keysize=128-256 x64 def=256, IV=128 bits
    '- Crypto Service Providers for hashing:
    '   . MD5: HashSize = 128 bits (16 bytes)
    '   . SHA1: 160 bits (20 bytes)
    '   . SHA256: 256 bits (32 bytes)
    '   . SHA384: 384 bits (48 bytes)
    '   . SHA512: 512 bits (64 bytes)
    '
    '==========================================================================

    Public Class EncryptDecryptFile
        'Sample:
        '    Encrypt A File *******************************************************
        '       Dim MyPassWord As String
        '       MyPassWord = "HoopDeDoo!"
        '       Dim oCrypt As New EncryptDecryptFile(MyPassWord)
        '       Dim b As Boolean
        '       b = oCrypt.EncryptFile("C:\autoexec.bat", "c:\autoexec.bat.enc")

        '   Decrypt A File  *******************************************************
        '       Dim MyPassWord2 As String
        '       MyPassWord2 = "HoopDeDoo!"
        '       Dim oCrypt2 As New EncryptDecryptFile(MyPassWord2)
        '       b = oCrypt.DecryptFile("C:\autoexec.bat.enc", "c:\Unencrypted.txt")
        '**************************************************************************
        Private Const CodeVersion As String = "01.00.00"

        'class member variables
        Private m_sPassPhrase As String

        'class private variables
        Private mbytKey() As Byte      'crypto key
        Private mbytIV() As Byte       'Initialization Vector 
        Private mbKeyIsSet As Boolean = False
        Private mksKeyNotSetException As String = "Crypto passphrase is not set."
        Private mksPassphraseTooSmall As String = "PassPhrase length must be at least {0} characters."

        '--- class constructors

        Public Sub New()
            'no passphrase is useful for GetHashString/ValidPassword methods
        End Sub

        Public Sub New(ByVal CryptoPassPhrase As String)
            PassPhrase = CryptoPassPhrase
        End Sub

        '--- class public properties

        'generate and store encryption key & iv from passphrase
        Public Property PassPhrase() As String
            Get
                Return m_sPassPhrase
            End Get
            Set(ByVal Value As String)
                Const iMinLength As Integer = -1    '-1 disables min length
                m_sPassPhrase = Value.Trim
                'enforce a rule on minimum length if desired here
                If (Value.Length > iMinLength) Or (iMinLength = -1) Then
                    Dim sha2 As New SHA256Managed()
                    '256 bits = 32 byte key
                    mbytKey = sha2.ComputeHash(BytesFromString(m_sPassPhrase))
                    'convert to Base64 for Initialization Vector, take last 16 chars
                    Dim sKey As String = Convert.ToBase64String(mbytKey)
                    mbytIV = Encoding.ASCII.GetBytes(sKey.Remove(0, sKey.Length - 16))
                    mbKeyIsSet = True
                    sha2 = Nothing
                Else
                    mbKeyIsSet = False
                    Throw New Exception(String.Format(mksPassphraseTooSmall, (iMinLength + 1).ToString))
                End If
            End Set
        End Property

        '--- class public methods

        'decrypt a file - replaces input file
        Public Function DecryptFile(ByVal TargetFile As String) As Boolean
            If mbKeyIsSet Then
                Return _DecryptFile(TargetFile, TargetFile)
            Else
                Throw New Exception(mksKeyNotSetException)
            End If
        End Function

        'decrypt a file - separate output file
        Public Function DecryptFile(ByVal EncryptedFile As String, ByVal PlainFile As String) As Boolean
            If mbKeyIsSet Then
                Return _DecryptFile(EncryptedFile, PlainFile)
            Else
                Throw New Exception(mksKeyNotSetException)
            End If
        End Function

        'decrypt a stream
        Public Function DecryptStream(ByVal EncryptedStream As MemoryStream) As MemoryStream
            If mbKeyIsSet Then
                Try
                    'create Crypto Service Provider, set key, transform and crypto stream
                    Dim oCSP As New RijndaelManaged()
                    oCSP.Key = mbytKey
                    oCSP.IV = mbytIV
                    Dim ct As ICryptoTransform = oCSP.CreateDecryptor()
                    Dim cs As CryptoStream = New CryptoStream(EncryptedStream, ct, CryptoStreamMode.Read)
                    'get bytes from encrypted stream
                    Dim byteArray(EncryptedStream.Length - 1) As Byte
                    Dim iBytesIn As Integer = cs.Read(byteArray, 0, EncryptedStream.Length)
                    cs.Close()
                    'create and write the decrypted output stream
                    Dim plainStream As New MemoryStream()
                    plainStream.Write(byteArray, 0, iBytesIn)
                    Return plainStream
                Catch ex As Exception
                    Debug.WriteLine("DecryptStream Error: " & ex.ToString)
                    Return Stream.Null
                End Try
            Else
                Throw New Exception(mksKeyNotSetException)
            End If
        End Function

        'decrypt a string - wrapper without Base64 flag (True by default)
        Public Function DecryptString(ByVal EncryptedString As String) As String
            If mbKeyIsSet Then
                Return _DecryptString(EncryptedString, True)
            Else
                Throw New Exception(mksKeyNotSetException)
            End If
        End Function

        'decrypt a string - wrapper with Base64 flag
        Public Function DecryptString(ByVal EncryptedString As String, ByVal Base64 As Boolean) As String
            If mbKeyIsSet Then
                Return _DecryptString(EncryptedString, Base64)
            Else
                Throw New Exception(mksKeyNotSetException)
            End If
        End Function

        'encrypt a file - replaces input file
        Public Function EncryptFile(ByVal TargetFile As String) As Boolean
            If mbKeyIsSet Then
                Return _EncryptFile(TargetFile, TargetFile)
            Else
                Throw New Exception(mksKeyNotSetException)
            End If
        End Function

        'encrypt a file - separate output file
        Public Function EncryptFile(ByVal PlainFile As String, ByVal EncryptedFile As String) As Boolean
            If mbKeyIsSet Then
                Return _EncryptFile(PlainFile, EncryptedFile)
            Else
                Throw New Exception(mksKeyNotSetException)
            End If
        End Function

        'encrypt a stream
        Public Function EncryptStream(ByVal PlainStream As MemoryStream) As MemoryStream
            If mbKeyIsSet Then
                Try
                    'open stream for encrypted data
                    Dim encStream As New MemoryStream()
                    'create Crypto Service Provider, set key, transform and crypto stream
                    Dim oCSP As New RijndaelManaged()
                    oCSP.Key = mbytKey
                    oCSP.IV = mbytIV
                    Dim ct As ICryptoTransform = oCSP.CreateEncryptor()
                    Dim cs As CryptoStream = New CryptoStream(encStream, ct, CryptoStreamMode.Write)
                    'get input stream into byte array
                    Dim byteArray() As Byte = PlainStream.ToArray()
                    'write input bytes to crypto stream and close up
                    cs.Write(byteArray, 0, PlainStream.Length)
                    cs.FlushFinalBlock()
                    cs.Close()
                    Return encStream
                Catch ex As Exception
                    Debug.WriteLine("EncryptStream Error: " & ex.ToString)
                    Return Stream.Null
                End Try
            Else
                Throw New Exception(mksKeyNotSetException)
            End If
        End Function

        'encrypt a string - wrapper without Base64 flag (True by default)
        Public Function EncryptString(ByVal PlainText As String) As String
            If mbKeyIsSet Then
                Return _EncryptString(PlainText, True)
            Else
                Throw New Exception(mksKeyNotSetException)
            End If
        End Function

        'encrypt a string - wrapper with Base64 flag 
        Public Function EncryptString(ByVal PlainText As String, ByVal Base64 As Boolean) As String
            If mbKeyIsSet Then
                Return _EncryptString(PlainText, Base64)
            Else
                Throw New Exception(mksKeyNotSetException)
            End If
        End Function

        'calculates the hash of InputValue, returns a string
        '- SHA1 hash is always 20 bytes (160 bits)
        Public Function GetHashString(ByVal InputValue As String) As String
            Try
                Dim inputBytes() As Byte = BytesFromString(InputValue)
                Dim hashValue() As Byte = New SHA1Managed().ComputeHash(inputBytes)
                Return BytesToHexString(hashValue)
            Catch ex As Exception
                Debug.WriteLine("GetHashString Error: " & ex.ToString)
                Return String.Empty
            End Try
        End Function

        'returns True if hash of Passphrase matches HashValue
        Public Function ValidPassword(ByVal Passphrase As String, ByVal HashValue As String) As Boolean
            Return (GetHashString(Passphrase) = HashValue)
        End Function

        '--- class private methods

        'internal file decryption method
        Private Function _DecryptFile(ByVal EncryptedFile As String, ByVal PlainFile As String) As Boolean
            Try
                'set flag for replacement if filenames are the same, open input file
                Dim bReplaceFile As Boolean = (EncryptedFile.ToLower.Trim = _
                    PlainFile.ToLower.Trim)
                Dim fsIn As FileStream = File.OpenRead(EncryptedFile)
                'create Crypto Service Provider, set key, transform and crypto stream
                Dim oCSP As New RijndaelManaged()
                oCSP.Key = mbytKey
                oCSP.IV = mbytIV
                Dim ct As ICryptoTransform = oCSP.CreateDecryptor()
                Dim cs As CryptoStream = New CryptoStream(fsIn, ct, _
                    CryptoStreamMode.Read)
                'get bytes from encrypted file
                Dim bytesPlain(fsIn.Length - 1) As Byte
                Dim iBytesIn As Integer = cs.Read(bytesPlain, 0, fsIn.Length)
                cs.Close()
                fsIn.Close()
                'create and write the decrypted output file
                Dim sPlainFile As String
                If bReplaceFile Then
                    'file is in Windows Temp dir
                    sPlainFile = Path.GetTempFileName()
                Else
                    sPlainFile = PlainFile
                End If
                Dim fsOut As FileStream = File.OpenWrite(sPlainFile)
                fsOut.Write(bytesPlain, 0, iBytesIn)
                fsOut.Close()
                'replace input file if flag set
                If bReplaceFile Then
                    Return ReplaceFile(sPlainFile, EncryptedFile)
                Else
                    Return True
                End If
            Catch ex As Exception
                Debug.WriteLine("_DecryptFile Error: " & ex.ToString)
                Return False
            End Try
        End Function

        'internal string decryption
        Private Function _DecryptString(ByVal EncryptedString As String, ByVal Base64 As Boolean) As String
            Try
                'put string in byte array depending on Base64 flag
                Dim byteArray() As Byte
                If Base64 Then
                    byteArray = Convert.FromBase64String(EncryptedString)
                Else
                    byteArray = BytesFromString(EncryptedString)
                End If
                'create the streams, decrypt and return a string
                Dim msEnc As New MemoryStream(byteArray)
                Dim msPlain As MemoryStream = DecryptStream(msEnc)
                Return BytesToString(msPlain.GetBuffer)
            Catch ex As Exception
                Debug.WriteLine("_DecryptString Error: " & ex.ToString)
                Return String.Empty
            End Try
        End Function

        'internal file encryption
        Private Function _EncryptFile(ByVal PlainFile As String, ByVal EncryptedFile As String) As Boolean
            Try
                'set flag for replacement if filenames are the same, open files
                Dim bReplaceFile As Boolean = (EncryptedFile.ToLower.Trim = PlainFile.ToLower.Trim)
                Dim fsIn As FileStream = File.OpenRead(PlainFile)
                Dim sEncryptedFile As String
                If bReplaceFile Then
                    sEncryptedFile = Path.GetTempFileName()
                Else
                    sEncryptedFile = EncryptedFile
                End If
                Dim fsOut As FileStream = File.OpenWrite(sEncryptedFile)
                'create Crypto Service Provider, set key, transform and crypto stream
                Dim oCSP As New RijndaelManaged()
                oCSP.Key = mbytKey
                oCSP.IV = mbytIV
                Dim ct As ICryptoTransform = oCSP.CreateEncryptor()
                Dim cs As CryptoStream = New CryptoStream(fsOut, ct, _
                    CryptoStreamMode.Write)
                'get bytes from input file
                Dim bytesPlain(fsIn.Length - 1) As Byte
                fsIn.Read(bytesPlain, 0, fsIn.Length)
                'write input bytes to crypto stream and close everything
                cs.Write(bytesPlain, 0, fsIn.Length)
                cs.FlushFinalBlock()
                cs.Close()
                fsIn.Close()
                fsOut.Close()
                'replace input file if flag set
                If bReplaceFile Then
                    Return ReplaceFile(sEncryptedFile, PlainFile)
                Else
                    Return True
                End If
            Catch ex As Exception
                Debug.WriteLine("_EncryptFile Error: " & ex.ToString)
                Return False
            End Try
        End Function

        'internal string encryption
        Private Function _EncryptString(ByVal PlainText As String, ByVal Base64 As Boolean) As String
            Try
                'put string in byte array
                Dim byteArray() As Byte = BytesFromString(PlainText)
                'create streams and encrypt
                Dim msPlain As New MemoryStream(byteArray)
                Dim msEnc As MemoryStream = EncryptStream(msPlain)
                'return string depending on Base64 flag
                If Base64 Then
                    Return Convert.ToBase64String(msEnc.ToArray)
                Else
                    Return BytesToString(msEnc.ToArray)
                End If
            Catch ex As Exception
                Debug.WriteLine("_EncryptString Error: " & ex.ToString)
                Return String.Empty
            End Try
        End Function

        'returns a Unicode byte array from a string
        Private Function BytesFromString(ByVal StringValue As String) As Byte()
            Return (New UnicodeEncoding()).GetBytes(StringValue)
        End Function

        'returns a hex string from a byte array
        Private Function BytesToHexString(ByVal byteArray() As Byte) As String
            Dim sb As New StringBuilder(40)
            Dim bValue As Byte
            For Each bValue In byteArray
                sb.AppendFormat(bValue.ToString("x2").ToUpper)
            Next
            Return sb.ToString
        End Function

        'returns a Unicode string from a byte array 
        Private Function BytesToString(ByVal byteArray() As Byte) As String
            Return (New UnicodeEncoding()).GetString(byteArray)
        End Function

        'replace a file with the contents of another
        Private Function ReplaceFile(ByVal TempFile As String, ByVal TargetFile As String) As Boolean
            Dim bStatus As Boolean = False
            If CheckWriteAccess(TargetFile) Then
                'replace the target file with the temp file
                File.Copy(TempFile, TargetFile, True)
                bStatus = True
            End If
            'delete the temp file
            File.Delete(TempFile)
            Return bStatus
        End Function

        'Return True when the file is available for writing
        '- returns False if output file locked, for example
        Private Function CheckWriteAccess(ByVal FileName As String) As Boolean
            '2 second delay with 10,200
            Dim iCount As Integer = 0       'retry count
            Const iLimit As Integer = 10    'retries
            Const iDelay As Integer = 200   'msec
            While (iCount < iLimit)
                Try
                    Dim fs As FileStream
                    fs = New FileStream(FileName, FileMode.Append, _
                        FileAccess.Write, FileShare.None)
                    fs.Close()
                    Return True
                Catch ex As Exception
                    Thread.Sleep(iDelay)
                Finally
                    iCount += 1
                End Try
            End While
            Return False
        End Function

    End Class 'EncryptDecryptFile
    '***********************************************************************************************************



    '***********************************************************************************************************
    'Sample:
    '    Dim s As String
    '    s = "Hello World"
    '    s = EncryptString(s, "mypassword")
    '    MsgBox("Encrypted Text = " & s)
    '    MsgBox("Decrypted Text = " & DecryptString(s, "mypassword"))
    '*************************************************************************
    Private bytIV() As Byte = {121, 241, 10, 1, 90, 74, 11, 39, 9, 91, 45, 78, 189, 211, 133, 62}
    '128 bit IV key must be provided
    'here a constant is used

    Public Function EncryptString(ByVal sValue As String, ByVal sKey As String) As String

        Dim bytValue() As Byte
        Dim bytKey() As Byte
        Dim bytEncoded() As Byte
        Dim iLen As Integer, iRemaining As Integer
        Dim objMS As New MemoryStream()
        Dim objCrypt As CryptoStream

        'Value must be within ASCII range (i.e., no DBCS chars)
        bytValue = Encoding.ASCII.GetBytes(sValue.ToCharArray)
        'key must be 256 bits
        iLen = Len(sKey)
        If iLen >= 32 Then
            sKey = Strings.Left(sKey, 32)
        Else
            iLen = Len(sKey)
            iRemaining = 32 - iLen
            sKey = sKey & Strings.StrDup(iRemaining, "X")
        End If
        bytKey = Encoding.ASCII.GetBytes(sKey.ToCharArray)
        Dim objRM As New RijndaelManaged()

        Try
            'Create the encryptor and write value 
            '(converted into bytearray) to it
            objCrypt = New CryptoStream(objMS, _
              objRM.CreateEncryptor(bytKey, bytIV), _
              CryptoStreamMode.Write)
            objCrypt.Write(bytValue, 0, bytValue.Length)

            objCrypt.FlushFinalBlock()

            bytEncoded = objMS.ToArray
            objMS.Close()
            objCrypt.Close()
        Catch

        End Try
        'return encoded value
        ' (converted from  byte Array to base64 string)
        Return Convert.ToBase64String(bytEncoded)


    End Function 'Encrypt String
    '****************************************************************************************************

    '****************************************************************************************************
    Public Function DecryptString(ByVal sEncryptedValue As String, ByVal sKey As String) As String
        'Sample:
        '    Dim s As String
        '    s = "Hello World"
        '    s = EncryptString(s, "mypassword")
        '    MsgBox("Encrypted Text = " & s)
        '    MsgBox("Decrypted Text = " & DecryptString(s, "mypassword"))
        '*****************************************************************
        Dim bytValue() As Byte
        Dim bytTemp() As Byte
        Dim objRM As New RijndaelManaged()
        Dim objMS As MemoryStream
        Dim objCs As CryptoStream
        Dim bytKey() As Byte

        Dim iLen As Integer
        Dim iRemaining As Integer
        Dim intCtr As Integer

        'convert base64 encrypted value to byte array
        bytValue = Convert.FromBase64String(sEncryptedValue)

        'ensure key is 256 bits
        iLen = Len(sKey)
        If iLen >= 32 Then
            sKey = Strings.Left(sKey, 32)
        Else
            iLen = Len(sKey)
            iRemaining = 32 - iLen
            sKey = sKey & Strings.StrDup(iRemaining, "X")
        End If
        bytKey = Encoding.ASCII.GetBytes(sKey.ToCharArray)

        ReDim bytTemp(bytValue.Length)
        objMS = New MemoryStream(bytValue)
        Try
            'create decryptor and write value to it
            objCs = New CryptoStream(objMS, _
               objRM.CreateDecryptor(bytKey, bytIV), _
               CryptoStreamMode.Read)

            objCs.Read(bytTemp, 0, bytTemp.Length)

            objCs.FlushFinalBlock()
            objMS.Close()
            objCs.Close()
        Catch

        End Try

        'return decypted value
        Return Encoding.ASCII.GetString(bytTemp)

    End Function 'Decrypt String
    '***************************************************************************************************************

    '***************************************************************************************************************
    Function Right(ByVal s As String, ByVal n As Integer) As String
        '************************************************************
        'Sample:
        '   MsgBox(myRight("Steve", 2)) 'Returns ve
        '************************************************************
        Try
            s = s.Substring(s.Length - n)
        Catch
            s = ""
        End Try
        Return s
    End Function 'Right
    '****************************************************************************************************************

    '******************************************************************************************
    Public Function AppPath() As String
        'Sample:
        '  'MsgBox(AppPath) 'Returns c:\temp\FunctionsAndSubs\bin\
        '*************************************************************
        'Returns the current application path, with a trailing slash
        Dim strPath As String
        strPath = StrReverse(Application.ExecutablePath)
        strPath = Mid(strPath, InStr(1, strPath, "\"))
        strPath = StrReverse(strPath)
        Return strPath
    End Function 'AppPath
    '***********************************************************************************************************


    '****************************************************************************************************************
    Public Class FolderBrowser
        'Sample:
        '        Dim oBrowse As FolderBrowser = New FolderBrowser(Me.Handle)
        '        oBrowse.Title = "Title For Browsing"
        '        oBrowse.NewUI = True
        '        oBrowse.ShowStatus = True
        '        Label1.Text = oBrowse.Browse("c:\can")
        '**********************************************************************
        Private Const BFFM_INITIALIZED As Integer = 1
        Private Const BFFM_SELCHANGED As Integer = 2
        Private Const BFFM_VALIDATEFAILED As Integer = 3
        Private Const BFFM_ENABLEOK As Integer = &H465
        Private Const BFFM_SETSELECTIONA As Integer = &H466
        Private Const BFFM_SETSTATUSTEXT As Integer = &H464

        Private Const BIF_RETURNONLYFSDIRS As Short = &H1S
        Private Const BIF_DONTGOBELOWDOMAIN As Short = &H2S
        Private Const BIF_STATUSTEXT As Short = &H4S
        Private Const BIF_RETURNFSANCESTORS As Short = &H8S
        Private Const BIF_EDITBOX As Short = &H10S
        Private Const BIF_VALIDATE As Short = &H20S
        Private Const BIF_USENEWUI As Short = &H40S
        Private Const BIF_BROWSEFORCOMPUTER As Short = &H1000S
        Private Const BIF_BROWSEFORPRINTER As Short = &H2000S
        Private Const BIF_BROWSEINCLUDEFILES As Short = &H4000S

        Private Const MAX_PATH As Short = 260

        Public Enum START_LOCATION
            SL_FLAG_CREATE = &H8000
            SL_FLAG_DONT_VERIFY = &H4000
            SL_ADMINTOOLS = &H30
            SL_ALTSTARTUP = &H1D
            SL_APPDATA = &H1A
            SL_BITBUCKET = &HA
            SL_COMMON_ADMINTOOLS = &H2F
            SL_COMMON_ALTSTARTUP = &H1D
            SL_COMMON_APPDATA = &H23
            SL_COMMON_DESKTOPDIRECTORY = &H19
            SL_COMMON_DOCUMENTS = &H2E
            SL_COMMON_FAVORITES = &H1F
            SL_COMMON_PROGRAMS = &H17
            SL_COMMON_STARTMENU = &H16
            SL_COMMON_STARTUP = &H18
            SL_COMMON_TEMPLATES = &H2D
            SL_CONTROLS = &H3
            SL_COOKIES = &H21
            SL_DESKTOP = &H0
            SL_DESKTOPDIRECTORY = &H10
            SL_DRIVES = &H11
            SL_FAVORITES = &H6
            SL_FONTS = &H14
            SL_HISTORY = &H22
            SL_INTERNET = &H1
            SL_INTERNET_CACHE = &H20
            SL_LOCAL_APPDATA = &H1C
            SL_MYPICTURES = &H27
            SL_NETHOOD = &H13
            SL_NETWORK = &H12
            SL_PERSONAL = &H5
            SL_PRINTERS = &H4
            SL_PRINTHOOD = &H1B
            SL_PROFILE = &H28
            SL_PROGRAM_FILES = &H26
            SL_PROGRAM_FILES_COMMON = &H2B
            SL_PROGRAM_FILES_COMMONX86 = &H2C
            SL_PROGRAM_FILESX86 = &H2A
            SL_PROGRAMS = &H2
            SL_RECENT = &H8
            SL_SENDTO = &H9
            SL_STARTMENU = &HB
            SL_STARTUP = &H7
            SL_SYSTEM = &H25
            SL_SYSTEMX86 = &H29
            SL_TEMPLATES = &H15
            SL_WINDOWS = &H24
        End Enum

        ' callback delegate
        Private Delegate Function BrowseCB(ByVal hWnd As IntPtr, _
                                       ByVal uMsg As Integer, _
                                       ByVal lParam As Integer, _
                                       ByVal lpData As Integer) As Integer

        Private Structure BROWSEINFO
            Dim hOwner As IntPtr
            Dim pidlRoot As Integer
            Dim pszDisplayName As String
            Dim lpszTitle As String
            Dim ulFlags As Integer
            Dim lpfn As BrowseCB
            Dim lParam As IntPtr
            Dim iImage As Integer
        End Structure

        <DllImport("ole32.dll")> _
        Private Shared Sub CoTaskMemFree(ByVal addr As IntPtr)
        End Sub

        <DllImport("user32.dll")> _
                  Private Overloads Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal uMsg As Integer, ByVal lParam As Integer, ByVal lpData As Integer) As Integer
        End Function

        <DllImport("user32.dll")> _
                  Private Overloads Shared Function SendMessage(ByVal hWnd As IntPtr, ByVal uMsg As Integer, ByVal lParam As Integer, ByVal lpData As String) As Integer
        End Function

        <DllImport("shell32.dll", CharSet:=CharSet.Ansi)> _
        Private Shared Function SHBrowseForFolder(ByRef lpBrowseInfo As BROWSEINFO) As IntPtr
        End Function

        <DllImport("shell32.dll", CharSet:=CharSet.Ansi)> _
        Private Shared Function SHGetPathFromIDList(ByVal pidl As IntPtr, ByVal pszPath As StringBuilder) As Integer
        End Function

        <DllImport("shell32.dll", CharSet:=CharSet.Ansi)> _
        Private Shared Function SHGetSpecialFolderLocation(ByVal hWnd As IntPtr, ByVal nFolder As Integer, ByRef pidl As Integer) As Integer
        End Function

        Private m_BI As BROWSEINFO
        Private m_Init As Boolean
        Private m_NewUI As Boolean = False
        Private m_ShowStatus As Boolean = False

        Public Sub New(ByVal handle As IntPtr)
            m_BI.hOwner = handle
            m_BI.lpfn = AddressOf BrowseCallbackProc
        End Sub

        Public Overloads Function Browse() As String
            m_BI.pidlRoot = 0
            Return DoBrowse("")
        End Function

        Public Overloads Function Browse(ByVal startPath As String) As String
            m_BI.pidlRoot = 0
            Return DoBrowse(startPath)
        End Function

        Public Overloads Function Browse(ByVal SL As START_LOCATION) As String
            SHGetSpecialFolderLocation(m_BI.hOwner, SL, m_BI.pidlRoot)
            Return DoBrowse("")
        End Function

        Private Function DoBrowse(ByVal startPath As String) As String
            Dim result As IntPtr
            Dim sel As String

            m_BI.ulFlags = BIF_RETURNONLYFSDIRS
            If m_NewUI Then m_BI.ulFlags += BIF_USENEWUI
            If m_ShowStatus Then m_BI.ulFlags += BIF_STATUSTEXT

            m_BI.lParam = Marshal.StringToHGlobalAnsi(startPath)
            m_Init = True
            result = SHBrowseForFolder(m_BI)

            sel = GetFSPath(result)

            Call CoTaskMemFree(result)

            Return sel
        End Function

        Public Property Title() As String
            Get
                Return m_BI.lpszTitle
            End Get
            Set(ByVal Value As String)
                m_BI.lpszTitle = Value
            End Set
        End Property

        Public Function BrowseCallbackProc(ByVal hWnd As IntPtr, _
                                       ByVal uMsg As Integer, _
                                       ByVal lParam As Integer, _
                                       ByVal lpData As Integer) As Integer
            If uMsg = BFFM_INITIALIZED Then
                SendMessage(hWnd, BFFM_SETSELECTIONA, 1, lpData)
                m_Init = False
            ElseIf uMsg = BFFM_SELCHANGED And Not m_Init Then
                SendMessage(hWnd, BFFM_SETSTATUSTEXT, 0, GetFSPath(New IntPtr(lParam)))
            End If
        End Function

        Private Function GetFSPath(ByVal pidl As IntPtr) As String
            Dim sb As New StringBuilder(MAX_PATH)

            If pidl.Equals(IntPtr.Zero) Then
                Return ""
            Else
                If SHGetPathFromIDList(pidl, sb) = 1 Then
                    Return sb.ToString()
                End If
            End If
        End Function

        Public Property NewUI() As Boolean
            Get
                Return m_NewUI
            End Get
            Set(ByVal Value As Boolean)
                m_NewUI = Value
            End Set
        End Property

        Public Property ShowStatus() As Boolean
            Get
                Return m_ShowStatus
            End Get
            Set(ByVal Value As Boolean)
                m_ShowStatus = Value
            End Set
        End Property

    End Class 'FolderBrowser 
    '************************************************************************************************


    '********* Previous Instance *************************************************************************
    'Sample:
    'If PrevInstance() = True Then
    ' Get all previous instances
    '    Dim Processes() As Process
    '    Processes =  Diagnostics.Process.GetProcessesByName(Diagnostics.Process.GetCurrentProcess.ProcessName)
    ' Activate the first instance
    '    AppActivate(Processes(0).Id)
    ' Exit the current instance
    '    Application.Exit()
    'End If

    Function PrevInstance() As Boolean
        If Diagnostics.Process.GetProcessesByName(Diagnostics.Process.GetCurrentProcess.ProcessName).Length > 1 Then
            Return True
        Else
            Return False
        End If
    End Function 'PreviousInstance
    ' *****************************************************************************************************

   '************************************  ReplacePhrase **********************************************************************
    Function ReplacePhrase(ByVal txt, ByVal vRemove, ByVal vReplace)
        'Inputs: Text String, The phrase to remove from text String, The phrase To replace the removed phrase.
        ' t = "Steve Was Here But Steve is No longer Steve anymore" 
        ' MsgBox RemovePhrase(t, "Steve","Nelson") Will remove "Steve" From the Sentence and replace it with Nelson
        Dim p As Integer
        p = InStr(txt, vRemove)
        Do While p > 0
            txt = Mid(txt, 1, p - 1) + vReplace + Mid(txt, p + Len(vRemove))
            p = InStr(txt, vRemove)
        Loop
        Return txt
    End Function
'***********************************************************************************************************************************

End Module