Extract Icons from exe applications or dlls -APIs- partII
We now studay icons exclusively with APIs.These APIs of course desserve the gdiplus and gdiplusX builts.
below 4 codes
1-extract icon given by an index in an exe or dll (icon is a valid one with a color depth=32)
2-Extract all icons 32x32 present in an exe or dll and save as ico in a given folder.
3.Extract with IconextractEx API the small or large icon from an icon
4-draw the windows standrad system icons on a form (showWindow=0,1,2).the drawing on a top level form having a particular hwn to accept drawings.
5-show explorer properties dialog box for any file (fired with the explorer rightclick on any file) with shell application method.
Notes:
-ExtractIconEx was not used in gdiplusX
-Can use same methods in previous post to view the icons on a form surface or IE browser application.can use also a listview control as pointed in Atoutfox link.
-below 5 codes around this chapter.
Click on code to select [then copy] -click outside to deselect
*1*
*extract 1 icon given by its index in exe ,dll....as ico
*example: IconExtract(HOME(1) + 'vfp9.exe', m.yrep+'11.ico', 10)
Clea All
Do yDeclare
Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Local m.lcdest,lnIndex,lcfile
m.lcfile="c:\windows\system32\shell32.dll"
m.lnIndex=325 &&lasr icon of shell32.dll here
m.lcdest=m.yrep+Juststem(m.lcfile)+"_"+Trans(m.lnIndex)+'.ico'
Messagebox("extract Icon as ico from :"+m.lcdest,0+32+4096,'',1500)
=IconExtract(m.lcfile, m.lcdest, m.lnIndex)
Set Defa To (yrep)
If File(m.lcdest)
Run/N explorer /Select, &lcdest
Else
Messagebox("error!")
Endi
Retu
Procedure IconExtract
Lparameters tcSourceFile As String, tcTargetFile As String, tnIconIndex As Integer
Local lnIconHandle As Integer, loIconReference As Object
tnIconIndex = Iif(Vartype(tnIconIndex) = 'N', tnIconIndex, 0)
lnIconHandle = ExtractIcon(0, tcSourceFile, tnIconIndex)
If lnIconHandle # 0
tcStructure = Long2String(16) + Long2String(3) + Long2String(lnIconHandle) + Long2String(0)
tcIdentifier = Replicate(Chr(0), 8) + Chr(0xC0)+ Replicate(Chr(0), 6) + Chr(0x46)
loIconReference = 0
OleCreatePictureIndirect(@tcStructure, @tcIdentifier, 1, @loIconReference)
If Vartype(loIconReference) = 'O'
If SavePicture(loIconReference, tcTargetFile) =.T.
*icon successfule created
Endif
Else
Messagebox('OleCreatePictureIndirect() error')
Endif
DestroyIcon(lnIconHandle)
Else
Messagebox('ExtractIcon() error')
Endif
Clear Dlls 'ExtractIcon', 'OleCreatePictureIndirect', 'DestroyIcon'
Return
Endproc
*
Function Long2String
Lparameters tnLong
tnLong = Int(tnLong)
Return Chr(Bitand(tnLong, 255)) + ;
CHR(Bitand(Bitrshift(tnLong, 8), 255)) + ;
CHR(Bitand(Bitrshift(tnLong, 16), 255)) + ;
CHR(Bitand(Bitrshift(tnLong, 24), 255))
Endfunc
Procedure yDeclare
Declare Integer ExtractIcon In shell32 Integer, String, Integer
Declare Long OleCreatePictureIndirect In oleaut32 String @, String @, Long, Object @
Declare SHORT DestroyIcon In user32 Integer
Endproc
Click on code to select [then copy] -click outside to deselect
*2*
*extract all icon given by index in an exe ,dll....(if exists).
*method uses APIs exclusively.
*Note: extractIcon API extracts only 32x32 format icons (color depth=32)
*this solves the pb of gdiplusX FUNCTION ExtractAssociatedIcon (for the icon representation) and got the valid icon format(can be embed in an image control and loaded with loadpicture() function).
Do yDeclare
Set Safe Off
Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Try
If ! Directory(m.yrep+"yicons")
Md (m.yrep+"yicons")
Else
Wait Window "cleaning folder icons...." Nowait
Dele File (m.yrep+"yicons\*.*") &&recycle
Wait Clea
Endi
Catch
Messagebox("An error was occured when deleting images in "+m.yrep+"yicons\...do this operation manually!",16+4096,"error",2000)
Endtry
Local lcfile,i,x,lcfile
m.lcfile=Getfile("exe|dll")
If Empty(m.lcfile)
Return .F.
Endi
i=0
m.x=.T.
Local m.lcdest,m.oo
m.oo=m.yrep+"yicons"
Do While m.x=.T.
m.lcdest= m.yrep+"yicons\"+Juststem(m.lcfile)+"_"+Trans(i)+'.ico'
m.x=IconExtract(m.lcfile,m.lcdest,i)
Wait Window (Justfname(m.lcdest)) At Srows()/2,Scols()/2-20 Nowait
If !File(m.lcdest)
Exit
Else
i=i+1
Endi
Enddo
Clear Dlls 'ExtractIcon', 'OleCreatePictureIndirect', 'DestroyIcon'
Run/N explorer &oo
Retu
Procedure IconExtract
Lparameters tcSourceFile As String, tcTargetFile As String, tnIconIndex As Integer
Assert File(tcSourceFile)
Local lnIconHandle As Integer, loIconReference As Object
tnIconIndex = Iif(Vartype(tnIconIndex) = 'N', tnIconIndex, 0)
lnIconHandle = ExtractIcon(0, tcSourceFile, tnIconIndex)
If lnIconHandle # 0
tcStructure = Long2String(16) + Long2String(3) + Long2String(lnIconHandle) + Long2String(0)
tcIdentifier = Replicate(Chr(0), 8) + Chr(0xC0)+ Replicate(Chr(0), 6) + Chr(0x46)
loIconReference = 0
OleCreatePictureIndirect(@tcStructure, @tcIdentifier, 1, @loIconReference)
If Vartype(loIconReference) = 'O'
If SavePicture(loIconReference, tcTargetFile)
*icon successful extracted
Endif
Else
Messagebox('OleCreatePictureIndirect() error')
Endif
DestroyIcon(lnIconHandle)
Else
* Messagebox('ExtractIcon() error')
Endif
Return
Function Long2String
Lparameters tnLong
tnLong = Int(tnLong)
Return Chr(Bitand(tnLong, 255)) + ;
CHR(Bitand(Bitrshift(tnLong, 8), 255)) + ;
CHR(Bitand(Bitrshift(tnLong, 16), 255)) + ;
CHR(Bitand(Bitrshift(tnLong, 24), 255))
Endfunc
Procedure yDeclare
Declare Integer ExtractIcon In shell32 Integer, String, Integer
Declare Long OleCreatePictureIndirect In oleaut32 String @, String @, Long, Object @
Declare SHORT DestroyIcon In user32 Integer
Endproc
Click on code to select [then copy] -click outside to deselect
*3*
*extract smallIcon or LargeIcon from an icon
*msdn extractIconEx is documented in :
*https://msdn.microsoft.com/en-us/library/windows/desktop/ms648069%28v=vs.85%29.aspx
*here the 16x16 icon extracted have a color depth=32 (instead 8 in gdiplusX)
Do ydeclare
Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
Set Defa To (yrep)
=IconExtractEx(Getfile('ico'), 'target.ico', 0, .T.)
*
Procedure IconExtractEx
Lparameters tcSourceFile As String, tcTargetFile As String,;
tnIconIndex As Integer, tlIconSmall As Logical
Assert File(tcSourceFile)
Local lnIconLarge As Integer, lnIconSmall As Integer,;
lnIconHandle As Integer, loIconReference As Object
tnIconIndex = Iif(Vartype(tnIconIndex) = 'N', tnIconIndex, 0)
Store 0 To lnIconLarge, lnIconSmall
ExtractIconEx(tcSourceFile, tnIconIndex, @lnIconLarge, @lnIconSmall, 1)
lnIconHandle = Iif(tlIconSmall, lnIconSmall, lnIconLarge) &&small icon or large icon
lnType=Iif(tlIconSmall, "Small Icon ", "Large Icon ")
If lnIconHandle # 0
tcStructure = Long2String(16) + Long2String(3) + Long2String(lnIconHandle) + Long2String(0)
tcIdentifier = Replicate(Chr(0), 8) + Chr(0xC0)+ Replicate(Chr(0), 6) + Chr(0x46)
loIconReference = 0
OleCreatePictureIndirect(@tcStructure, @tcIdentifier, 1, @loIconReference)
If Vartype(loIconReference) = 'O'
If SavePicture(loIconReference, tcTargetFile)=.T.
Local m.oo
m.oo=LoadPicture(tcTargetFile) &&my old method to get width+height from loadpicture() function
w=Int(m.oo.Width/26.4375)
h=Int(m.oo.Height/26.4375)
Messagebox(lnType+ ' extracted to '+m.yrep+"target.ico : width="+Trans(m.w)+" height="+Trans(h))
Endif
Else
Messagebox('OleCreatePictureIndirect() Error')
Endif
DestroyIcon(lnIconHandle) &&mandatory
Else
Messagebox('ExtractIconEx() Error')
Endif
Clear Dlls 'ExtractIconEx', 'OleCreatePictureIndirect', 'DestroyIcon' &&clean dlls loaded
Set Defa To (yrep)
Getfile('ico')
Return
Function Long2String
Lparameters tnLong
tnLong = Int(tnLong)
Return Chr(Bitand(tnLong, 255)) + ;
CHR(Bitand(Bitrshift(tnLong, 8), 255)) + ;
CHR(Bitand(Bitrshift(tnLong, 16), 255)) + ;
CHR(Bitand(Bitrshift(tnLong, 24), 255))
Endfunc
Procedure ydeclare
Declare Long ExtractIconEx In shell32 String @, Long, Long @, Long @, Long
Declare Long OleCreatePictureIndirect In oleaut32 String @, String @, Long, Object @
Declare SHORT DestroyIcon In user32 Integer
Endproc
Click on code to select [then copy] -click outside to deselect
*4*
*draw system standard icons on form even on top level form
*(form.showWindow=0,1,2)
clea all
Publi oform
oform=Newobject("asup")
oform.Show
Read Events
*
Define Class asup As Form
Height = 77
Width = 510
ShowWindow = 2
AutoCenter = .T.
Caption = "System icons drawn on Form & Working with showWindow=0,1,2"
MaxButton = .F.
MinButton = .F.
Borderstyle=2
BackColor = Rgb(0,0,0)
realhwnd = 0
Name = "Form1"
Procedure ydrawicons
#Define IDI_APPLICATION 32512
#Define IDI_ASTERISK 32516
#Define IDI_ERROR 32513
#Define IDI_EXCLAMATION 32515
#Define IDI_HAND IDI_ERROR
#Define IDI_INFORMATION IDI_ASTERISK
#Define IDI_QUESTION 32514
#Define IDI_WARNING IDI_EXCLAMATION
#Define IDI_WINLOGO 32517
#Define IDI_SHIELD 32518
Local hWindow, hdc, hicon,x,Y
m.x=10
m.y=10
For I=1 To 10
hWindow = This.realhwnd
hdc = GetDC(hWindow)
Do Case
Case I=1
m.lhIcon = LoadIcon(0, IDI_APPLICATION)
Case I=2
m.lhIcon = LoadIcon(0, IDI_ASTERISK )
Case I=3
m.lhIcon = LoadIcon(0, IDI_ERROR)
Case I=4
m.lhIcon = LoadIcon(0, IDI_EXCLAMATION)
Case I=5
m.lhIcon = LoadIcon(0, IDI_QUESTION)
Case I=6
m.lhIcon = LoadIcon(0,IDI_WINLOGO)
Case I=7
m.lhIcon = LoadIcon(0,IDI_WARNING)
Case I=8
m.lhIcon = LoadIcon(0, IDI_HAND)
Case I=9
m.lhIcon = LoadIcon(0, IDI_INFORMATION)
Case I=10
m.lhIcon = LoadIcon(0, IDI_SHIELD)
Endcase
If m.lhIcon <> 0
= DrawIcon(hdc, m.x,m.y, m.lhIcon )
Endif
= ReleaseDC(hWindow, hdc)
m.x=m.x+50
Endfor
Endproc
Procedure Move
Lparameters nLeft, nTop, nWidth, nHeight
Thisform.ydrawicons
Endproc
Procedure Paint
Thisform.ydrawicons
Endproc
Procedure Resize
Thisform.ydrawicons
Endproc
Procedure Load
Declare Integer LoadIcon In user32;
INTEGER hInstance, Integer lpIconName
Declare SHORT DrawIcon In user32;
INTEGER hDC, Integer X, Integer Y, Integer hIcon
Declare Integer ReleaseDC In user32;
INTEGER hWindow, Integer hdc
Declare Integer GetDC In user32 Integer hWindow
Endproc
Procedure Init
With Thisform
.realhwnd= Iif(.ShowWindow = 2, Sys(2327, Sys(2325, Sys(2326, .HWnd))), .HWnd)
*this is very important for drawing on top level forms or on desktop
*the hwnd delivring hdc is singularly diffrent wit forms showWindow=0,1
*the devlopment of gdiplus,gdiplusX was restricted to forms showWindow=0,1 only, never to showWindow=2
.Resize
Endwith
Endproc
Procedure destroy
clea events
endproc
Enddefine
*
*-- EndDefine: asup
*****************************
Click on code to select [then copy] -click outside to deselect
*5*
&&show the file dialog box (idem windows explorer right click)+all verbs
**display the Properties dialog box for any file
*this is a file shell application scripting....can be done with shellexecuteEX API
Local m.lcfile
m.lcfile=Getfile("ico|*.*") &&"c:\windows\explorer.exe"
If Empty(m.lcfile)
Return
Endi
Local oShell32, oFolder, oFolderItem, oFolderItemVerbs, oFolderItemVerb
* Creating a shell application object
oShell32 = Createobject("Shell.Application")
oFolder = oShell32.NameSpace(Justpath(m.lcfile) )
*Checking Folder object validation
If Vartype(oFolder)="O"
*Retrieve the FolderItem object
oFolderItem = oFolder.ParseName(Justfname(m.lcfile))
*Validation...
If Vartype(oFolderItem)="O"
* invoking the context menu properties of the file
oFolderItemVerbs = oFolderItem.Verbs
*--- Looping the collection of oFolderItemVerbs
Messagebox( "Explorer rightclick contains :"+Trans(oFolderItemVerbs.Count )+" items",0+32+4096,'',1500)
For Each oFolderItemVerb In oFolderItemVerbs
Wait Window ("item: "+oFolderItemVerb.Name) Timeout 0.2
If oFolderItemVerb.Name="P&ropriétés" &&warning :localized (here french)
oFolderItem.InvokeVerb("Properties")
Endi
Next
*--- Cleaning objects
oFolderItemVerb = Null
oFolderItemVerbs = Null
Endi
oFolderItem = Null
Endi
*--- Cleaning objects
oFolder = Null
oShell32 = Null
Click on code to select [then copy] -click outside to deselect
*6* created on tuesday 09 of january 2018
*Extract all vfp9.exe icons in a folder named "images" from start folder.
*11 extracted icons are 32x32.
Clea Resources
Clea All
*Do yDeclare
Set Safe Off
Publi m.yrep
m.yrep=Addbs(Justpath(Sys(16,1)))
If Directory(m.yrep+"images")
Try
Dele File *.*
Catch
Endtry
Else
Md (m.yrep+"images")
Endi
Local m.lcdest,lnIndex,lcfile
m.lcfile=Home(1) + 'vfp9.exe'
For i=1 To 20
m.lnIndex=i-1 &&lasr icon of shell32.dll here
m.lcdest=m.yrep+"images\"+Juststem(m.lcfile)+"_"+Trans(m.lnIndex)+'.ico'
Wait Window m.lcdest Nowait
Try
=IconExtract(m.lcfile, m.lcdest, m.lnIndex)
Catch
Exit
Endtry
Endfor
Local m.oo
m.oo=m.yrep+"images"
Run/N explorer &oo
Clea Dlls
m.yrep=Null
Release m.yrep
Retu
Procedure IconExtract
Lparameters tcSourceFile As String, tcTargetFile As String, tnIconIndex As Integer
*must declare APIs each time mandatory because clered at end procedure to avoid pbs
Do ydeclare
Local lnIconHandle As Integer, loIconReference As Object
tnIconIndex = Iif(Vartype(tnIconIndex) = 'N', tnIconIndex, 0)
lnIconHandle = ExtractIcon(0, tcSourceFile, tnIconIndex)
If lnIconHandle # 0
tcStructure = Long2String(16) + Long2String(3) + Long2String(lnIconHandle) + Long2String(0)
tcIdentifier = Replicate(Chr(0), 8) + Chr(0xC0)+ Replicate(Chr(0), 6) + Chr(0x46)
loIconReference = 0
OleCreatePictureIndirect(@tcStructure, @tcIdentifier, 1, @loIconReference)
If Vartype(loIconReference) = 'O'
If SavePicture(loIconReference, tcTargetFile) =.T.
*icon successfule created
Endif
Else
Wait Window 'OleCreatePictureIndirect() error' Nowait
Endif
DestroyIcon(lnIconHandle)
Else
Wait Window 'ExtractIcon() error' Nowait
Endif
Wait Clea
Clear Dlls 'ExtractIcon', 'OleCreatePictureIndirect', 'DestroyIcon'
Return
Endproc
*
Procedure ydeclare
Declare Integer ExtractIcon In shell32 Integer, String, Integer
Declare Long OleCreatePictureIndirect In oleaut32 String @, String @, Long, Object @
Declare SHORT DestroyIcon In user32 Integer
Endproc
Function Long2String
Lparameters tnLong
tnLong = Int(tnLong)
Return Chr(Bitand(tnLong, 255)) + ;
CHR(Bitand(Bitrshift(tnLong, 8), 255)) + ;
CHR(Bitand(Bitrshift(tnLong, 16), 255)) + ;
CHR(Bitand(Bitrshift(tnLong, 24), 255))
Endfunc
/image%2F1435407%2F20150930%2Fob_f55441_demo1.jpg)
Icons extract from exe applications or dlls - partI - Visual Foxpro codes
In this first part we studay only the gdiplus class Solution from xfcIcon class.in the second part we studay that with APIS exclusively. Exe and dlls can encapsulate many resources as icon ...
http://yousfi.over-blog.com/2015/09/icons-extract-from-exe-applications-or-dlls-parti.html
*Important:*the code above is tested on visual foxpro 9 sp2-under windows 10 pro