[RESOLVED] Save Extracted Icon problem

[killer7k]

Hi ,

I have Extracted an Icon from an .exe
its displayed on a PictureBox after i want to save it i get an exception
invalid property value

Private Sub Command1_Click()

Dim hIcon As Long
Picture1.AutoRedraw = True
hIcon = ExtractAssociatedIcon(App.hInstance, "C:\IconChan.exe", 0)
DrawIcon Picture1.hdc, 0, 0, hIcon

Picture1.Refresh

SavePicture Picture1.Picture, "C:\Icon1.ico"


End Sub

Public Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" (ByVal hInst As Long, ByVal lpIconPath As String, lpiIcon As Long) As Long
Public Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long

Thanks !

[Edgemeal]

did you try,
SavePicture Picture1.Image, "C:\Icon1.ico"

[killer7k]

Thanks m8 It work but it look very bad when it saved
is there any way to save the same icon extracted from a file
without going for Picturebox ?

what i mean extract it & save it like it was !

Thanks !

[Siddharth Rout]

Does this shelp?

http://www.thescarms.com/vbasic/extracticons.aspx

[killer7k]

Thanks koolsid ,

The problem i get it's strange havent tested your link yet
but i modified my code & it display good
but the strange is that it doesnt save as a real icons ?!!

i will clarifie the situation
i have a programme that extract icone & change icon

change icon work very well
extract icon i have a bit problem with it , they extract icon good but save them in not a real icon

How ?

i have some icons in my pc when i load a programme & i choose for him a new icon : result = programme changed with new icons

but when i use the extracted icon as an icone for the programme
result = programme changed with a black icone (like icon for svchost.exe) not the real one

Strange !!!!

[LaVolpe]

Reason why it isn't a true icon is that if you are saving the .Image property, you will only get bmps, regardless of whatever extension you give the file name. However, if the .Picture property was an icon, than VB will save the .Picture property in actual icon format.

Saving an icon handle to a file can be done a couple different ways:
1. GetIconInfo API, write the icon header & then write the icon pixels. However, this requires knowledge of the icon file structure.

2. Luckily we can let VB do it for us with an API call & custom function.

' declarations
Private Type PictDesc
    Size As Long
    Type As Long
    hHandle As Long
    hPal As Long
