[RESOLVED] Save Extracted Icon problem

Printable View

Mar 20th, 2008, 04:59 PM
killer7k

[RESOLVED] Save Extracted Icon problem

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

Code:

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 !
Mar 20th, 2008, 05:06 PM
Edgemeal

Re: Save Extracted Icon problem

did you try,
SavePicture Picture1.Image, "C:\Icon1.ico"
Mar 20th, 2008, 05:31 PM
killer7k

Re: Save Extracted Icon problem

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 !
Mar 20th, 2008, 06:03 PM
Siddharth Rout

Re: Save Extracted Icon problem

Does this shelp?

http://www.thescarms.com/vbasic/extracticons.aspx
Mar 20th, 2008, 06:15 PM
killer7k

Re: Save Extracted Icon problem

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 !!!!
Mar 20th, 2008, 07:09 PM
LaVolpe

Re: Save Extracted Icon problem

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.

Code:

' 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:

Code:

' 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).
Mar 20th, 2008, 08:01 PM
killer7k

Re: Save Extracted Icon problem

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

What's wrong ?

Code:

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

Thanks !
Mar 20th, 2008, 08:25 PM
DigiRev

Re: Save Extracted Icon problem
Did you change [path/file name] to a path or file name? :p

ex:
vb Code:
```
Dim tmpPic As StdPicture
Set tmpPic = HandleToStdPicture(hIcon, vbPicTypeIcon)
SavePicture tmpPic, "C:\test.ico"
```
Mar 20th, 2008, 09:05 PM
LaVolpe

Re: Save Extracted Icon problem

Quote:

Originally Posted by killer7k

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:

Code:

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
Mar 21st, 2008, 06:18 AM
killer7k

Re: Save Extracted Icon problem
Quote:
Originally Posted by DigiRev

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

ex:

vb Code:

Dim tmpPic As StdPicture
Set tmpPic = HandleToStdPicture(hIcon, vbPicTypeIcon)
SavePicture tmpPic, "C:\test.ico"
No i changed to an extention :p
come on DigiRev !!!! :(
Mar 21st, 2008, 06:25 AM
killer7k

Re: Save Extracted Icon problem

Quote:

Originally Posted by LaVolpe

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

Code:

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

Code:

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

Code:

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 !
Mar 21st, 2008, 08:04 AM
LaVolpe

Re: Save Extracted Icon problem

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.
Mar 21st, 2008, 09:00 AM
killer7k

Re: Save Extracted Icon problem

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 !
Mar 21st, 2008, 09:19 AM
LaVolpe

Re: Save Extracted Icon problem

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?
Mar 21st, 2008, 09:26 AM
killer7k

Re: Save Extracted Icon problem

Can you put your working code again
i have always the msgbox error
Stange !!
Mar 21st, 2008, 09:33 AM
LaVolpe

Re: Save Extracted Icon problem

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

Code:

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
Mar 21st, 2008, 09:40 AM
killer7k

Re: Save Extracted Icon problem

Yes m8 Working Great Now

Thanks again !
Sep 7th, 2015, 12:57 PM
jmsrickland

Re: [RESOLVED] Save Extracted Icon problem

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
Sep 7th, 2015, 01:06 PM
LaVolpe

Re: [RESOLVED] Save Extracted Icon problem

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
Sep 7th, 2015, 01:27 PM
jmsrickland

Re: [RESOLVED] Save Extracted Icon problem

I think I got here from a link you gave in my other thread
Sep 7th, 2015, 01:36 PM
LaVolpe

Re: [RESOLVED] Save Extracted Icon problem

Quote:

Originally Posted by jmsrickland

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.
Sep 7th, 2015, 02:10 PM
jmsrickland

Re: [RESOLVED] Save Extracted Icon problem

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