.NET Easy Icons extractor. - Printable Version

Code

Imports System.Runtime.InteropServices



Public Class Natives

    'Credits: ibennz, msdn

    'Version: 1.0.0.0



    <DllImport("kernel32.dll", CharSet:=CharSet.Unicode)>

    Private Shared Function FindResource(hModule As IntPtr, lpName As IntPtr, lpType As IntPtr) As IntPtr

    End Function

    <DllImport("kernel32.dll", CharSet:=CharSet.Unicode)>

    Private Shared Function FindResource(hModule As IntPtr, lpName As String, lpType As IntPtr) As IntPtr

    End Function



    <DllImport("kernel32.dll", CharSet:=CharSet.Unicode)>

    Private Shared Function LockResource(hResData As IntPtr) As IntPtr

    End Function

    <DllImport("kernel32.dll")>

    Private Shared Function LoadLibraryEx(lpFileName As String, hReservedNull As IntPtr, dwFlags As LoadLibraryFlags) As IntPtr

    End Function

    <System.Flags()>

    Enum LoadLibraryFlags As UInteger

      DONT_RESOLVE_DLL_REFERENCES = &H1

      LOAD_IGNORE_CODE_AUTHZ_LEVEL = &H10

      LOAD_LIBRARY_AS_DATAFILE = &H2

      LOAD_LIBRARY_AS_DATAFILE_EXCLUSIVE = &H40

      LOAD_LIBRARY_AS_IMAGE_RESOURCE = &H20

      LOAD_WITH_ALTERED_SEARCH_PATH = &H8

    End Enum



    <DllImport("kernel32.dll", CharSet:=CharSet.Unicode)>

    Private Shared Function SizeofResource(ByVal hModule As IntPtr, ByVal hResInfo As IntPtr) As Integer

    End Function



    <DllImport("kernel32", CharSet:=CharSet.Unicode)>

    Private Shared Function LoadResource(ByVal hModule As IntPtr, ByVal hResInfo As IntPtr) As IntPtr

    End Function



    <DllImport("kernel32.dll", CharSet:=CharSet.Unicode)> _

    Private Shared Function EnumResourceNames(ByVal hModule As IntPtr, ByVal dwID As Integer, ByVal lpEnumFunc As EnumResNameProcDelegate, ByVal lParam As IntPtr) As Boolean

    End Function

    Private Delegate Function EnumResNameProcDelegate(ByVal hModule As IntPtr, ByVal lpszType As IntPtr, ByVal lpszName As IntPtr, ByVal lParam As IntPtr) As Boolean

    Public Enum ResourceType

      CURSOR = 1

      BITMAP = 2

      ICON = 3

      MENU = 4

      DIALOG = 5

      [STRING] = 6

      FONTDIR = 7

      FONT = 8

      ACCELERATOR = 9

      RCDATA = 10

      MESSAGETABLE = 11

      GROUP_CURSOR = 12

      GROUP_ICON = 14

      VERSION = 16

      DLGINCLUDE = 17

      PLUGPLAY = 19

      VXD = 20

      ANICURSOR = 21

      ANIICON = 22

      HTML = 23

      MANIFEST = 24

    End Enum

    <StructLayout(LayoutKind.Sequential, size:=16)>

    Structure IconDirEntry

      Public bWidth As Byte

      Public bHeight As Byte

      Public bColorCount As Byte

      Public bReserved As Byte

      Public wPlanes As UShort

      Public wBitCount As UShort

      Public dwBytesInRes As UInteger

      Public dwImageOffset As UInteger

    End Structure

    <StructLayout(LayoutKind.Sequential, size:=14)>

    Structure GroupIconDirEntry

      Public Width As Byte

      Public Height As Byte

      Public ColorCount As Byte

      Public Reserved As Byte

      Public Planes As Int16

      Public BitCount As Int16

      Public ByteInRes As Int32

      Public nID As Int16

    End Structure



    <StructLayout(LayoutKind.Sequential, size:=6)>

    Structure GRPICONDIR

      Public Reserved As Short

      Public Type As Short

      Public Count As Short

    End Structure

    <StructLayout(LayoutKind.Sequential, size:=6)>

    Structure ICONDIR

      Public Reserved As UShort

      Public Type As UShort

      Public Count As UShort

    End Structure

    Structure TypedObject

      Public MainType As IntPtr

      Public OpType As String

      Sub New(mt As IntPtr, Optional opt As String = Nothing)

      MainType = mt

      opt = opt

      End Sub

    End Structure

    Private Shared PtrToIconList As New List(Of TypedObject)

    Private Shared IconList As New List(Of Icon)



    Public Shared Function GetIcons(ByVal FilePath As String) As List(Of Icon)



      Dim hModule As IntPtr = LoadLibraryEx(FilePath, IntPtr.Zero, LoadLibraryFlags.LOAD_LIBRARY_AS_DATAFILE)

      If EnumResourceNames(hModule, 14, AddressOf EnumResNameProc, IntPtr.Zero) = False Then

      Throw New Exception("No icon Found")

      End If

      For Each IconGroup As TypedObject In PtrToIconList



      Dim loc As IntPtr = FindResource(hModule, IconGroup.MainType, New IntPtr(14))

      If IconGroup.MainType = IntPtr.Zero Then

      loc = FindResource(hModule, IconGroup.OpType, New IntPtr(14))

      End If

      Dim hRes As IntPtr = LoadResource(hModule, loc)

      Dim GrpPtrIco As IntPtr = LockResource(hRes)

      Dim ResSize As Integer = SizeofResource(hModule, loc)



      Dim resBytes As Byte() = New Byte(ResSize - 1) {}

      Marshal.Copy(GrpPtrIco, resBytes, 0, resBytes.Length)



      Dim mst As IO.MemoryStream = New IO.MemoryStream(resBytes)



      Using dst As New IO.MemoryStream()



      Dim IconHeadSize As Integer = Marshal.SizeOf(GetType(GRPICONDIR))

      Dim IconHeadBuffer As Byte() = New Byte(IconHeadSize) {}

      mst.Read(IconHeadBuffer, 0, IconHeadSize)

      Dim PtrIconhead As IntPtr = Marshal.AllocHGlobal(IconHeadSize)

      Marshal.Copy(IconHeadBuffer, 0, PtrIconhead, IconHeadSize)



      Dim IconHead As GRPICONDIR = Marshal.PtrToStructure(PtrIconhead, GetType(GRPICONDIR))

      Marshal.FreeHGlobal(PtrIconhead)



      Dim Entries As Integer = IconHead.Count

      Dim iconImageOffset As Integer = Marshal.SizeOf(GetType(ICONDIR)) + Entries * Marshal.SizeOf(GetType(IconDirEntry))



      Dim IconDir As New ICONDIR

      IconDir.Reserved = IconHead.Reserved

      IconDir.Type = IconHead.Type

      IconDir.Count = IconHead.Count

      Dim IconDirSize As Integer = Marshal.SizeOf(GetType(ICONDIR))

      Dim IconDirBuffer As Byte() = New Byte(IconDirSize) {}

      Dim PtrIconDir As IntPtr = Marshal.AllocHGlobal(IconDirSize)

      Marshal.StructureToPtr(IconDir, PtrIconDir, True)

      Marshal.Copy(PtrIconDir, IconDirBuffer, 0, IconDirSize)



      dst.Write(IconDirBuffer, 0, IconDirSize)



      For I As Integer = 0 To Entries - 1

      Dim GrpEntriesSize As Integer = Marshal.SizeOf(GetType(GroupIconDirEntry))

      Dim GrpEntriesBuff As Byte() = New Byte(GrpEntriesSize) {}

      mst.Read(GrpEntriesBuff, 0, GrpEntriesSize)

      Dim GrpEntriesPtr As IntPtr = Marshal.AllocHGlobal(GrpEntriesSize)

      Marshal.Copy(GrpEntriesBuff, 0, GrpEntriesPtr, GrpEntriesSize)

      Dim GrpEntires As GroupIconDirEntry = Marshal.PtrToStructure(GrpEntriesPtr, GetType(GroupIconDirEntry))

      Marshal.FreeHGlobal(GrpEntriesPtr)



      dst.Seek(IconDirSize + I * Marshal.SizeOf(GetType(IconDirEntry)), IO.SeekOrigin.Begin)



      Dim IconDirEntry As New IconDirEntry

      IconDirEntry.bWidth = GrpEntires.Width

      IconDirEntry.bHeight = GrpEntires.Height

      IconDirEntry.bColorCount = GrpEntires.ColorCount

      IconDirEntry.bReserved = GrpEntires.Reserved

      IconDirEntry.wPlanes = GrpEntires.Planes

      IconDirEntry.wBitCount = GrpEntires.BitCount

      IconDirEntry.dwBytesInRes = GrpEntires.ByteInRes

      IconDirEntry.dwImageOffset = iconImageOffset



      Dim DirEntrySize As Integer = Marshal.SizeOf(GetType(IconDirEntry))

      Dim DirEntryBuffer As Byte() = New Byte(DirEntrySize) {}

      Dim DirEntryPtr As IntPtr = Marshal.AllocHGlobal(DirEntrySize)

      Marshal.StructureToPtr(IconDirEntry, DirEntryPtr, True)

      Marshal.Copy(DirEntryPtr, DirEntryBuffer, 0, DirEntrySize)



      dst.Write(DirEntryBuffer, 0, DirEntrySize)



      'get the icon data

      Dim IcoLoc As IntPtr = FindResource(hModule, New IntPtr(GrpEntires.nID), New IntPtr(3))

      Dim IcoRes As IntPtr = LoadResource(hModule, IcoLoc)

      Dim IcoPtr As IntPtr = LockResource(IcoRes)

      Dim IcoSize As Integer = SizeofResource(hModule, IcoLoc)

      Dim ImgBuff As Byte() = New Byte(IcoSize) {}

      Marshal.Copy(IcoPtr, ImgBuff, 0, IcoSize)



      dst.Seek(iconImageOffset, IO.SeekOrigin.Begin)

      dst.Write(ImgBuff, 0, ImgBuff.Length)

      iconImageOffset += ImgBuff.Length

      Next

      dst.Seek(0, IO.SeekOrigin.Begin)

      IconList.Add(New Icon(dst))

      End Using

      Next

      Return IconList

    End Function

    Public Shared Sub SaveIcon(ByVal Path As String, ByVal mIcon As Icon)

      Dim fs As IO.FileStream = IO.File.Create(Path)

      mIcon.Save(fs)

      fs.Close()

    End Sub

    Private Shared Function EnumResNameProc(ByVal hModule As IntPtr, ByVal lpszType As IntPtr, ByVal lpszName As IntPtr, ByVal lParam As IntPtr) As Boolean

      Dim PtrStr As String = Marshal.PtrToStringUni(lpszName)

      Dim mTyped As New TypedObject

      If Not IsNothing(PtrStr) Then

      mTyped.OpType = PtrStr

      Else

      mTyped.MainType = lpszName

      End If

      PtrToIconList.Add(mTyped)

      EnumResNameProc = True

    End Function

