This code allows to extract icons from .dll and .exe files

کد:

Option Explicit



Global lIcon&

Global sSourcePgm$

Global sDestFile$



Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long

Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long

Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long

کد:

'www.parsicoders.com

' Add VScrollBar, Label, Tow CommnandButtons and CommonDialog

'Then Add the Following:

Option Explicit



Private Sub Command1_Click()

  On Error Resume Next

  With CommonDialog1

    .FileName = sDestFile

    .CancelError = True

    .Action = 2

    If Err Then

      Err.Clear

      Exit Sub

    End If

    sDestFile = .FileName

    SavePicture Picture1.Image, sDestFile

  End With

End Sub



Private Sub Command2_Click()

  Dim a%

  

  On Error Resume Next

  With CommonDialog1

    .FileName = sSourcePgm

    .CancelError = True

    .DialogTitle = "Select a DLL or EXE which includes Icons"

    ........ = "Icon Resources (*.ico;*.exe;*.dll)|*.ico;*.exe;*.dll|All files|*.*"

    .Action = 1

    If Err Then

      Err.Clear

      Exit Sub

    End If

    sSourcePgm = .FileName

    DestroyIcon lIcon

    Do

      lIcon = ExtractIcon(App.hInstance, sSourcePgm, a)

      If lIcon = 0 Then Exit Do

      a = a + 1

      DestroyIcon lIcon

    Loop

    If a = 0 Then

      MsgBox "No Icons in this file!"

    End If

    Label1.Caption = a & IIf(a = 1, " Image", " Images")

    VScroll1.Max = IIf(a = 0, 0, a - 1)

    VScroll1.Value = 0

    VScroll1_Change

  End With

End Sub



Private Sub Form_Load()

Command1.Caption = "save"

Command2.Caption = "open"

  Command2_Click

End Sub





Private Sub VScroll1_Change()

  DestroyIcon lIcon

  Picture1.Cls

  lIcon = ExtractIcon(App.hInstance, sSourcePgm, VScroll1.Value)

  Picture1.AutoSize = True

  Picture1.AutoRedraw = True

  DrawIcon Picture1.hdc, 0, 0, lIcon

  Picture1.Refresh

End Sub