Public Const MAX_PATH As Long = 260
Public Const SHGFI_DISPLAYNAME = &H200
Public Const SHGFI_EXETYPE = &H2000
Public Const SHGFI_SYSICONINDEX = &H4000 'system icon index
Public Const SHGFI_LARGEICON = &H0 'large icon
Public Const SHGFI_SMALLICON = &H1 'small icon
Public Const SHGFI_SHELLICONSIZE = &H4
Public Const SHGFI_TYPENAME = &H400
Public Const ILD_TRANSPARENT = &H1 'display transparent
Public Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME Or _
                                 SHGFI_SHELLICONSIZE Or _
                                 SHGFI_SYSICONINDEX Or _
                                 SHGFI_DISPLAYNAME Or _
                                 SHGFI_EXETYPE

Public Type SHFILEINFO
   hIcon As Long
   iIcon As Long
   dwAttributes As Long
   szDisplayName As String * MAX_PATH
   szTypeName As String * 80
End Type

Public Declare Function SHGetFileInfo Lib "shell32" _
   Alias "SHGetFileInfoA" _
   (ByVal pszPath As String, _ 
    ByVal dwFileAttributes As Long, _ 
    psfi As SHFILEINFO, _ 
    ByVal cbSizeFileInfo As Long, _ 
    ByVal uFlags As Long) As Long

Public Declare Function ImageList_Draw Lib "comctl32" _
   (ByVal himl As Long, ByVal i As Long, _
    ByVal hDCDest As Long, ByVal x As Long, _
    ByVal y As Long, ByVal flags As Long) As Long

Public shinfo As SHFILEINFO

Option Explicit

Private Sub Form_Load()
   
  'centre the form on the screen   
   Me.Move (Screen.Width - Me.Width) / 2, (Screen.Height - Me.Height) / 2

End Sub 


Private Sub Command2_Click()

   Unload Me

End Sub 


Private Sub Command1_Click()
   
  'working variables...
   Dim hImgSmall as Long   'the handle to the system image list
   Dim fName As String     'the file name to get icon from
   Dim fnFilter As String  'the file name filter   
   Dim r As Long
   
  'a little error handling to trap a cancel   
   On Local Error GoTo Command1ErrorHandler
   
  'get the file from the user   
   fnFilter = "All Files (*.*)|*.*|"
   fnFilter = fnFilter & "Applications (*.exe)|*.exe|"
   fnFilter = fnFilter & "Windows Bitmap (*.bmp)|*.bmp|"
   fnFilter = fnFilter & "Icon Files (*.ico)|*.ico"

   CommonDlg1.CancelError = True
   CommonDlg1.Filter = fnFilter
   CommonDlg1.ShowOpen

   fName = CommonDlg1.FileName
   
  'get the system icon associated with that file   
   hImgSmall& = SHGetFileInfo(fName, 0&, _
                              shinfo, Len(shinfo), _
                              BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)

   hImgLarge& = SHGetFileInfo(fName, 0&, _
                              shinfo, Len(shinfo), _
                              BASIC_SHGFI_FLAGS Or SHGFI_LARGEICON)
   
   'fill in the labels with the image's file data   
    Label1.Caption = Left$(shinfo.szDisplayName, _
               InStr(shinfo.szDisplayName, Chr$(0)) - 1)

    Label2.Caption = Left$(shinfo.szTypeName, _
               InStr(shinfo.szTypeName, Chr$(0)) - 1)
   
  'Set set the picture boxes to receive the icons.
  'Their size must be 16x16 pixels (240x240 twips)
  'for the small icon, and 32x32 pixels (480x480 twips)
  'for the large icon, with no 3d or border. 
  'Clear any existing image   
   pixSmall.Picture = LoadPicture()
   pixSmall.AutoRedraw = True

   pixLarge.Picture = LoadPicture()
   pixLarge.AutoRedraw = True
   
  'draw the associated icons into the picture boxes   
   Call ImageList_Draw(hImgSmall&, shinfo.iIcon, pixSmall.hDC, 0, 0, ILD_TRANSPARENT)
   Call ImageList_Draw(hImgLarge&, shinfo.iIcon, pixLarge.hDC, 0, 0, ILD_TRANSPARENT)
   
  'realize the images by assigning its 
  'image property (where the icon was drawn) 
  'to the actual picture property   
   pixSmall.Picture = pixSmall.Image
   pixLarge.Picture = pixLarge.Image
   
  'Uncomment out the following code to save 
  'to the current path.  Note that the background
  'colour of the icons saved will be the background
  'colour of the pixSmall/pixLarge control.  
  ' SavePicture pixSmall, "testSmall.bmp"
  ' SavePicture pixLarge, "testLarge.bmp"

Exit Sub

Command1ErrorHandler:
Exit Sub

End Sub