Members

Technology Zones

IBM Learning Center

Articles

Hosted By

MaximumASP

Info
Rated
Read 49,070 times
5 comments

Contents

Related Categories

File Extensions: Finding the default Icon - The Complete Code

couling

The Complete Code

So all together now:

Option Explicit
'For looking at registry keys
'To: Open key ready to look at
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
'To: Look at key
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As Any, lpcbData As Long) As Long
'To: Close the key when it's finished with
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const KEY_READ = &H20019 'To allow us to READ the registry keys

'For Drawing the icon
'To: Retrieve the icon from the .EXE, .DLL or .ICO
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long  
'To: Draw the icon into our picture box 
Private Declare Function DrawIcon Lib "user32.dll" (ByVal hDC As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long
'To: Clean up after our selves (destroy the icon that "ExtractIcon" created)
Private Declare Function DestroyIcon Lib "user32.dll" (ByVal hIcon As Long) As Long

'For Finding the System folder
Private Declare Function GetSystemDirectory Lib "kernel32.dll" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Private Sub GetDefaultIcon(FileName As String, Picture_hDC As Long )
    Dim TempFileName As String 'Never manipulate an input unless it doubles as an output
    Dim lngError As Long'For receiving error numbers
    Dim lngRegKeyHandle As Long'Stores the "handle" of the registry key that is currently open
    Dim strProgramName As String'Stores the contents of the first registry key
    Dim strDefaultIcon As String'Stores the contents of the second registry key  
    Dim lngStringLength As Long'Sets / Returns the length of the output string  
    Dim lngIconNumber As Long'Stores the icon number within a file 
    Dim lngIcon As Long'Stores the "Icon Handle" for the default icon  
    Dim intN As Integer 'For any temporary numbers 

    TempFileName = Right(FileName, Len(FileName) - InStrRev(FileName, ".") + 1) 

    If LCase(TempFileName) = ".exe" Then  
        strDefaultIcon = Space(260) 
        lngStringLength = GetSystemDirectory(strDefaultIcon, 260) 
        strDefaultIcon = Left(strDefaultIcon, lngStringLength) & "\SHELL32.DLL" 
        lngIconNumber = 2 
        GoTo Draw_Icon 
    End If  

    lngError = RegOpenKey(HKEY_CLASSES_ROOT, TempFileName, lngRegKeyHandle) 
    If lngError Then GoTo No_Icon 'we do not even have a valid extension so lets NOT try to find an icon!  
    lngStringLength = 260 
    strProgramName = Space$(260) 'Make space for the incoming string  
    'Get the key value:  
    lngError = RegQueryValueEx(lngRegKeyHandle, vbNullString, 0, 0, strProgramName, lngStringLength) 
    If lngError Then'if there's an error then BIG TROUBLE so lets use the normal "windows" icon  
        lngError = RegCloseKey(lngRegKeyHandle) 'the world may be about to end (or just an error) but we'll clean up anyway  
        GoTo No_Icon 
    End If  
    lngError = RegCloseKey(lngRegKeyHandle) 'if this generates an error then we can't do anything about it anyway 
    strProgramName = Left(strProgramName, lngStringLength - 1) 'Cut the name down to size 

    'Use the value of the last key in the name of the next one (strProgramName)  
    lngError = RegOpenKey(HKEY_CLASSES_ROOT, strProgramName & "\DefaultIcon", lngRegKeyHandle) 
    If lngError Then GoTo No_Icon 'there is no icon for this extension so lets NOT try to load what doesn't exist!  
    'The rest is just the same as before  
    lngStringLength = 260 
    strDefaultIcon = Space$(260) 
    lngError = RegQueryValueEx(lngRegKeyHandle, vbNullString, 0, 0, strDefaultIcon, lngStringLength) 
    If lngError Then  
        lngError = RegCloseKey(lngRegKeyHandle) 
        GoTo No_Icon 
    End If  
    lngError = RegCloseKey(lngRegKeyHandle) 
    strDefaultIcon = Trim$(Left(strDefaultIcon, lngStringLength - 1)) 

    intN = InStrRev(strDefaultIcon, ",") 'Find the commer  
    If intN < 1 Then GoTo No_Icon 'We MUST have an icon number and it will be after the ",": NO COMMA NO DEFAULT ICON 
    lngIconNumber = Trim$(Right(strDefaultIcon, Len(strDefaultIcon) - intN)) 'What number is after the comma  
    strDefaultIcon = Trim$(Left(strDefaultIcon, intN - 1)) 'We only want what's before the comma in the file name  

Draw_Icon: 
    lngIcon = ExtractIcon(App.hInstance, strDefaultIcon, lngIconNumber) 'Extract the Icon  
    If lngIcon = 1 Or lngIcon = 0 Then GoTo No_Icon 'if 1 or 0 then after all that the Icon Could not be retrieved  

    lngError = DrawIcon(Picture_hDC, 0, 0, lngIcon) 'Draw the icon in the box 
    'If that was unsucessful then we can't do anything about it now!  
    lngError = DestroyIcon(lngIcon) 
    'Again we can't correct any errors now  
    Exit Sub
No_Icon: 
    'No icon could be found so we use the normal windows icon 
    'This icon is held in shell32.dll in the system directory, Icon 0  
    strDefaultIcon = Space(260) 
    lngStringLength = GetSystemDirectory(strDefaultIcon, 260) 
    strDefaultIcon = Left(strDefaultIcon, lngStringLength) & "\SHELL32.DLL" 
    lngIconNumber = 0 
    GoTo Draw_Icon
End Sub

Just incase it’s not obvious (I hope i is), here’s how to use this subroutine (remember that picture box etc. that I said you’d need at the beginning) and make sure that “AutoRedraw” is set to True!:

Private Sub Command1_Click()
    Picture1.Cls
    GetDefaultIcon Text1.Text, Picture1.hDC
End Sub

Simple as that! I hope this has all been helpful.

Just graduated from the University of Birmingham. Computer Science and Artifical Intelligence 2.2 Languages: Java c++ PHP Prolog VB6

Comments

Read Comments | Post Comment

  • Re: [2982] File Extensions: Finding the default Icon

    Posted by Anishsane on 22 May 2007

    does any one want to extract image used for icon?
    the icon may be in an exe file or dll file.
    this is a veryyyyyyyy long way, and there are ready softwares available for it.

    but it is dis...

  • About lessons and codes

    Posted by PATHFINDER on 16 Jul 2005

    I'll never be thankful enough to have decided to join Developer Fusion. It's real fun to have what's needed to start with programming language. I am really amazed of the progresses i have done in two ...

  • INTERESTING

    Posted by Tochukwu on 02 Jun 2005

    THAT WAS A NICE JOB.

    I AM AN UNDERGRADUATE STUDYING COMPUTER PRORAMMING. i WILL NEED MORE EXPLANATION ON THIS TOPIC.

    tOCHUKWU.

  • Posted by jab on 18 Sep 2003

    Absolutely brilliant! Works a treat.

    THANKS VERY MUCH!!!

  • Posted by couling on 13 Sep 2003

    Looks like my reply is too large to fit in one post so I've put it [url="http://mysite.freeserve.com/visualbasic/16.htm"]here[/url].

    Hope this helps :cool: