Icon Extractor in VB.NET

• Download demo project - 11 Kb
• Download source - 22 Kb

Introduction

In my years of developing windows applications, finding the best icons is sometimes the most difficult thing to do. When I eventually settle on one, I always wonder if there was something better that I could have used. What I've developed here, is an Icon Extractor. Point the application to a directory, and let it run... It scans every DLL, EXE, and ICO file in every directory under the one you provide (can be edited to scan other files too like OCX's). I hope some of you find this useful for your own development. The demo application is really quite quick as well. It scanned 10 GB worth of files and came up with 6182 icons in 10:33 minutes! I also have to admit that it's fun to watch it run through all the files on your computer and watch the forms' icon flash through about 50 icons in a second!

Background

The general idea is to pull out icons that are embedded resources to DLL's or EXE's. The way it's done is with the old fashioned Win32 API's. I had intended to use .NET's System.Reflection.Assembly.GetEmbeddedResource function, but this only works for managed assemblies. I found that the API's work on anything.

Using the code

When you click the button, here's what happens:

• Load a DirectroyInfo object based on user input.
• Use GetDirectories in conjunction with GetFiles to find all the file types that might have an icon in them.
• While looping through the files, extract each icon that's available, and save it to a directory using a FileStream
• That's pretty much it.

Below is the class used to extract all the icons.

[ Editor Note - the lines have been wrapped to avoid scrolling]

Imports System
Imports System.IO
Class IconExtractor
    'First, lets declare the API's we'll need.
#Region "API's"
    Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" _
            (ByVal lpszFile As String, _
             ByVal nIconIndex As Integer, _
             ByRef phiconLarge As Integer, _
             ByRef phiconSmall As Integer, _
             ByVal nIcons As Long) As Integer
    Declare Function DestroyIcon Lib "user32.dll" 
     (ByVal hIcon As Integer) As Integer
    Declare Function GetStockObject Lib "gdi32.dll" 
     (ByVal nIndex As Integer) As Integer
    Declare Function DrawIconEx Lib "user32.dll" 
     (ByVal hdc As Integer, ByVal xLeft As Integer, ByVal yTop As Integer, 
     ByVal hIcon As Integer, ByVal cxWidth As Integer, ByVal cyWidth As Integer, 
     ByVal istepIfAniCur As Integer, ByVal hbrFlickerFreeDraw As Integer, 
     ByVal diFlags As Integer) As Integer
    Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" 
     (ByVal hInst As Integer, ByVal lpszExeFileName As String,
      ByVal nIconIndex As Integer) As Integer
