Imports System
Imports System.IO
Imports System.Reflection
Imports System.Runtime.InteropServices
Imports System.Text
Imports System.Text.RegularExpressions
Imports System.Threading

Imports Microsoft.Win32

Imports VB6 = Microsoft.VisualBasic

<Assembly: AssemblyTitle("File Association Changer")> 
<Assembly: AssemblyProduct("File Association Changer")> 
<Assembly: AssemblyDescription("Changes the default file association easily")> 
<Assembly: AssemblyCopyright("Copyright © stax76")> 
<Assembly: AssemblyCompany("stax")> 
<Assembly: AssemblyVersion("1.0.0.0")> 

Public Class MainForm
    Inherits Form

#Region "Designer"
    'Form overrides dispose to clean up the component list.
    <System.Diagnostics.DebuggerNonUserCode()> _
    Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
        If disposing AndAlso components IsNot Nothing Then
            components.Dispose()
        End If
        MyBase.Dispose(disposing)
    End Sub
    Friend WithEvents lv As System.Windows.Forms.ListView
    Friend WithEvents tbSearch As TextBox
    Friend WithEvents tbType As TextBox

    'Required by the Windows Form Designer
    Private components As System.ComponentModel.IContainer

    'NOTE: The following procedure is required by the Windows Form Designer
    'It can be modified using the Windows Form Designer.  
    'Do not modify it using the code editor.
    <System.Diagnostics.DebuggerStepThrough()> _
    Private Sub InitializeComponent()
        Me.lv = New System.Windows.Forms.ListView
        Me.tbSearch = New TextBox
        Me.tbType = New TextBox
        Me.SuspendLayout()
        '
        'lv
        '
        Me.lv.Anchor = CType((((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Bottom) _
                    Or System.Windows.Forms.AnchorStyles.Left) _
                    Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles)
        Me.lv.Location = New System.Drawing.Point(12, 38)
        Me.lv.Name = "lv"
        Me.lv.Size = New System.Drawing.Size(318, 312)
        Me.lv.TabIndex = 2
        Me.lv.UseCompatibleStateImageBehavior = False
        '
        'tbSearch
        '
        Me.tbSearch.Anchor = CType(((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Left) _
                    Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles)
        Me.tbSearch.Location = New System.Drawing.Point(12, 12)
        Me.tbSearch.Size = New System.Drawing.Size(220, 20)
        Me.tbSearch.TabIndex = 0
        '
        'tbType
        '
        Me.tbType.Anchor = CType((System.Windows.Forms.AnchorStyles.Top Or System.Windows.Forms.AnchorStyles.Right), System.Windows.Forms.AnchorStyles)
        Me.tbType.Location = New System.Drawing.Point(238, 12)
        Me.tbType.Size = New System.Drawing.Size(92, 20)
        Me.tbType.TabIndex = 1
        '
        'MainForm
        '
        Me.AutoScaleDimensions = New System.Drawing.SizeF(6.0!, 13.0!)
        Me.AutoScaleMode = System.Windows.Forms.AutoScaleMode.Font
        Me.ClientSize = New System.Drawing.Size(342, 362)
        Me.Controls.Add(Me.tbType)
        Me.Controls.Add(Me.tbSearch)
        Me.Controls.Add(Me.lv)
        Me.FormBorderStyle = System.Windows.Forms.FormBorderStyle.FixedDialog
        Me.MaximizeBox = False
        Me.Name = "MainForm"
        Me.ShowIcon = False
        Me.StartPosition = System.Windows.Forms.FormStartPosition.CenterScreen
        Me.Text = "File Association Changer"
        Me.ResumeLayout(False)
        Me.PerformLayout()

    End Sub
#End Region

    Private Filepaths As New List(Of String)
    Private Items As New List(Of Item)
    Private Images As New ImageList With {.ImageSize = New Size(32, 32)}
    Private Worker As New Threading.Thread(AddressOf SearchExePaths)

    Public Sub New()
        InitializeComponent()

        AddHandler Application.ThreadException, AddressOf ThreadException
        lv.LargeImageList = Images
        lv.View = View.Tile
        lv.FullRowSelect = True
        lv.TileSize = New Size(lv.Width - 4, 38)
        lv.MultiSelect = False
        lv.Columns.AddRange(New ColumnHeader() {New ColumnHeader(), New ColumnHeader()})
        lv.Scrollable = False

        KeyPreview = True

        Dim args = My.Application.CommandLineArgs

        If args.Count > 0 Then
            Dim m = Regex.Match(args(0), "\.*\w+$")

            If m.Success Then
                tbType.Text = m.Value.Substring(1)
            End If
        End If

        Native.SetWindowTheme(lv.Handle, "explorer", Nothing)

        tbSearch.SetCue("Search Application", False)
        tbType.SetCue("File Type", False)

        Worker.Start()
    End Sub

    <STAThread()> _
    Public Shared Sub Main()
        Application.EnableVisualStyles()
        Application.Run(New MainForm())
    End Sub

    Public Sub ThreadException(ByVal sender As Object, ByVal e As ThreadExceptionEventArgs)
        Msg(e.Exception.Message, MessageBoxIcon.Error)
    End Sub

    Sub SearchExePaths()
        Using k = Registry.CurrentUser.OpenSubKey("Software\Microsoft\Windows\ShellNoRoam\MUICache")
            If Not k Is Nothing Then
                For Each i In k.GetValueNames
                    Add(i)
                Next
            End If
        End Using

        Using k = Registry.ClassesRoot.OpenSubKey("Applications")
            If Not k Is Nothing Then
                For Each i In k.GetSubKeyNames
                    Using k2 = k.OpenSubKey(i + "\shell\open\command")
                        If Not k2 Is Nothing Then
                            Add(CStr(k2.GetValue(Nothing)))
                        End If
                    End Using
                Next
            End If
        End Using

        Using k = Registry.ClassesRoot
            For Each i In k.GetSubKeyNames
                Using k2 = k.OpenSubKey(i + "\shell\open\command")
                    If Not k2 Is Nothing Then
                        Add(CStr(k2.GetValue(Nothing)))
                    End If
                End Using
            Next
        End Using

        Using k = Registry.LocalMachine.OpenSubKey("SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths")
            For Each i In k.GetSubKeyNames
                Using k2 = k.OpenSubKey(i)
                    Add(CStr(k2.GetValue(Nothing)))
                End Using
            Next
        End Using
    End Sub

    Sub Add(ByVal value As String)
        If Not value Is Nothing AndAlso _
            (value.Contains(".exe") OrElse _
             value.ToUpper.Contains(".EXE")) Then

            If Not value.Contains(".exe") Then
                value = value.Replace(".EXE", ".exe")
            End If

            Dim length = value.IndexOf(".exe") + 4
            value = value.Substring(0, length)

            If value.StartsWith("""") Then
                value = value.TrimStart(""""c)
            End If

            If Not Filepaths.Contains(value) AndAlso File.Exists(value) Then
                Filepaths.Add(value)

                Dim info = FileVersionInfo.GetVersionInfo(value)
                Dim item As New Item

                item.Filepath = value
                item.Company = info.CompanyName
                item.Image = Drawing.Icon.ExtractAssociatedIcon(value).ToBitmap

                For Each i In New String() { _
                    info.FileDescription, _
                    info.ProductName, _
                    Path.GetFileNameWithoutExtension(value)}

                    If item.Name = "" Then
                        item.Name = i
                    Else
                        Exit For
                    End If
                Next

                SyncLock Items
                    Items.Add(item)
                End SyncLock
            End If
        End If
    End Sub

    Private Sub MainForm_KeyDown(ByVal sender As Object, ByVal e As KeyEventArgs) Handles Me.KeyDown
        If lv.Items.Count > 0 Then
            If lv.SelectedIndices.Count = 0 Then
                lv.Items(0).Selected = True
            End If

            Select Case e.KeyData
                Case Keys.Up
                    e.Handled = True
                    lv.Items(FixBounds(lv.SelectedItems(0).Index - 1, lv.Items)).Selected = True
                Case Keys.Down
                    e.Handled = True
                    lv.Items(FixBounds(lv.SelectedItems(0).Index + 1, lv.Items)).Selected = True
                Case Keys.Enter
                    Run()
            End Select
        End If
    End Sub

    Sub Run()
        If Not Regex.IsMatch(tbType.Text, "^\w+$") Then
            Msg("Please enter a valid file type like txt, jpg, htm, avi....", MessageBoxIcon.Warning)
        End If

        If lv.SelectedItems.Count > 0 AndAlso tbType.Text <> "" Then
            Dim filepath = DirectCast(lv.SelectedItems(0).Tag, Item).Filepath
            FileAssociation.Create(filepath, tbType.Text, """%1"" %*")
            FileAssociation.RefreshIconCache()
            Close()
        End If
    End Sub

    Function FixBounds(ByVal index As Integer, ByVal col As ICollection) As Integer
        If index >= col.Count Then
            index = col.Count - 1
        ElseIf index < 0 Then
            index = 0
        End If

        Return index
    End Function

    Private Sub tbSearch_TextChanged(ByVal sender As Object, ByVal e As EventArgs) Handles tbSearch.TextChanged
        lv.Items.Clear()

        If tbSearch.Text = "" Then
            Exit Sub
        End If

        SyncLock Items
            For Each i In Items
                If i.Name.ToUpper.StartsWith(tbSearch.Text.ToUpper) AndAlso _
                    (lv.TileSize.Height + 6) * lv.Items.Count < lv.Height Then

                    Dim item As New ListViewItem
                    item.Text = i.Name
                    item.ImageKey = i.Filepath
                    item.SubItems.Add(i.Company)
                    item.Tag = i

                    If Not Images.Images.ContainsKey(i.Filepath) Then
                        Images.Images.Add(i.Filepath, i.Image)
                    End If

                    lv.Items.Add(item)
                End If
            Next

            For Each i In Items
                If Not i.Name.ToUpper.StartsWith(tbSearch.Text.ToUpper) AndAlso _
                    i.Name.ToUpper.Contains(tbSearch.Text.ToUpper) AndAlso _
                    (lv.TileSize.Height + 6) * lv.Items.Count < lv.Height Then

                    Dim item As New ListViewItem
                    item.Text = i.Name
                    item.ImageKey = i.Filepath
                    item.SubItems.Add(i.Company)
                    item.Tag = i

                    If Not Images.Images.ContainsKey(i.Filepath) Then
                        Images.Images.Add(i.Filepath, i.Image)
                    End If

                    lv.Items.Add(item)
                End If
            Next
        End SyncLock

        If lv.Items.Count > 0 Then
            lv.Items(0).Selected = True
        End If
    End Sub

    Private Sub lv_DoubleClick(ByVal sender As Object, ByVal e As EventArgs) Handles lv.DoubleClick
        Run()
    End Sub
End Class