By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
434,921 Members | 1,479 Online
Bytes IT Community
+ Ask a Question
Need help? Post your question and get tips & solutions from a community of 434,921 IT Pros & Developers. It's quick & easy.

Get associated Icon based on file type not actual file

P: n/a
I am building this SQL Server database app in which i can store files. In
order to display files I want to have the app show the associated icon for
the extension of the file that is in the database. Therefore the file doesnt
really exist on the user's hard drive. All the file extracting techniques
require that I have the actual file on the drive in order to get an icon for
it. There is a workaround for this: i could create dummy files with the
correct extension and get the icon for them but that is kind of messy. Can
someone help me create/find a function like this
Function GetIcon(Extension as String) as Drawing.Icon

Thanks in advice
Nov 21 '05 #1
Share this Question
Share on Google+
5 Replies


P: n/a
"IcingDeath via DotNetMonster.com" <fo***@DotNetMonster.com> wrote in
message news:54***********@DotNetMonster.com...
|I am building this SQL Server database app in which i can store files. In
| order to display files I want to have the app show the associated icon for
| the extension of the file that is in the database. Therefore the file
doesnt
| really exist on the user's hard drive. All the file extracting techniques
| require that I have the actual file on the drive in order to get an icon
for
| it. There is a workaround for this: i could create dummy files with the
| correct extension and get the icon for them but that is kind of messy. Can
| someone help me create/find a function like this
| Function GetIcon(Extension as String) as Drawing.Icon
i came up with this a few years back when learning vb.net...hope it helps
you...

Imports Microsoft.Win32
Imports System.Runtime.InteropServices

Public Class fileAssociation

#Region " structures "

Private Structure SHFILEINFO
Public iconHandle As IntPtr
Public iconIndex As Integer
Public attributes As Integer
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=260)> _
Public displayName As String
<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=80)> _
Public typeName As String
End Structure

#End Region

#Region " interop "

Private Declare Function SHGetFileInfo Lib "shell32.dll" ( _
ByVal pszPath
As String, _
ByVal
dwFileAttributes As Integer, _
ByRef psfi As
SHFILEINFO, _
ByVal
cbFileInfo As Integer, _
ByVal uFlags
As Integer _
) As IntPtr

#End Region

#Region " internal classes"

Class associationConstants

#Region " constants "

Public Const SHGFI_ICON As Integer = &H100
Public Const SHGFI_SMALLICON As Integer = &H1
Public Const SHGFI_LARGEICON As Integer = &H0

#End Region

End Class

Class fileAssociationException

#Region " interfaces "

Inherits Exception

#End Region

#Region " methods "

Public Sub New(ByVal message As String)
MyBase.New(message)
End Sub

#End Region

End Class

#End Region

#Region " methods "

Public Shared Function ApplicationName(ByVal ext As String) As String
Dim registeredExtension As RegistryKey =
Registry.ClassesRoot.OpenSubKey(ext)
ApplicationName = registeredExtension.GetValue("")
registeredExtension.Close()
End Function

Public Shared Function ApplicationIcon(ByVal ext As String, Optional ByVal
largeIcon As Boolean = False) As Icon
Dim applicationName As String = ApplicationPath(ext)
If applicationName Is Nothing OrElse applicationName = "" Then
Throw New fileAssociationException("Associated icon not found.")
End If
Dim imagePointer As IntPtr
Dim fileInfo As New SHFILEINFO()
fileInfo.displayName = New String(Chr(0), 260)
fileInfo.typeName = New String(Chr(0), 80)
Dim iconSize As Integer = IIf(largeIcon,
associationConstants.SHGFI_LARGEICON, associationConstants.SHGFI_SMALLICON)
imagePointer = SHGetFileInfo( _
applicationName, 0, fileInfo, _
Marshal.SizeOf(fileInfo), _
associationConstants.SHGFI_ICON Or
iconSize _
)
Return System.Drawing.Icon.FromHandle(fileInfo.iconHandle )
End Function

