VB and VBA Users Source Code: Extracting the icon resources from a file or executable
[
Home
|
Contents
|
Search
|
Reply
| Previous | Next ]
VB/VBA Source Code
Extracting the icon resources from a file or executable
By:
Andrew Baker
Email (spam proof):
Email the originator of this post
Date:
Monday, April 09, 2001
Hits:
1886
Category:
Files/Directories/IO
Article:
The following code an demonstration routine, illustrate how to extract icons from files: Option Explicit Private Type tPicBmp Size As Long Type 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 tPicBmp, 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 'Purpose : Extracts an icon from a file 'Inputs : sFileName The file to extract the icon from ' [lIconIndex] The zero based index of the icon to extract (some files can contain more than one icon). ' [bUseLargeIcon] If True extracts a 32x32 icon else extracts 16x16 icon. 'Outputs : Returns the icon as an StdPicture 'Author : Andrew Baker 'Date : 15/01/2001 11:55 'Notes : 'Revisions : 'Assumptions : Public Function IconFromFile(sFileName As String, Optional lIconIndex As Long = 0, Optional bUseLargeIcon As Boolean = False) As StdPicture Dim lhwndLargeIcon As Long, lhwndSmallIcon As Long, lhwndSelected As Long Dim tPic As tPicBmp, IPic As IPicture Dim IID_IDispatch As GUID If ExtractIconEx(sFileName, lIconIndex, lhwndLargeIcon, lhwndSmallIcon, 1) > 0 Then If bUseLargeIcon Then lhwndSelected = lhwndLargeIcon Else lhwndSelected = lhwndSmallIcon End If 'Fill in with IDispatch Interface ID. With IID_IDispatch .Data1 = &H20400 .Data4(0) = &HC0 .Data4(7) = &H46 End With 'Fill tPic with necessary parts. With tPic .Size = Len(tPic) 'Length of structure. .Type = 3 'vbPicTypeIcon, type of Picture (bitmap). .hBmp = lhwndSelected 'Handle to bitmap. End With 'Create Picture object. Call OleCreatePictureIndirect(tPic, IID_IDispatch, 1, IPic) 'Return the new Picture object. Set IconFromFile = IPic DestroyIcon lhwndSmallIcon DestroyIcon lhwndLargeIcon End If End Function 'Extracts an icon from an EXE and saves it to the root in the C: drive Sub Test() Dim Picture1 As StdPicture, lCount As Long, sExcelPath As String 'Extracts icons from Excel.exe sExcelPath = "C:\Program Files\Microsoft Office\Office\excel.exe" Do If Len(Dir$(sExcelPath)) Then 'Specified valid path to excel Exit Do ElseIf Len(sExcelPath) Then 'Path to Excel is incorrect sExcelPath = InputBox("Please enter the path to the file Excel.exe:", , sExcelPath) Else MsgBox "Aborted" End End If Loop Do Set Picture1 = IconFromFile(sExcelPath, lCount, True) 'Save the icon If (Picture1 Is Nothing) = False Then lCount = lCount + 1 On Error Resume Next VBA.Kill "C:\excel" & lCount & ".ico" On Error GoTo 0 SavePicture Picture1, "C:\excel" & lCount & ".ico" Set Picture1 = Nothing Else 'Finished extracting icons Exit Do End If Loop End Sub
Terms and Conditions
Support this site
Download a trial version of the Excel Workbook Rebuilder