End Class

PHP Code



<?php 
Imports System.Runtime.InteropServices
Public Class Form1
    Sub New()
      AllowDrop = True
      ' This call is required by the designer.
      InitializeComponent()

      ' Add any initialization after the InitializeComponent() call.

    End Sub

    Private Sub CM_CLICK(sender As Object, e As EventArgs)
      Dim sfd As New SaveFileDialog With {.Filter = "Icon files (*.ico)|*.ico"}
      DirectCast(sender, ContextMenuStrip).Visible = False
      If sfd.ShowDialog = Windows.Forms.DialogResult.OK Then
      Dim mList As List(Of Icon) = DirectCast(DirectCast(sender, ContextMenuStrip).Tag(1), List(Of Icon))
      Natives.SaveIcon(sfd.FileName, mList(DirectCast(sender, ContextMenuStrip).Tag(0)))
      MsgBox("icon Saved !")
      End If
    End Sub
    Private Sub Form1_DragDrop(sender As Object, e As DragEventArgs) Handles Me.DragDrop
      Dim Data() As String = e.Data.GetData(DataFormats.FileDrop)
      Dim mList As List(Of Icon) = Natives.GetIcons(Data(0))
      Dim OldLoc As Integer = 0
      For I As Integer = 0 To mList.Count - 1
      Dim pict As New PictureBox()
      pict.Size = Icon.Size
      pict.Image = mList(I).ToBitmap()
      pict.Location = New Point(OldLoc, 0)
      Dim CM As New ContextMenuStrip
      pict.ContextMenuStrip = CM
      CM.Items.Add("Save")
      CM.Tag = New Object() {I, mList}
      AddHandler CM.Click, AddressOf CM_CLICK
      OldLoc += pict.Width + 3
      Controls.Add(pict)
      Next
    End Sub

    Private Sub Form1_DragEnter(sender As Object, e As DragEventArgs) Handles Me.DragEnter
      If e.Data.GetDataPresent(DataFormats.FileDrop) Then
      e.Effect = DragDropEffects.Copy
      End If

    End Sub

End Class