How to capture an icon from an EXE ????

I have a program that has a directory of exe files. Each exe has a unique icon that represents the application.

I have a vb program that needs to display the exe's icon in a picture/image control.

How?

I think there was a tip about how to do it but i never got it to work correctly. Extracting the fifth icon from moricons.dll crashed my app

Quite simple, really :)

Code:

---


Declare Function ExtractIconEx Lib "shell32" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phIconLarge As Long, phIconSmall As Long, ByVal nIcons As Long) As Long

' Usage:

Dim hIcon As Long

ExtractIconEx "C:\THIS\IS\A\COOL\PROGRAM.EXE", 0, hIcon, ByVal 0&, 1

' To specify NULL, pass "byval 0&". (as I did for phIconSmall). DO NOT FORGET THE BYVAL PART!

' To get a count, pass -1 for the index and NULL for both phIconLarge and phIconSmall:

nIcons = ExtractIconEx("C:\WINDOWS\MORICONS.DLL", -1, ByVal 0&, ByVal 0&, 0)

' To extract several icons at once, create an array and pass the first item:

Dim hIcons(10) As Long

ExtractIconEx "C:\HERE\ARE\LOTS\OF\ICONS.DLL", 0, hIcons(0), ByVal 0&, 10

---

Incidentally, because this is a Shell32 function, it has the following properties:

* As expected, it will extract icons from DLLs, EXEs, and friends.
* Not surprisingly, it will also extract the icon from a .ICO file.
* If the file is a bitmap, it returns the bitmap's image squished into a 32x32 icon. The transparent color is set to the color of the pixel at (0, 0).
* If the file is a .CUR (cursor) file, it extracts the cursor's image.

I can get the icon extracted now, but I need to save this as a file. I only know how to draw it to the form.

It doesn't matter if it is saved as a .bmp or .ico, however, it would be nice to know how to save it as both types, though?? ;)

You should use savepicture statement, that will save your icon or bitmap to what it is, just remeber that a picture property can be only one of them and that saving a bitmap into an ico wont turn into an "real" icon.

Erm, that's gonna be a little bit more difficult.

First off, to save it as an bitmap, you'll need to choose a background color, as bitmaps don't support transparent and inverse colors.

Now, in either case, you need to to make a few API calls to get the two bitmaps used to draw the icon. Right now my brain is too fried to remember exactly which calls those are.

Then you need to go to Wotsit's Format (http://www.wotsit.org) and find the file formats for bitmap and icon files.

Hi... I'm not sure if you already had got it to work, but here's some code from a prog. I wrote.

Code:

---

Option Explicit


              Private Type PicBmp
                  Size As Long
                  tType As Long
                  hBmp As Long
                  hPal As Long
                  Reserved As Long
              End Type

              Private Type GUID
                  Data1 As Long
                  Data2 As Integer
                  Data3 As Integer
                  Data4(7) As Byte
              End Type

              Private Declare Function OleCreatePictureIndirect _
              Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As GUID, _
              ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long

              Private Declare Function ExtractIconEx Lib "shell32.dll" _
              Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal _
              nIconIndex As Long, phiconLarge As Long, phiconSmall As _
              Long, ByVal nIcons As Long) As Long

              Private Declare Function DestroyIcon Lib "user32" (ByVal _
              hicon As Long) As Long


