如何在image或者是pictrue中显示指定exe文件的图标，或者将exe文件的图标取出存为文件？

Question

如何在image或者是pictrue中显示指定exe文件的图标，或者将exe文件的图标取出存为文件？

Answer 1

你到网上找“轻轻松松抓图标 ”工具软件，他可以将任何形式的图标给取出并可以保存的，如果没有找到，告诉。
关于.exe文件的图标，你可以在各个窗体的icon中添加图标，然后在“工程”菜单里的工程属性里面，选择“生成”按钮，里面可以选择任意窗体的图标。

Answer 2

从文件中提取图标的程序:
http://www.applevb.com/sourcecode/exticon.zip

Answer 3

斑竹编写的一个从可执行文件、DLL文件等中提取图标的程序，可以以树形列表的方式显示文件目录。以ListView的方式显示全部图标，自动保存到目录。包含了斑竹从主要的Windows软件中提取的900多个图标。(这个软件包含了源程序):
http://www.applevb.com/sourcecode/exticontree.zip

Answer 4

把下面这个东西，存储为form1.frm就可以了
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{F9043C88-F6F2-101A-A3C9-08002B2F49FB}#1.2#0"; "COMDLG32.OCX"
Begin VB.Form FrmMain 
   Caption         =   "zyl910的图标提取器"
   ClientHeight    =   3495
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4980
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   ScaleHeight     =   3495
   ScaleWidth      =   4980
   StartUpPosition =   3  '窗口缺省
   Begin MSComctlLib.ImageList ILLVB 
      Left            =   2070
      Top             =   1320
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   32
      ImageHeight     =   32
      MaskColor       =   12632256
      _Version        =   393216
   End
   Begin MSComDlg.CommonDialog CDlgSave 
      Left            =   1080
      Top             =   360
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin MSComDlg.CommonDialog CDlgOpen 
      Left            =   60
      Top             =   360
      _ExtentX        =   847
      _ExtentY        =   847
      _Version        =   393216
   End
   Begin MSComctlLib.ImageList ILLVS 
      Left            =   1650
      Top             =   1410
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
   End
   Begin MSComctlLib.ListView LV1 
      Height          =   1605
      Left            =   300
      TabIndex        =   1
      Top             =   1020
      Width           =   2925
      _ExtentX        =   5159
      _ExtentY        =   2831
      Arrange         =   2
      LabelEdit       =   1
      LabelWrap       =   0   'False
      HideSelection   =   0   'False
      OLEDragMode     =   1
      FullRowSelect   =   -1  'True
      _Version        =   393217
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      Appearance      =   1
      OLEDragMode     =   1
      NumItems        =   0
   End
   Begin MSComctlLib.ImageList ILTB 
      Left            =   2850
      Top             =   150
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   4
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmMain.frx":0000
            Key             =   "Open"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmMain.frx":015C
            Key             =   "Save"
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmMain.frx":02B8
            Key             =   "Big"
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "FrmMain.frx":0414
            Key             =   "Small"
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.Toolbar TB1 
      Align           =   1  'Align Top
      Height          =   360
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   4980
      _ExtentX        =   8784
      _ExtentY        =   635
      ButtonWidth     =   1667
      ButtonHeight    =   582
      AllowCustomize  =   0   'False
      Wrappable       =   0   'False
      Appearance      =   1
      Style           =   1
      TextAlignment   =   1
      ImageList       =   "ILTB"
      _Version        =   393216
      BeginProperty Buttons {66833FE8-8583-11D1-B16A-00C0F0283628} 
         NumButtons      =   5
         BeginProperty Button1 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "打开　"
            Key             =   "Open"
            Object.ToolTipText     =   "打开"
            ImageKey        =   "Open"
         EndProperty
         BeginProperty Button2 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "保存　"
            Key             =   "Save"
            Object.ToolTipText     =   "保存"
            ImageKey        =   "Save"
         EndProperty
         BeginProperty Button3 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Style           =   3
         EndProperty
         BeginProperty Button4 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "大图标"
            Key             =   "BigIco"
            Object.ToolTipText     =   "大图标"
            ImageKey        =   "Big"
            Style           =   2
            Value           =   1
         EndProperty
         BeginProperty Button5 {66833FEA-8583-11D1-B16A-00C0F0283628} 
            Caption         =   "小图标"
            Key             =   "SmallIco"
            Object.ToolTipText     =   "小图标"
            ImageKey        =   "Small"
            Style           =   2
         EndProperty
      EndProperty
      BorderStyle     =   1
   End
