Ce code extrait et affiche une icône d'un fichier exe (mais fonctionne aussi pour les dll) en fonction de la taille demandée. Le code teste que l'icône est de forme carré mais ne tient pas compte de la profondeur des couleurs. C'est possible de modifier le code pour prendre en compte cette profondeur. Non testé sur icône vista sous Vista mais ça doit marcher.
Code : Tout sélectionner
EnableExplicit
#Return_Error = 0
; Utilisé pour charger une Dll, ICL, EXE en datafile (non executable)
#LOAD_LIBRARY_AS_DATAFILE = 2
Structure IconFind
Size.l
hIcon.i
EndStructure
Macro HIWORD(Value)
(Value>>16)
EndMacro
Macro LOWORD(Value)
Value & $FFFF
EndMacro
Macro MAKEINTRESOURCE(INT)
LOWORD(INT)
EndMacro
Macro IS_INTRESOURCE(Val)
HIWORD(Val)
EndMacro
; ici commence la callback utilisé pour compter les icônes des DLL/EXE 32 bits
; here start callback used to count up DLL/EXE 32 bits icons
Procedure.l Enumerate_Icon(hModule, lpszType, lpszName, *Icon.IconFind)
; la fonction énumère les identifiants des d'icônes et pas des groupes d'icônes
; mémorise le handle du bloc d'information de la ressource recherchée
Protected Find_Resource = 0
; mémorise le handle du bloc d'information des données de la ressource chargée
Protected LoadResource = 0
; mémorise le pointeur sur le premier octet de la ressource retournée par LockResource_()
Protected *lpIconesource.BITMAPINFOHEADER = 0
If IS_INTRESOURCE(lpszName)
; c'est un pointeur sur une chaîne
Find_Resource = FindResource_(hModule, PeekS(lpszName), #RT_ICON)
Else
; c'est une valeur non un pointeur
Find_Resource = FindResource_(hModule, MAKEINTRESOURCE(lpszName), #RT_ICON)
EndIf
; l'API a échouée ? si oui on quitte, on passe au suivant
If Find_Resource = #Null
ProcedureReturn #True ; #True pour continuer l'opération
EndIf
; on charge la ressource en mémoire, l'opération a réussie ?
LoadResource = LoadResource_(hModule, Find_Resource)
If LoadResource = #Null
ProcedureReturn #True ; #True pour continuer l'opération
EndIf
; *lpIconesource est un pointeur sur le premier octet de la ressource
; si *lpIconesource vaut 0, l'opération a échouée
*lpIconesource = LockResource_(LoadResource)
If *lpIconesource = #Null
ProcedureReturn #True ; #True pour continuer l'opération
EndIf
; retrouve la taille de l'icône
If (*lpIconesource\biWidth = *Icon\size) And (*lpIconesource\biheight/2) = *Icon\size
; icone trouvé, on extrait
; ; Let the OS make us an icon
*Icon\hIcon = CreateIconFromResourceEx_(*lpIconesource, SizeofResource_(hModule, Find_Resource), #True, $00030000, *Icon\size, *Icon\size, 0)
ProcedureReturn #False ; on stoppe l'énumération
EndIf
ProcedureReturn #True ; #true pour continuer l'opération
EndProcedure
Procedure.l Create_Icon_From_EXEFile(szFileName$, Size)
; mémorise le handle de l'exe ou dll ouvert
Protected hLibrary = 0
; mémorise les données propres à l'icone
Protected IconData.IconFind
; Load the DLL/EXE-NOTE : must be a 32bit EXE/DLL For this To work
; Charge Le fichier DLL/EXE, doit être au format PE (32 bits) pour fonctionner
hLibrary = LoadLibraryEx_(szFileName$, #Null, #LOAD_LIBRARY_AS_DATAFILE)
If hLibrary = #Null
; //Failed To load-abort
; Impossible de charger le module, on quitte
Debug "Unable to load exe file/Impossible de charger le fichier exe"
ProcedureReturn #Return_Error
EndIf
IconData\Size = Size
; enumerate icons in ressource
EnumResourceNames_(hLibrary, #RT_ICON, @Enumerate_Icon(), @IconData)
; libère les ressources
FreeLibrary_(hLibrary)
ProcedureReturn IconData\hIcon
EndProcedureCode : Tout sélectionner
; init
Global icone = 0
; Change here the size you want to get
Global size = 32
; Change here the file name
Global File$ = "K:\PureBasic\Projets\Editeur d icones\Version 4\Essai_Icon.exe"
Global File$ = "C:\Program Files\adslTV\Uninstal.exe"
If OpenWindow(0, 0, 0, 300, 300, "Extraction icone", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
icone = Create_Icon_From_EXEFile(File$, size)
If icone = 0
MessageRequester("Erreur","Aucune icone au format demandé", 16)
End
EndIf
ImageGadget(0, (WindowWidth(0)-size)/2, (WindowHeight(0)-size)/2, 0, 0, icone, #PB_Image_Border)
Repeat
Until WaitWindowEvent() = #PB_Event_CloseWindow
; don't forget to destroy icon
If icone
DestroyIcon_(icone)
EndIf
EndIf
