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
#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
Private intIconNumber As Long = 0
Private intIconCount As Long = 0
Private ar As New SortedList
Private destinationFolder As String = ""
Private blnCheckForDupes As Boolean
Private strCurrentFolder As String
Dim strCurrentFile As String
Private intFolderX As Integer
Private intFolderY As Integer
Private strFilterAr() As String
Private frmParent As Form
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)
Private Function GetNumberOfIcons(ByVal fl As String) As Integer
Return ExtractIconEx(fl, -1, 0, 0, 0)
End Function
Private Sub ExtractIconsFromFile(ByVal f As FileInfo)
Dim numicons As Integer
Dim retval As Integer
numicons = GetNumberOfIcons(f.FullName)
For i As Integer = 0 To numicons - 1
retval = ExtractIcon(frmParent.Handle.ToInt32,
f.FullName, i)
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
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
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
bc = br.ReadBytes(fStream.Length)
fStream.Close()
Try
ar.Add(Convert.ToBase64String(bc), i)
Catch ex As Exception
End Try
i += 1
Catch ex As Exception
End Try
Next
End Sub
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)
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
Public Sub ExtractIcons()
Dim intCounter As Integer = 0
Dim lstStringFolders As New ArrayList
Dim strSubFolders As String()
Dim lstSortedFolders As New ArrayList
lstStringFolders.Add(strCurrentFolder)
If blnCheckForDupes Then LoadCurrentIcons()
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)
Dim d As New DirectoryInfo(lstStringFolders(intCounter))
strCurrentFolder = d.FullName
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
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
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()
btnStop.Enabled = True
chkNoDuplicates.Enabled = False
btnStart.Enabled = False
Application.DoEvents()
t = New DateTime
Timer1.Enabled = True
End If
End Sub
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
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
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
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
Threading.Thread.Sleep(250)
End While
Timer1.Enabled = False
btnStart.Enabled = True
chkNoDuplicates.Enabled = True
End Sub
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
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)
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.