End
Attribute VB_Name = "FrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option ExplicitPrivate 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
Private Declare Function GetIconInfo Lib "user32" (ByVal hIcon As Long, piconinfo As ICONINFO) As Long
Private Type ICONINFO
    fIcon As Long
    xHotspot As Long
    yHotspot As Long
    hbmMask As Long
    hbmColor As LongEnd Type
Private Type ICONDIR
    idReserved As Integer
    idType As Integer
    idCount As Integer
    ' idEntries() as ICONDIRENTRY array follows.End Type
Private Type ICONDIRENTRY
    bWidth As Byte
    bHeight As Byte
    bColorCount As Byte
    bReserved As Byte
    wPlanes As Integer
    wBitCount As Integer
    dwBytesInRes As Long
    dwImageOffset As LongEnd Type'bitmapinfoheader icheader;
'rgbquad iccolors[];
'byte icxor[]; '4字节对齐
'byte icand[]; '4字节对齐Private Type BitMapInfoHeader
    biSize As Long
    biWidth As Long
    biHeight As Long
    biPlanes As Integer
    biBitCount As Integer
    biCompression As Long
    biSizeImage As Long
    biXPelsPerMeter As Long
    biYPelsPerMeter As Long
    biClrUsed As Long
    biClrImportant As Long
End Type

Answer 5

Private Type RGBQuad
    rgbBlue As Byte
    rgbGreen As Byte
    rgbRed As Byte
    rgbReserved As Byte
End TypePrivate Declare Function ImageList_ReplaceIcon Lib "comctl32.dll" (ByVal himl As Long, ByVal I As Long, ByVal hIcon As Long) As LongPrivate Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)Private Type BITMAPINFO
    bmiHeader As BitMapInfoHeader
    bmiColors As RGBQuad