#End Region

    ' keeps track of what to name each file to create. 
    Private intIconNumber As Long = 0

    ' keeps track of how many icons we've created.
    Private intIconCount As Long = 0

    'holds an array of BASE64 strings which representPrivate 
    'ar As New SortedList
    'each icon that we've written. This is used to make sure 
    'we don't create duplicate icons.
    Private ar As New SortedList

    'determines where the files are to be put.
    Private destinationFolder As String = ""

    'variable to determine if we care about duplicate icons.
    Private blnCheckForDupes As Boolean

    'keeps track of the folder we are processing: sent to client in event
    Private strCurrentFolder As String

    'keeps track of the file we are processing: sent to client in event
    Dim strCurrentFile As String

    'Current numbered directory we're working on, 
    'used to determine percent complete
    Private intFolderX As Integer

    'total number of directories/sub directories we've got to look at
    Private intFolderY As Integer

    'the file types we'd like to look for icons in
    Private strFilterAr() As String

    'the parent form that's calling this class. needed to draw the icon on.
    Private frmParent As Form

    'variable to hold the icon in
    Private icon As icon

    Public Event On_Progress(ByVal folder As String, 
     ByVal file As String, ByVal searchingForDupes As Boolean,
      ByVal folderX As Integer, ByVal folderY As Integer, 
      ByVal totalIconsFound As Integer)
    Public Event On_Complete(ByVal totalIconsFound As Integer)
    Public Event LoadingCurrentIcons(ByVal current As Integer, 
     ByVal total As Integer)

    'calls API to determine how many icons are embedded in the file
    Private Function GetNumberOfIcons(ByVal fl As String) As Integer
        Return ExtractIconEx(fl, -1, 0, 0, 0)
    End Function

    'Extracts each icon from the file given, and saves 
    'it to the destination directory
    Private Sub ExtractIconsFromFile(ByVal f As FileInfo)
        Dim numicons As Integer  ' number of regular icons in the file
        Dim retval As Integer  ' return value
        numicons = GetNumberOfIcons(f.FullName)

        For i As Integer = 0 To numicons - 1
            retval = ExtractIcon(frmParent.Handle.ToInt32,
              f.FullName, i) '?Me.Handle?
            If retval > 0 Then
                Dim stream As New IO.MemoryStream
                frmParent.Icon = icon.FromHandle(New IntPtr(retval))
                Application.DoEvents()
                frmParent.Icon.Save(stream)

                Dim b(stream.Length) As Byte
                stream.Position = 0
                stream.Read(b, 0, stream.Length)
                stream.Close()
                Dim blnOkToCreate As Boolean

                If blnCheckForDupes = False Then
                    blnOkToCreate = True
                ElseIf blnCheckForDupes Then
                    RaiseEvent On_Progress(strCurrentFolder, 
                     strCurrentFile, True, intFolderX, intFolderY,
                      intIconCount)
                    blnOkToCreate = Not IconExists(b)
                    RaiseEvent On_Progress(strCurrentFolder, 
                     strCurrentFile, False, intFolderX,
                      intFolderY, intIconCount)
                End If
                If blnOkToCreate Then
                    Try
                        ar.Add(Convert.ToBase64String(b), intIconNumber)

                        Dim strIcon As New IO.FileStream(
                         destinationFolder & intIconNumber & ".ico", 
                         IO.FileMode.CreateNew)
                        strIcon.Write(b, 0, b.Length)
                        strIcon.Close()
                        intIconNumber += 1
                        intIconCount += 1
                        RaiseEvent On_Progress(strCurrentFolder, strCurrentFile,
                          False, intFolderX, intFolderY, intIconCount)

                    Catch ex As Exception
                    End Try
                End If
            End If
            DestroyIcon(retval)

        Next

    End Sub

    'Checks the array for the same key
    Private Function IconExists(ByVal b() As Byte) As Boolean
        Dim strCurrent As String = Convert.ToBase64String(b)
        For Each strKey As String In ar.Keys
            If strKey = strCurrent Then Return True
        Next
        Return False
    End Function

    'Called if we need to check the directory for what 
    'icons are allready in there. 
    'This way, we can call this class any time, and save icons 
    'to the same directory without
    'worrying about duplicates.
    Private Sub LoadCurrentIcons()
        Dim fi() As FileInfo = New DirectoryInfo(
         destinationFolder).GetFiles("*.ico")
        Dim s As IO.BinaryReader
        Dim str As String
        Dim i As Integer = 1
        For Each f As FileInfo In fi
            RaiseEvent LoadingCurrentIcons(i, fi.Length)
            Try
                Dim fStream As New FileStream(f.FullName, FileMode.Open)
                Dim br As New BinaryReader(fStream)
                Dim bc() As Byte 'current files bytes
                bc = br.ReadBytes(fStream.Length)
                fStream.Close()
                Try
                    ar.Add(Convert.ToBase64String(bc), i)
                Catch ex As Exception
                    'possibility of there being a dupe in the folder already.
                End Try

                i += 1

            Catch ex As Exception

            End Try

        Next

    End Sub

    'Get everything we need to get going. 
    Public Sub New(ByRef fHandle As Form, ByVal folderPath As String,
      ByVal dFolder As String, ByRef hIcon As icon, 
      ByVal checkForDupes As Boolean, ByVal filter() As String)
        Try
            If Not IO.Directory.Exists(dFolder) Then 
             IO.Directory.CreateDirectory(dFolder)
        Catch ex As Exception
            Throw New ArgumentException(
             "The folder specified could not be found or created.")
        End Try

        While IO.File.Exists(destinationFolder & intIconNumber & ".ico")
            intIconNumber += 1
        End While
        ar.Add("blah", 0) 'start the array off
        If Right(dFolder, 1) = "\" Or Right(dFolder, 1) = "/" 
         Then destinationFolder = dFolder Else destinationFolder &= "\"

        icon = hIcon
        blnCheckForDupes = checkForDupes
        strFilterAr = filter
        strCurrentFolder = folderPath
        frmParent = fHandle
    End Sub

    'Called with no parameters to simplify threading options.
    Public Sub ExtractIcons()

        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(strCurrentFolder)

        'Load the icons that we currenlty have in the directory. 
        'Use these as a base when comparing for duplicates.
        If blnCheckForDupes Then LoadCurrentIcons()

        'as a string list - just gives you a list of the
        ' folders that exist in the path
        Do Until intCounter = lstStringFolders.Count

            intFolderX = intCounter
            intFolderY = lstStringFolders.Count

            RaiseEvent On_Progress(strCurrentFolder, strCurrentFile, 
             False, intFolderX, intFolderY, intIconCount)

            Try
                strSubFolders = System.IO.Directory.GetDirectories(
                 lstStringFolders.Item(intCounter))

                lstStringFolders.AddRange(strSubFolders)

                'get all files in this folder:
                Dim d As New DirectoryInfo(lstStringFolders(intCounter))
                strCurrentFolder = d.FullName

                'make sure we're not looking in the directory we're writing to.
                If Right(strCurrentFolder, 1) = "\" Or
                  Right(strCurrentFolder, 1) = "/" Then
                    If strCurrentFolder.ToLower = destinationFolder.ToLower 
                     Then Exit Try
                Else
                    If d.FullName & "\".ToLower = 
                     destinationFolder.ToLower Then Exit Try
                End If

                'don't look in the recycle bins:
                If d.FullName.ToLower.IndexOf("recycler") > -1 Then Exit Try

                RaiseEvent On_Progress(strCurrentFolder, "", False, 
                 intFolderX, intFolderY, intIconCount)

                Dim fl() As FileInfo

                For Each sFilter As String In strFilterAr
                    fl = d.GetFiles(sFilter)
                    For Each f As FileInfo In fl
                        RaiseEvent On_Progress(strCurrentFolder,
                         f.Name, False, 
                         intFolderX, intFolderY, intIconCount)
                        ExtractIconsFromFile(f)
                    Next
                Next


            Catch ex As Exception

            End Try

            intCounter += 1
        Loop

        RaiseEvent On_Complete(intIconCount)

    End Sub
