[Amin_Mansouri]

با کد زیر میتونی ایکون های dll , exe رو از فایل استخراج کنید.

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


Declarations

کد:

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

Code

کد:

'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