End TypePrivate Declare Function CreateDIBSection Lib "gdi32" (ByVal hDC As Long, pBitmapInfo As BITMAPINFO, ByVal un As Long, lplpVoid As Long, ByVal handle As Long, ByVal dw As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As LongPrivate Declare Function SetDIBColorTable Lib "gdi32" (ByVal hDC As Long, ByVal un1 As Long, ByVal un2 As Long, pRGBQuad As RGBQuad) As Long'Private Declare Function GetDIBits Lib "gdi32" (ByVal hDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Private Const DIB_RGB_COLORS = 0
Private Const DIB_PAL_COLORS = 1Private Declare Function DrawState Lib "user32" Alias "DrawStateA" (ByVal hDC As Long, ByVal hBrush As Long, ByVal lpDrawStateProc As Long, ByVal lParam As Long, ByVal wParam As Long, ByVal x As Long, ByVal y As Long, ByVal W As Long, ByVal H As Long, ByVal StateFlags As Long) As Long
Private Const DST_BITMAP As Long = &H4
Private Const DSS_NORMAL As Long = &H0Private Declare Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function DeleteDC Lib "gdi32" (ByVal hDC As Long) As Long
'Private Declare Function GetPixel Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long
'Private Declare Function SetPixelV Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As LongPrivate Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As LongPrivate Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Type BITMAP
    bmType As Long
    bmWidth As Long
    bmHeight As Long
    bmWidthBytes As Long
    bmPlanes As Integer
    bmBitsPixel As Integer
    bmBits As Long
End Type
Private IcoS() As Long
Private IcoB() As Long
Private IcoCount As LongPrivate Sub LoadIco()
    Dim rc As Long
    Dim I As Long
    
    rc = ExtractIconEx(CDlgOpen.FileName, 0, ByVal 0, ByVal 0&, -1)
    
    If rc <= 0 Then
        MsgBox "没有发现图标！", vbCritical, "错误"
        Exit Sub
    End If
    
    FreeIco
    LV1.ListItems.Clear
    IcoCount = ILLVB.ListImages.Count
    For I = IcoCount + 1 To rc
        ILLVB.ListImages.Add , , Me.Icon
        ILLVS.ListImages.Add , , Me.Icon
    Next I
    
    IcoCount = rc
    ReDim IcoS(0 To IcoCount - 1)
    ReDim IcoB(0 To IcoCount - 1)
    
    If IcoCount > 10 Then Me.MousePointer = vbHourglass
    
    rc = ExtractIconEx(CDlgOpen.FileName, 0, IcoB(0), IcoS(0), IcoCount)
    
    Dim hILLVB As Long, hILLVS As Long
    
    
    hILLVB = ILLVB.hImageList
    hILLVS = ILLVS.hImageList
    
    For I = 0 To IcoCount - 1
        ImageList_ReplaceIcon hILLVB, I, IcoB(I)
        ImageList_ReplaceIcon hILLVS, I, IcoS(I)
        LV1.ListItems.Add , , I, I + 1, I + 1
    Next I
    
    If IcoCount > 10 Then Me.MousePointer = vbDefault
    
End SubPrivate Sub FreeIco()
    Dim I As Long
    
    For I = 0 To IcoCount - 1
        DestroyIcon IcoS(I)
        DestroyIcon IcoB(I)
    Next I
    IcoCount = 0
    
End SubPublic Function ReWrite(FileName As String) As Boolean
    Dim hFile As Long
    
    hFile = FreeFile
    On Error Resume Next
    Open FileName For Output As #hFile
    If Err.Number Then Exit Function
    On Error GoTo 0
    Close hFile
    
    ReWrite = True
    
End FunctionPublic Function SaveIco(ByVal hIcon As Long, FileName As String) As Boolean
    Dim hFile As Long
    
    If ReWrite(FileName) = False Then Exit Function
    
    hFile = FreeFile
    On Error Resume Next
    Open FileName For Binary As #hFile
    If Err.Number Then Exit Function
    On Error GoTo 0
    
    Dim II As ICONINFO
    Dim BM As BITMAP
    Dim ID As ICONDIR
    Dim IDE As ICONDIRENTRY
    Dim BMIH As BitMapInfoHeader
    Dim BMI As BITMAPINFO
    Dim LineWidth As Long
    Dim MapBit() As Byte
    Dim TCB(0 To 1) As RGBQuad
    
    Call GetIconInfo(hIcon, II)
    Call GetObject(II.hbmColor, Len(BM), BM)
    'MsgBox BM.bmWidth & " * " & BM.bmHeight & " * " & BM.bmBitsPixel & "位色"
    
    ID.idReserved = 0
    ID.idType = 1
    ID.idCount = 1
    Put hFile, , ID
    
    With IDE
        .bWidth = BM.bmWidth
        .bHeight = BM.bmHeight
        .bColorCount = &HFF
        .wBitCount = 24
        .wPlanes = 1
        .dwBytesInRes = Len(BMIH)
        .dwBytesInRes = .dwBytesInRes + ((BM.bmWidth * 3 + 3) And &H7FFFFFFC) * BM.bmHeight
        .dwBytesInRes = .dwBytesInRes + (((BM.bmWidth + 7) \ 8 + 3) And &H7FFFFFFC) * BM.bmHeight
        .dwImageOffset = Len(ID) + Len(IDE)
    End With
    Put hFile, , IDE
    
    
    Dim TemphDC As Long
    Dim hDIB As Long
    Dim MapPtr As Long
    Dim OldMap As Long
    Dim TempLng As Long
    Dim I As Long
    
    BMI.bmiHeader.biSize = Len(BMI.bmiHeader)
    BMI.bmiHeader.biWidth = BM.bmWidth
    BMI.bmiHeader.biHeight = BM.bmHeight
    BMI.bmiHeader.biBitCount = 24
    BMI.bmiHeader.biPlanes = 1
    LineWidth = (BM.bmWidth * 3 + 3) And &H7FFFFFFC
    BMI.bmiHeader.biSizeImage = LineWidth * BM.bmHeight
    
    BMIH = BMI.bmiHeader
    BMIH.biHeight = BMIH.biHeight * 2
    Put hFile, , BMIH
    
    TemphDC = CreateCompatibleDC(0)
    hDIB = CreateDIBSection(TemphDC, BMI, DIB_RGB_COLORS, MapPtr, 0, 0)
    'Debug.Print hDIB
    OldMap = SelectObject(TemphDC, hDIB)
    
    DrawState TemphDC, 0, 0, II.hbmColor, 0, 0, 0, 0, 0, DST_BITMAP Or DSS_NORMAL
    'BitBlt Me.hDC, 0, 0, BM.bmWidth, BM.bmHeight, TemphDC, 0, 0, vbSrcCopy
    
    ReDim MapBit(1 To BMI.bmiHeader.biSizeImage)
    CopyMemory MapBit(1), ByVal MapPtr, BMI.bmiHeader.biSizeImage
    'Debug.Print GetDIBits(TemphDC, II.hbmColor, 0, BM.bmHeight, MapBit(1), BMI, DIB_RGB_COLORS)
    Put hFile, , MapBit
    
    
    'Call SelectObject(TemphDC, II.hbmMask)
    BMI.bmiHeader.biBitCount = 1
    LineWidth = ((BM.bmWidth + 31) \ 8) And &H7FFFFFFC
    BMI.bmiHeader.biSizeImage = LineWidth * BM.bmHeight
    Call SelectObject(TemphDC, OldMap)
    hDIB = CreateDIBSection(TemphDC, BMI, DIB_PAL_COLORS, MapPtr, 0, 0)
    OldMap = SelectObject(TemphDC, hDIB)
    TCB(1).rgbRed = &HFF
    TCB(1).rgbGreen = &HFF
    TCB(1).rgbBlue = &HFF
    SetDIBColorTable TemphDC, 0, 2, TCB(0)
    DrawState TemphDC, 0, 0, II.hbmMask, 0, 0, 0, 0, 0, DST_BITMAP Or DSS_NORMAL
    ReDim MapBit(1 To BMI.bmiHeader.biSizeImage)
    CopyMemory MapBit(1), ByVal MapPtr, BMI.bmiHeader.biSizeImage
    'Call GetDIBits(TemphDC, II.hbmMask, 0, BM.bmHeight, MapBit(1), BMI, DIB_RGB_COLORS)
    Put hFile, , MapBit
    
    
    Call SelectObject(TemphDC, OldMap)
    DeleteObject hDIB
    Call DeleteDC(TemphDC)
    
    '由ICONINFO结构载入的位图必须由应用程序删去
    DeleteObject II.hbmMask
    DeleteObject II.hbmColor
    
    Close hFile
    
    SaveIco = True
    
End Function

Answer 6

Private Sub Form_Load()
    CDlgOpen.CancelError = True
    CDlgOpen.Filter = "所有支持的文件(*.exe;*.dll;*.ocx)|*.exe;*.dll;*.ocx|可执行文件(*.exe)|*.exe|动态连接库(*.dll)|*.dll|控件(*.ocx)|*.ocx|所有文件(*.*)|*.*"
    CDlgOpen.FilterIndex = 1
    CDlgOpen.Flags = cdlOFNFileMustExist Or cdlOFNHideReadOnly
    
    CDlgSave.CancelError = True
    CDlgSave.Filter = "图标文件(*.ico)|*.ico"
    CDlgSave.FilterIndex = 1
    CDlgSave.Flags = cdlOFNHideReadOnly
    
    ILLVB.ImageWidth = 32
    ILLVB.ImageHeight = 32
    ILLVS.ImageWidth = 16
    ILLVS.ImageHeight = 16
    ILLVB.ListImages.Add , , Me.Icon
    ILLVS.ListImages.Add , , Me.Icon
    Set LV1.Icons = ILLVB
    Set LV1.SmallIcons = ILLVS
    
End SubPrivate Sub Form_Resize()
    LV1.Move 0, TB1.Height, Me.ScaleWidth, Me.ScaleHeight - TB1.Height
    
End SubPrivate Sub Form_Unload(Cancel As Integer)
    FreeIco
    
End SubPrivate Sub TB1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
    Case "Open"
        On Error Resume Next
        CDlgOpen.ShowOpen
        If Err.Number Then Exit Sub
        On Error GoTo 0
        LoadIco
        
    Case "Save"
        If LV1.ListItems.Count = 0 Then Exit Sub
        
        On Error Resume Next
        CDlgSave.ShowSave
        If Err.Number Then Exit Sub
        On Error GoTo 0
        If SaveIco(IIf(LV1.View = lvwIcon, IcoB(LV1.SelectedItem.Text), IcoS(LV1.SelectedItem.Text)), CDlgSave.FileName) Then
        Else
        End If
        
    Case "BigIco"
        LV1.View = lvwIcon
    Case "SmallIco"
        LV1.View = lvwList
    End Select
    
End Sub