End Class
      
      

The form itself should use addHandler or dim the class withEvents to expose the events.

[ Editor Note - the lines have been wrapped to avoid scrolling]

Private t As DateTime
Const destDir As String = "C:\icons2\"
Private strFilter() As String = {"*.dll", "*.exe", "*.ico"}
Private th As Threading.Thread

'starts the whole thing off.
Private Sub Button2_Click(ByVal sender As System.Object, 
 ByVal e As System.EventArgs) Handles btnStart.Click
    If FolderBrowserDialog1.ShowDialog = DialogResult.OK Then
        Dim objIconExtractor As New IconExtractor(Me, 
         FolderBrowserDialog1.SelectedPath, destDir, Me.Icon, 
         chkNoDuplicates.Checked, strFilter)
        AddHandler objIconExtractor.On_Progress, 
         AddressOf UpdateUI
        AddHandler objIconExtractor.On_Complete, 
         AddressOf Completed
        AddHandler objIconExtractor.LoadingCurrentIcons, 
         AddressOf LoadingCurrentIcons
        th = New System.Threading.Thread(
         AddressOf objIconExtractor.ExtractIcons)
        th.Start() 'put the function into its own thread so 
         'I can cancel it, and move the form around.
        btnStop.Enabled = True
        chkNoDuplicates.Enabled = False
        btnStart.Enabled = False
        Application.DoEvents()
        t = New DateTime
        Timer1.Enabled = True 'timer to keep track of time elapsed. 
    End If
