Iconextract bug in vb5

[kedaman]

This is the iconextractor sample that i've downloaded, but it crashes when i load more than 5 icons from moricons.dll
Anyone encountered this error? Anyone have any solutions? It seems to work with vb6...

VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3195
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3195
ScaleWidth = 4680
StartUpPosition = 3 'Windows Default
Begin VB.PictureBox Picture1
Height = 855
Left = 600
ScaleHeight = 795
ScaleWidth = 795
TabIndex = 0
Top = 480
Width = 855
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Type PicBmp
Size As Long
tType 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 PicBmp, 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

Public Function GetIconFromFile(FileName As String, IconIndex As Long, UseLargeIcon As Boolean) As Picture 'Parameters:

'FileName - File (EXE or DLL) containing icons
'IconIndex - Index of icon to extract, starting with 0
'UseLargeIcon-True for a large icon, False for a small icon
'Returns: Picture object, containing icon
Dim hlargeicon As Long
Dim hsmallicon As Long
Dim selhandle As Long
'IPicture requires a reference to "Standard OLE Types."
Dim pic As PicBmp
Dim IPic As IPicture
Dim IID_IDispatch As GUID
If ExtractIconEx(FileName, IconIndex, hlargeicon, hsmallicon, 1) > 0 Then
If UseLargeIcon Then
selhandle = hlargeicon
Else
selhandle = hsmallicon
End If
'Fill in with IDispatch Interface ID.
With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With 'Fill Pic with necessary parts.
With pic
.Size = Len(pic) 'Length of structure.
.tType = vbPicTypeIcon 'Type of Picture (bitmap).
.hBmp = selhandle 'Handle to bitmap.
End With 'Create Picture object.
Call OleCreatePictureIndirect(pic, IID_IDispatch, 1, IPic)
'Return the new Picture object.
Set GetIconFromFile = IPic
DestroyIcon hsmallicon
DestroyIcon hlargeicon
End If

End Function


Private Sub Form_Load()

End Sub

Private Sub Picture1_Click()
Static ink As Long
Set Picture1.Picture = GetIconFromFile("c:\windows\moricons.dll", ink, True)
ink = ink + 1
End Sub

[Mc Brain]

I've tried your script in VB% (Entrepise Edition), and had no problem... where's exactly the problem you get?

[kedaman]

Declare Function ExtractIconEx Lib "shell32" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phIconLarge As Long, phIconSmall As Long, ByVal nIcons As Long) As Long

Function GetIconsFromFile(Filename$)
    Dim hIcons()
    ReDim hIcons(ExtractIconEx(Filename, -1, ByVal 0&, ByVal 0&, 0))
    If UBound(hIcons) = 0 Then Exit Function Else ReDim Preserve hIcons(UBound(hIcons) - 1)
    ExtractIconEx Filename, 0, hIcons(0), ByVal 0&, 10 '<-- Crash at this line
    GetIconsFromFile = hIcons
End Function

I'm just passing "C:\windows\moricons.dll" and it will crash vb.