Extract Icons from exe applications or dlls -APIs- partII

Published on by Yousfi Benameur

 
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



Extract Icons  from  exe applications or dlls -APIs- partII

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
*****************************



API drawings on a top levl form (showWindox=2)

API drawings on a top levl form (showWindox=2)

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



Extract Icons  from  exe applications or dlls -APIs- partII

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



Extract Icons  from  exe applications or dlls -APIs- partII
 
*Important:*the code above is tested on visual foxpro 9 sp2-under windows 10 pro

To be informed of the latest articles, subscribe:
Comment on this post