Public Function GetIconFromFile(Filename As String, _
              IconIndex As Long, UseLargeIcon As Boolean) As Picture

              'Parameters:
              'FileName - File (EXE or DLL) containing icons
              'IconIndex - Index of icon to extract, starting with 0
              'UseLargeIcon-True for a large icon, False for a small icon
              'Returns: Picture object, containing icon

              Dim hlargeicon As Long
              Dim hsmallicon As Long
              Dim selhandle As Long

              'IPicture requires a reference to "Standard OLE Types."
              Dim pic As PicBmp
              Dim IPic As IPicture
              Dim IID_IDispatch As GUID

              If ExtractIconEx(Filename, IconIndex, hlargeicon, _
              hsmallicon, 1) > 0 Then

              If UseLargeIcon Then
              selhandle = hlargeicon
              Else
              selhandle = hsmallicon
              End If

              'Fill in with IDispatch Interface ID.
              With IID_IDispatch
              .Data1 = &H20400
              .Data4(0) = &HC0
              .Data4(7) = &H46
              End With
              'Fill Pic with necessary parts.
              With pic
              .Size = Len(pic) 'Length of structure.
              .tType = vbPicTypeIcon 'Type of Picture (bitmap).
              .hBmp = selhandle 'Handle to bitmap.
              End With

              'Create Picture object.
              Call OleCreatePictureIndirect(pic, IID_IDispatch, 1, IPic)

              'Return the new Picture object.
              Set GetIconFromFile = IPic

              DestroyIcon hsmallicon
              DestroyIcon hlargeicon

              End If
              End Function


Private Sub lblIcon_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
'Right click > popup menu
If Button = vbRightButton Then
    Me.PopupMenu mnuFile
    ElseIf Button = vbLeftButton Then
    Me.PopupMenu mnuConvert
    End If
End Sub

Private Sub lblStatus_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
'Right click > popup menu
If Button = vbRightButton Then
    Me.PopupMenu mnuFile
    ElseIf Button = vbLeftButton Then
    Me.PopupMenu mnuConvert
    End If
End Sub


Private Sub lblW_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
If Button = vbRightButton Then
    Me.PopupMenu mnuFile
    ElseIf Button = vbLeftButton Then
    Me.PopupMenu mnuConvert
    End If
End Sub
Private Sub lblH_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
'Right click > popup menu
If Button = vbRightButton Then
    Me.PopupMenu mnuFile
    ElseIf Button = vbLeftButton Then
    Me.PopupMenu mnuConvert
End If
End Sub

Private Sub mnuBI_Click()
Dim SaveBI As String, F As Integer
Picture2.Picture = Picture1.Image
Comd1.Flags = cdlOFNOverwritePrompt + cdlOFNNoChangeDir
Comd1.DialogTitle = "Save Icon"
Comd1.Filter = "Icons (*.ico)|*.ico"
Comd1.ShowSave
SaveBI = Comd1.Filename
SavePicture Picture2.Picture, SaveBI
End Sub


Private Sub mnuSaveBMP_Click()
Dim SaveBMP As String, F As Integer
Picture2.Picture = Picture1.Picture
Comd1.Flags = cdlOFNOverwritePrompt + cdlOFNNoChangeDir
Comd1.DialogTitle = "Save Icon"
Comd1.Filter = "Bitmaps (*.bmp)|*.bmp"
Comd1.ShowSave
SaveBMP = Comd1.Filename
SavePicture Picture2.Image, SaveBMP
End Sub


Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
'Right click > popup menu
If Button = vbRightButton Then
    Me.PopupMenu mnuFile
    ElseIf Button = vbLeftButton Then
    Me.PopupMenu mnuConvert
End If
End Sub

Private Sub mnuExtract_Click()
'Menu Extract Icon
Dim IcoFile As String
Dim Filename As String
Comd1.DialogTitle = "Extract File"
Comd1.Filter = "All supported files|*.exe;*.dll;*.ico,*.bmp|Executables (*.exe)|*.exe|DLL Files (*.dll)|*.dll|Ico Files (*.ico)|*.ico|Bitmap(*.bmp)|*.bmp|All Files (*.*)|*.*"
Comd1.ShowOpen
IcoFile = Comd1.Filename
'Plaats Ico in PictureBox
Set Picture1.Picture = GetIconFromFile(IcoFile, 0, True)
lblH = Picture1.Height
lblW = Picture1.Width
lblStatus.Caption = Comd1.FileTitle
End Sub

Private Sub mnuInfo_Click()
frmAbout.Show
End Sub