End Sub

'Handles when the class raises the On_Progress Event... 
'Lets tell the user where we are, and what we're up to:
Private Sub UpdateUI(ByVal folder As String, ByVal file As String, 
 ByVal searchingForDupes As Boolean, ByVal folderX As Integer, 
 ByVal folderY As Integer, ByVal totalIconsFound As Integer)
    lblFolder.Text = folder
    lblFile.Text = file
    If searchingForDupes Then lblProgress.Text = 
     "Scanning for duplicates..." Else lblProgress.Text = ""
    Try
        Dim percent As Integer = CInt((folderX / folderY) * 100)
        lblPercent.Text = percent & "%"
    Catch
    End Try
    ProgressBar1.Maximum = folderY
    ProgressBar1.Value = folderX

    Label2.Text = "New Icons Found: " & totalIconsFound
    Application.DoEvents()
End Sub

'All done
Private Sub Completed(ByVal intCount As Integer)
    ClearUI()
    Label2.Text = "Done: " & intCount & 
     " new icons were created."
    Timer1.Enabled = False
    btnStart.Enabled = True
    btnStop.Enabled = False
    chkNoDuplicates.Enabled = True
End Sub

'initialize the labels.
Private Sub ClearUI()
    lblFile.Text = ""
    lblFolder.Text = ""
    lblProgress.Text = ""
    lblPercent.Text = ""
End Sub

Private Sub Form1_Load(ByVal sender As System.Object, 
 ByVal e As System.EventArgs) Handles MyBase.Load
    ClearUI()
End Sub

'Cancel the thread if its still running. 
Private Sub btnStop_Click(ByVal sender As System.Object, 
 ByVal e As System.EventArgs) Handles btnStop.Click
    btnStop.Enabled = False
    Application.DoEvents()
    th.Abort()
    While Not th.ThreadState = Threading.ThreadState.Stopped
     'Wait for it to stop before continuing
        Threading.Thread.Sleep(250)
    End While
    Timer1.Enabled = False
    btnStart.Enabled = True
    chkNoDuplicates.Enabled = True
End Sub

'let the user know that we're loading the icons 
'that already exist in the given directory.
Private Sub LoadingCurrentIcons(ByVal current As Integer, 
 ByVal total As Integer)
    lblProgress.Text = "Loading current icons: " & 
     current & " of " & total & "."
    Application.DoEvents()
End Sub

Private Sub Timer1_Tick(ByVal sender As System.Object,
  ByVal e As System.EventArgs) Handles Timer1.Tick
    t = t.AddSeconds(1)
    lblTime.Text = t.TimeOfDay.ToString
    Application.DoEvents()
End Sub

'Be absolutely sure that the other thread is done,
' otherwise we really don't exit.
Private Sub Form1_Closing(ByVal sender As Object,
  ByVal e As System.ComponentModel.CancelEventArgs) Handles MyBase.Closing
    Try
        Me.Cursor = Cursors.WaitCursor
        If Not th Is Nothing Then
            If Not th.ThreadState = Threading.ThreadState.Stopped 
                  Then th.Abort()

            While Not th.ThreadState = Threading.ThreadState.Stopped
                Try
                    Threading.Thread.Sleep(100) 'this forms thread
                Catch ex As Exception

                End Try
            End While
        End If
    Catch ex As Exception
    End Try
End Sub

Points of Interest

I found that being able to run this multiple times, and always have the most current icons that are on my system are very beneficial. I can find an icon for almost any need.