Public Shared Function ApplicationPath(ByVal ext As String) As String
Dim associatedApplication As RegistryKey
Dim registeredExtension As RegistryKey
Dim properties() As String
Try
registeredExtension = Registry.ClassesRoot.OpenSubKey(ext)
Dim applicationName As String = registeredExtension.GetValue("")
associatedApplication =
Registry.ClassesRoot.OpenSubKey(applicationName & "\shell\open\command")
properties = Split(associatedApplication.GetValue(""), """")
Catch ex As Exception
Throw New fileAssociationException("Associated application not found."
& vbCrLf & vbCrLf & ex.Message)
Finally
registeredExtension.Close()
associatedApplication.Close()
End Try
If properties Is Nothing OrElse properties.Length = 1 Then Return ""
Return properties(1)
End Function

#End Region

End Class
Nov 21 '05 #2

P: n/a
I really like your approach! Thanks... a lot!
--
Message posted via http://www.dotnetmonster.com
Nov 21 '05 #3

P: n/a
no problem...hope it works for what you need.
"IcingDeath via DotNetMonster.com" <fo***@DotNetMonster.com> wrote in
message news:54***********@DotNetMonster.com...
|I really like your approach! Thanks... a lot!
|
|
| --
| Message posted via http://www.dotnetmonster.com
Nov 21 '05 #4

P: n/a
Using your code and other code on the internet as well some of my own I made
the extended icon class....
Its a good wrapper....
Note that although your method is nice cause you avoid read/writes from the
disk it is not very reliable....
Check for example icon for ".mdb" using the registry method vs the dummy file
method.
anyway here goes.....

------------------------ Code Start ------------------------------------------
--------------
Imports System.Runtime.InteropServices
Imports System.Drawing, System.Drawing.Imaging
Imports Microsoft.Win32
Public Class ExtendedIcon
'Inherits Drawing.Icon Declared NotInheritable... as if there was nothing
wrong with it!

#Region " FileInfo API"
#Region " Constants"
Private Const SHGFI_ICON = &H100
Private Const SHGFI_SMALLICON = &H1
Private Const SHGFI_LARGEICON = &H0
#End Region
#Region " Structures"
Private Structure SHFILEINFO

Public hIcon As IntPtr
Public iIcon As Integer
Public dwAttributes As Integer

<VBFixedString(260), MarshalAs(UnmanagedType.ByValTStr, SizeConst:
=260)> _
Public szDisplayName As String

<VBFixedString(80), MarshalAs(UnmanagedType.ByValTStr, SizeConst:=80)
_

Public szTypeName As String

End Structure
#End Region
Private Declare Function SHGetFileInfo Lib "shell32" Alias
"SHGetFileInfoA" _
(ByVal pszPath As String, _
ByVal dwFileAttributes As Integer, _
ByRef psfi As SHFILEINFO, _
ByVal ByValcbFileInfo As Integer, _
ByVal uFlags As Integer) As Integer
#End Region 'Get Icon from a file
#Region " IconInfo API"

<DllImport("gdi32.dll", SetLastError:=True)> _
Private Shared Function DeleteObject(ByVal hObject As IntPtr) As Boolean
End Function

<DllImport("user32.dll", CallingConvention:=CallingConvention.Cdecl)> _
Private Shared Function GetIconInfo(ByVal hIcon As IntPtr, ByRef
piconinfo As ICONINFO) As Boolean
End Function

Private Structure ICONINFO
Dim fIcon As Boolean
Dim xHotspot As Integer
Dim yHotspot As Integer
Dim hbmMask As IntPtr
Dim hbmColor As IntPtr
End Structure

#End Region 'Correct alpha blending
Private Base As Icon 'The underlying icon class
#Region " Original Constructors"
Public Sub New(ByVal IconFile As String)
Base = New Icon(IconFile)
End Sub
Public Sub New(ByVal Original As Icon, ByVal Size As Size)
Base = New Icon(Original, Size)
End Sub
Public Sub New(ByVal Type As System.Type, ByVal Resource As String)
Base = New Icon(Type, Resource)
End Sub
Public Sub New(ByVal Stream As IO.Stream)
Base = New Icon(Stream)
End Sub
Public Sub New(ByVal Stream As IO.Stream, ByVal Width As Integer, ByVal
Height As Integer)
Base = New Icon(Stream, Width, Height)
End Sub
#End Region
#Region " Original Methods"
Public Function Clone() As ExtendedIcon
Return New ExtendedIcon(CType(Base.Clone, Icon))
End Function
Public Function CreateObjRef(ByVal RequestedType As System.Type) As
System.Runtime.Remoting.ObjRef
Return Base.CreateObjRef(RequestedType)
End Function
Public Sub Dispose()
Base.Dispose()
End Sub
Public Shared Function FromHandle(ByVal Handle As IntPtr) As ExtendedIcon
Return New ExtendedIcon(Icon.FromHandle(Handle))
End Function
Public Function GetLifeTimeService() As Object
Return Base.GetLifetimeService
End Function
Public Function InitializeLifeTimeService() As Object
Return Base.InitializeLifetimeService()
End Function
Public Sub Save(ByVal ToStream As IO.Stream)
Base.Save(ToStream)
End Sub
#End Region
#Region " Original Properties"
Public ReadOnly Property Handle() As IntPtr
Get
Return Base.Handle
End Get
End Property
Public ReadOnly Property Height() As Integer
Get
Return Base.Height
End Get
End Property
Public ReadOnly Property Size() As Drawing.Size
Get
Return Base.Size
End Get
End Property
Public ReadOnly Property Width() As Integer
Get
Return Base.Width
End Get
End Property
#End Region
#Region " Added Constructors"
Friend Sub New(ByVal Prototype As Icon)
Base = Prototype
End Sub
Public Sub New(ByVal Stream As IO.Stream, ByVal Size As Size)
Me.New(Stream, Size.Width, Size.Height)
End Sub
Public Sub New(ByVal Buffer As Byte())
Dim Stream As New BufferStream(Buffer)
Base = New Icon(Stream)
End Sub
Public Sub New(ByVal Buffer As Byte(), ByVal Size As Size)
Me.New(Buffer, Size.Width, Size.Height)
End Sub
Public Sub New(ByVal Buffer As Byte(), ByVal Width As Integer, ByVal
Height As Integer)
Dim Stream As New BufferStream(Buffer)
Base = New Icon(Stream, Width, Height)
End Sub
#End Region
#Region " Added Methods"
Public Function ToBitmap() As Drawing.Bitmap
Dim Info As New ICONINFO
GetIconInfo(Base.Handle, Info)
Dim bmp As Bitmap = Bitmap.FromHbitmap(Info.hbmColor)
DeleteObject(Info.hbmColor)
DeleteObject(Info.hbmMask)
If Bitmap.GetPixelFormatSize(bmp.PixelFormat) < 32 Then
Return Base.ToBitmap
End If

Dim bmData As Imaging.BitmapData
Dim bmBounds As New Rectangle(0, 0, bmp.Width, bmp.Height)

bmData = bmp.LockBits(bmBounds, _
ImageLockMode.ReadOnly, _
bmp.PixelFormat)

Dim dstBitmap As New Bitmap(bmData.Width, _
bmData.Height, _
bmData.Stride, _
PixelFormat.Format32bppArgb, _
bmData.Scan0)

Dim x, y As Integer
Dim IsAlphaBitmap As Boolean = False

For y = 0 To bmData.Height - 1
For x = 0 To bmData.Width - 1
Dim PixelColor As Color
PixelColor = Color.FromArgb(Marshal.ReadInt32(bmData.Scan0,
(bmData.Stride * y) + (4 * x)))
If PixelColor.A > 0 And PixelColor.A < 255 Then
IsAlphaBitmap = True
Exit For
End If
Next
If IsAlphaBitmap Then Exit For
Next

bmp.UnlockBits(bmData)

If IsAlphaBitmap Then
Return New Bitmap(dstBitmap)
Else
Return New Bitmap(Base.ToBitmap)
End If
End Function 'Correct alpha blending, picked this up somewhere on the net
Public Shared Function FromFileExtension(ByVal Extension As String, ByVal
Method As FileExtensionMethod, Optional ByVal Size As IconSize = IconSize.
Small) As ExtendedIcon
Select Case Method
Case FileExtensionMethod.DummyFile
'Create a dummy file in the Internet Cache special folder
Dim TheFile As New IO.FileInfo(Environment.GetFolderPath
(Environment.SpecialFolder.InternetCache) & "\Dummy." & Extension)
Dim TheIcon As Icon
If Not TheFile.Exists Then 'Dont want to stumble uppon
something
TheFile.Create.Close() 'Just created the file and closed
the stream
TheIcon = Extract(TheFile.FullName, Size)
TheFile.Delete() 'We created it so lets kill it
Else
TheIcon = Extract(TheFile.FullName, Size) 'Dont delete
anything that was already there
End If
Return New ExtendedIcon(TheIcon)
Case FileExtensionMethod.Registry
Dim AppPath As String
AppPath = ApplicationPath(Extension) 'Get the associated
application path from the registry
Return New ExtendedIcon(Extract(AppPath, Size)) 'return it's
icon
End Select
End Function
Public Shared Function FromAnyFile(ByVal FilePath As String, Optional
ByVal Size As IconSize = IconSize.Small) As ExtendedIcon
Return New ExtendedIcon(Extract(FilePath, Size))
End Function
#End Region
#Region " Support Methods"
Private Shared Function Extract(ByVal File As String, ByVal Size As
IconSize) As System.Drawing.Icon

Dim aSHFileInfo As SHFILEINFO
Dim cbFileInfo As Integer
Dim uflags As Integer
Dim Icon As System.Drawing.Icon

Select Case Size
Case IconSize.Large
uflags = SHGFI_ICON Or SHGFI_LARGEICON
Case Else
uflags = SHGFI_ICON Or SHGFI_SMALLICON
End Select

cbFileInfo = Marshal.SizeOf(aSHFileInfo)

SHGetFileInfo(File, 0, aSHFileInfo, cbFileInfo, uflags)

Icon = System.Drawing.Icon.FromHandle(aSHFileInfo.hIcon)

Return Icon

End Function
Private Shared Function ApplicationName(ByVal ext As String) As String
Dim registeredExtension As RegistryKey = Registry.ClassesRoot.
OpenSubKey(ext)
ApplicationName = registeredExtension.GetValue("")
registeredExtension.Close()
End Function
Private Shared Function ApplicationPath(ByVal ext As String) As String
Dim associatedApplication As RegistryKey
Dim AppName As String = ApplicationName(ext)
Dim properties() As String
Try
associatedApplication = Registry.ClassesRoot.OpenSubKey(AppName &
"\shell\open\command")
properties = Split(associatedApplication.GetValue(""), """")
Catch ex As Exception
Exit Function
Finally
associatedApplication.Close()
End Try
If properties Is Nothing OrElse properties.Length = 0 Then Return ""
Dim S As String
For Each S In properties
If Dir(S) <> "" And S <> "" Then
Return S
End If
If InStr(S, " ") <> 0 Then
Dim SS() As String = S.Split
Dim f As String
For Each f In SS
If InStr(f, "\") = 0 Then f = Environment.SystemDirectory
& "\" & f
If Dir(f) <> "" And f <> "" Then
Return f
End If
Next
End If
Next
End Function
#End Region
#Region " Support Classes"
Private Class BufferStream
Inherits IO.Stream
Private Buffer As Byte()
Private Pos As Long
Sub New(ByVal B As Byte())
Buffer = B
End Sub
Public Overrides ReadOnly Property CanRead() As Boolean
Get
Return False
End Get
End Property

Public Overrides ReadOnly Property CanSeek() As Boolean
Get
Return False
End Get
End Property

Public Overrides ReadOnly Property CanWrite() As Boolean
Get
Return False
End Get
End Property

Public Overrides Sub Flush()
End Sub

Public Overrides ReadOnly Property Length() As Long
Get
Return Buffer.Length
End Get
End Property

Public Overrides Property Position() As Long
Get
Return Pos
End Get
Set(ByVal Value As Long)
Pos = Value
End Set
End Property

Public Overrides Function Read(ByVal inbuffer() As Byte, ByVal offset
As Integer, ByVal count As Integer) As Integer
Dim i As Long, ib As Integer
'Stupid Icon class reads everything at once...
'I gave it a length of 160MB and it still tried to read it at
once
For i = Pos + offset To Pos + offset + count - 1
inbuffer(ib) = Buffer(i)
ib += 1
Next
End Function

Public Overrides Function Seek(ByVal offset As Long, ByVal origin As
System.IO.SeekOrigin) As Long
Select Case origin
Case IO.SeekOrigin.Begin
Pos = offset
Case IO.SeekOrigin.Current
Pos += offset
Case IO.SeekOrigin.End
Pos = Buffer.Length - offset
End Select
End Function

Public Overrides Sub SetLength(ByVal value As Long)
End Sub

Public Overrides Sub Write(ByVal buffer() As Byte, ByVal offset As
Integer, ByVal count As Integer)
End Sub
Sub Dispose()
Erase Buffer
End Sub
End Class 'For constructor using byte array
#End Region
End Class
#Region " Enums"
Public Enum FileExtensionMethod
Registry 'Check the windows Registry... Not 100%
DummyFile ' Create a dummy file with the extension and let windows decide
End Enum
Public Enum IconSize
Small ' eeeer Small :)
Large ' If not small then...
End Enum
#End Region

------------------------------------------ Code End --------------------------
-----------------
--
Message posted via http://www.dotnetmonster.com
Nov 21 '05 #5

P: n/a
| Note that although your method is nice cause you avoid read/writes from
the
| disk it is not very reliable....

interesting. i tried it with .mdb and got a typical ms access icon...i do
see your point though, since i tried .jpg and got a shell command for it to
be opened by the image viewer on xp rather than, say, ms paint.

i'm glad you've got what you need.

all the best.
Nov 21 '05 #6

This discussion thread is closed

Replies have been disabled for this discussion.