'Extracted from i00CodeLib - Do not remove this message
Public Module Extensions
<System.Runtime.CompilerServices.Extension>
Public Function ToFileDialogFilter(Exentsions As String(), ShowAllSupported As Boolean, Optional SupportedFileText As String = "All Supported Files", Optional ShowExtensions As Boolean? = Nothing, Optional ShowAllFiles As Boolean? = Nothing) As String
Dim FileExt = {New With {.Ext = "", .Desc = ""}}.ToList
FileExt.Clear()
'IN SOME VERSIONS OF WINDOWS THE OS CAN OVERRIDE THE ShowExtensions SETTING!
If ShowExtensions.HasValue = False Then ShowExtensions = Shell.OS.ShowingFileExtensions
If ShowAllFiles.HasValue = False Then ShowAllFiles = ShowAllSupported
Dim Extensions As New List(Of String)
For Each ExtensionGroup In Exentsions
Dim arrExtensions = Split(ExtensionGroup, ";")
Dim NiceExtensions = arrExtensions.Select(Function(x) "*." & x).ToArray
Extensions.AddRange(NiceExtensions)
Dim ExtensionFilter = Join(NiceExtensions, ";")
FileExt.Add(New With {.Ext = ExtensionFilter,
.Desc = Replace(Shell.FileInfo.GetFileTypeDescription(arrExtensions(0), True), "|", "")})
Next
If Extensions.Count = 1 Then
'don't need all supported as only has one type!
ElseIf ShowAllSupported Then
Dim AllSupported = New With {.Ext = Join(Extensions.ToArray, ";"),
.Desc = SupportedFileText}
FileExt.Insert(0, AllSupported)
End If
If ShowAllFiles.Value Then
FileExt.Add(New With {.Ext = "*.*",
.Desc = "All Files"})
End If
Return Join(FileExt.Select(Function(x) x.Desc & If(ShowExtensions.Value, " (" & x.Ext & ")", "") & "|" & x.Ext).ToArray, "|")
End Function
End Module
Namespace Shell
Partial Public Class OS
Public Shared ReadOnly Property ShowingFileExtensions As Boolean
Get
Static mc_ShowingFileExtensions As Boolean
Static mc_Obtained As Boolean
If mc_Obtained = False Then
mc_Obtained = True
Try
Dim regKey = My.Computer.Registry.CurrentUser.OpenSubKey("SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\Advanced")
If regKey IsNot Nothing Then
mc_ShowingFileExtensions = Not CBool(regKey.GetValue("HideFileExt"))
End If
Catch ex As Exception
'key permission issue?? - assume false
End Try
End If
Return mc_ShowingFileExtensions
End Get
End Property
End Class
Public Class FileInfo
Public Shared Function GetFileTypeDescription(Extension As String, Optional FillIfEmpty As Boolean = True) As String
If Extension Is Nothing Then Return Nothing
Extension = Extension.TrimStart("."c)
Using extKey = My.Computer.Registry.ClassesRoot.OpenSubKey("." & Extension)
If extKey IsNot Nothing Then
Dim extClass = TryCast(extKey.GetValue(""), String)
If extClass <> "" Then
Using extClassKey = My.Computer.Registry.ClassesRoot.OpenSubKey(extClass)
If extClassKey IsNot Nothing Then
Dim ExtensionDesc = TryCast(extClassKey.GetValue(""), String)
If ExtensionDesc <> "" Then
Return ExtensionDesc
End If
End If
End Using
End If
End If
End Using
If FillIfEmpty AndAlso Extension <> "" Then
Return "." & Extension & " file"
Else
Return ""
End If
End Function
End Class
End Namespace