Private Sub mnuSave_Click()
Dim SaveIco As String, F As Integer
Comd1.Flags = cdlOFNOverwritePrompt + cdlOFNNoChangeDir
Comd1.DialogTitle = "Save Icon"
Comd1.Filter = "Icons (*.ico)|*.ico"
Comd1.ShowSave
SaveIco = Comd1.Filename
SavePicture Picture1.Picture, SaveIco
End Sub

Private Sub mnuQuit_Click()
Unload Me
End Sub
Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
'Right click > popup menu
If Button = vbRightButton Then
    Me.PopupMenu mnuFile
ElseIf Button = vbLeftButton Then
    Me.PopupMenu mnuConvert
End If
End Sub

Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, x As Single, Y As Single)
'Right click > popup menu
If Button = vbRightButton Then
    Me.PopupMenu mnuFile
ElseIf Button = vbLeftButton Then
    Me.PopupMenu mnuConvert
End If
End Sub

---

I'm sorry for posting non-nessecary elements, but I'm tired..
if you have any questions, just mail me:
[email protected]

Jop

Private Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" (ByVal hInst As Long, ByVal lpIconPath As String, lpiIcon As Long) As Long
Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long

Private Sub Command1_Click()
Dim lIcon As Long
On Error GoTo User_Cancelled
With CommonDialog1
.Flags = cdlOFNNoValidate
.CancelError = True
.DialogTitle = "Select a File.."
.Filter = "All Files (*.*)|*.*"
.ShowOpen
Picture1.Cls
lIcon = ExtractAssociatedIcon(App.hInstance, .FileName, -1)
Call DrawIconEx(Picture1.hdc, 0, 0, lIcon, 32, 32, 0, 0, 3)
End With
User_Cancelled:

End Sub

Erm, he doesn't need to draw an icon, he needs to save it to a file.

Code:

---

Declare Function ExtractIconEx Lib "shell32" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phIconLarge As Long, phIconSmall As Long, ByVal nIcons As Long) As Long

Function GetIconsFromFile(Filename$)
    Dim hIcons()
    ReDim hIcons(ExtractIconEx(Filename, -1, ByVal 0&, ByVal 0&, 0))
    If UBound(hIcons) = 0 Then Exit Function Else ReDim Preserve hIcons(UBound(hIcons) - 1)
    ExtractIconEx Filename, 0, hIcons(0), ByVal 0&, 10 '<--- VB crashes here
    GetIconsFromFile = hIcons
End Function

---

Why does it crash when i pass filename as "C:\windows\moricons.dll"?

I use VB5 Enterprise edit if that's any use

Once you have the Icon drawn on the Picturebox you can save it using the "SavePicture" method, i.e.

Code:

---

Private Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" (ByVal hInst As Long, ByVal lpIconPath As String, lpiIcon As Long) As Long
Private Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long

Private Sub Command1_Click()
    Dim lIcon As Long
    On Error GoTo User_Cancelled
    With CommonDialog1
        .CancelError = True
        .DialogTitle = "Select a File..."
        .Filter = "All Files (*.*)|*.*"
        .ShowOpen
       
        Picture1 = LoadPicture()
        Picture1.AutoRedraw = True
        Picture1.Cls
        lIcon = ExtractAssociatedIcon(App.hInstance, .FileName, -1)
        Call DrawIconEx(Picture1.hdc, 0, 0, lIcon, 32, 32, 0, 0, 3)
        Picture1 = Picture1.Image
       
        .DialogTitle = "Save Bitmap as..."
        .Filter = "BMP Files (*.bmp)|*.bmp"
        .ShowSave
        SavePicture Picture1, .FileName
    End With
User_Cancelled:
End Sub

---

If you want to save it as an Icon, then you can use an "ImageList" control and use the "ExtractIcon" Method after adding the Bitmap Image to the List to save an Icon version.

I did get the last code working which is extracting Icos associated with dll or exes. But I'm curious to know how can we extract all the icons/gif/bmps used in the application - like used on buttons or else where. Any idea? And how can we extract out a .frm file?
Please suggest.
thanks