End Type
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (lpPictDesc As PictDesc, _
    riid As Any, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long

' function
Public Function HandleToStdPicture(ByVal hImage As Long, ByVal imgType As Long) As IPicture

    ' function creates a stdPicture object from an image handle (bitmap or icon)
    ' pass vbPicTypeBitmap if handle is bitmap or vbPicTypeIcon if it is an icon
    
    Dim lpPictDesc As PictDesc, aGUID(0 To 3) As Long
    With lpPictDesc
        .Size = Len(lpPictDesc)
        .Type = imgType
        .hHandle = hImage
        .hPal = 0
    End With
    ' IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
    aGUID(0) = &H7BF80980
    aGUID(1) = &H101ABF32
    aGUID(2) = &HAA00BB8B
    aGUID(3) = &HAB0C3000
    ' create stdPicture
    Call OleCreatePictureIndirect(lpPictDesc, aGUID(0), True, HandleToStdPicture)
    
End Function

Example:

' assume an icon handle is stored in hIcon returned from ExtractAssociatedIcon

    Dim tmpPic As StdPicture
    Set tmpPic = HandleToStdPicture(hIcon, vbPicTypeIcon)
    SavePicture tmpPic, [path\filename]

Edited: I haven't tested this to see if it would actually work with XP alpha icons, though it might, but VB won't display these correctly anyway, without some API help (that's a different topic).

[killer7k]

hi LaVolpe,
I tried your example with my code but i get an exception invalid property value

What's wrong ?

 Dim tmpPic As StdPicture
    Set tmpPic = HandleToStdPicture(hIcon, vbPicTypeIcon)
    SavePicture tmpPic, [path\filename]

Thanks !

[DigiRev]

Did you change [path/file name] to a path or file name?

ex:

Dim tmpPic As StdPicture
Set tmpPic = HandleToStdPicture(hIcon, vbPicTypeIcon)
SavePicture tmpPic, "C:\test.ico"

[LaVolpe]

hi LaVolpe,
I tried your example with my code but i get an exception invalid property value
What's wrong ?

Ensure hIcon contains an icon handle from your routines. Doesn't hurt to test result:

Dim tmpPic As StdPicture
    Set tmpPic = HandleToStdPicture(hIcon, vbPicTypeIcon)
    If tmpPic Is Nothing Then
         MsgBox "Invalid Image Format or Format Not Supported", vbOkOnly, "Error"
    Else
         SavePicture tmpPic, [path\filename]
    End If

[killer7k]

Did you change [path/file name] to a path or file name?

ex:

Dim tmpPic As StdPicture
Set tmpPic = HandleToStdPicture(hIcon, vbPicTypeIcon)
SavePicture tmpPic, "C:\test.ico"

No i changed to an extention
come on DigiRev !!!!

[killer7k]

Ensure hIcon contains an icon handle from your routines. Doesn't hurt to test result:

Dim tmpPic As StdPicture
    Set tmpPic = HandleToStdPicture(hIcon, vbPicTypeIcon)
    If tmpPic Is Nothing Then
         MsgBox "Invalid Image Format or Format Not Supported", vbOkOnly, "Error"
    Else
         SavePicture tmpPic, [path\filename]
    End If

Hi LaVolpe

Here You my code maybe i am missing something

Private Sub Command1_Click()
CommonDialog1.DialogTitle = "Extract File"
CommonDialog1.Filter = "All supported files|*.exe;*.dll;*.ico,*.bmp|Executables (*.exe)|*.exe|DLL Files (*.dll)|*.dll|Ico Files (*.ico)|*.ico|Bitmap(*.bmp)|*.bmp|All Files (*.*)|*.*"
CommonDialog1.ShowOpen
Dim hIcon As Long
Picture1.AutoRedraw = True
hIcon = ExtractAssociatedIcon(App.hInstance, CommonDialog1.FileName, -1)
Call DrawIconEx(Picture1.hdc, 0, 0, hIcon, 32, 32, 0, 0, 3)

'This work but doesnt produce a True icon
'SavePicture Picture1.Image, "C:\Icon1.ico"

Dim tmpPic As StdPicture
    Set tmpPic = HandleToStdPicture(hIcon, vbPicTypeIcon)
    If tmpPic Is Nothing Then
         MsgBox "Invalid Image Format or Format Not Supported", vbOKOnly, "Error"
    Else
         SavePicture tmpPic, "C:\Iconmania.ico"
    End If

End Sub

Public Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" (ByVal hInst As Long, ByVal lpIconPath As String, lpiIcon As Long) As Long
Public 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

Public Function HandleToStdPicture(ByVal hImage As Long, ByVal imgType As Long) As IPicture

End Function

Thanks m8 !

[LaVolpe]

As I mentioned in #6 above, this may not work with (24 & 32 bit icons) XP-type icons. If you can add the source icon to your form's Icon property, then this should work. But if VB says no, then this won't work either and you will have to create the icon the old fashioned way -- write it yourself.

P.S. I used exactly your code and ran it on about a dozen files; worked every time.

[killer7k]

Hi LaVolpe ,

I Tried 16*16 also doesnt work !

you said I used exactly your code and ran it on about a dozen files; worked every time.

you get worked what ?

Thanks !

[LaVolpe]

For every file I chose, on my C:\ drive, an icon was created as Iconmania.ico in a true ico file format. Which executable(s) do not work for you? Maybe I can replicate the problem. And what exactly is not working?

[killer7k]

Can you put your working code again
i have always the msgbox error
Stange !!

[LaVolpe]

Here is your project along with the function I provided. Add a commondialog, picturebox & command button to your new form & play.

Option Explicit
' declarations
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 Type PictDesc
    Size As Long
    Type As Long
    hHandle As Long
    hPal As Long
End Type
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (lpPictDesc As PictDesc, _
    riid As Any, ByVal fPictureOwnsHandle As Long, iPic As IPicture) As Long

Private Sub Command1_Click()
    CommonDialog1.DialogTitle = "Extract File"
    CommonDialog1.Filter = "All supported files|*.exe;*.dll;*.ico,*.bmp|Executables (*.exe)|*.exe|DLL Files (*.dll)|*.dll|Ico Files (*.ico)|*.ico|Bitmap(*.bmp)|*.bmp|All Files (*.*)|*.*"
    CommonDialog1.ShowOpen
    Dim hIcon As Long
    Picture1.AutoRedraw = True
    Picture1.Cls
    hIcon = ExtractAssociatedIcon(App.hInstance, CommonDialog1.FileName, -1)
    Call DrawIconEx(Picture1.hdc, 0, 0, hIcon, 32, 32, 0, 0, 3)

    Dim tmpPic As StdPicture
    Set tmpPic = HandleToStdPicture(hIcon, vbPicTypeIcon)
    If tmpPic Is Nothing Then
         MsgBox "Invalid Image Format or Format Not Supported", vbOKOnly, "Error"
    Else
         SavePicture tmpPic, "C:\Iconmania.ico"
    End If

End Sub

Private Function HandleToStdPicture(ByVal hImage As Long, ByVal imgType As Long) As IPicture

    ' function creates a stdPicture object from an image handle (bitmap or icon)
    ' pass vbPicTypeBitmap if handle is bitmap or vbPicTypeIcon if it is an icon
    
    Dim lpPictDesc As PictDesc, aGUID(0 To 3) As Long
    With lpPictDesc
        .Size = Len(lpPictDesc)
        .Type = imgType
        .hHandle = hImage
        .hPal = 0
    End With
    ' IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
    aGUID(0) = &H7BF80980
    aGUID(1) = &H101ABF32
    aGUID(2) = &HAA00BB8B
    aGUID(3) = &HAB0C3000
    ' create stdPicture
    Call OleCreatePictureIndirect(lpPictDesc, aGUID(0), True, HandleToStdPicture)
    
End Function

[killer7k]

Yes m8 Working Great Now

Thanks again !

[jmsrickland]

I used the code from post #16. It saved the icon but it came out bad. It had gray areas where it should have white. It shows in the picturebox correctly

[LaVolpe]

I gave you link in your other thread to a more reliable way to save icons by handle. Also in that link, the reason for the poor quality is briefly explained: VB limitation

[jmsrickland]

I think I got here from a link you gave in my other thread

[LaVolpe]

I think I got here from a link you gave in my other thread

Yes, I gave you two links. This one and another one. Both can save icon handles to file, but the solution here is limited though much smaller code needed. The other link requires much more code and is only limited to icons 256x256 and smaller.

Note to self: Update that code to support larger icons. Win10 allows 768x768 icons.

[jmsrickland]

OK, my end is resolved from your other link so I wont worry about this one. Thanks