如何得到各类文件在系统中注册时的图标？

[xuqiang007]

想做一个类似资源浏览器的东东，得到的每个文件想带上文件本身的图标，比如说*.DOC文件的图标就是类似WORD的那样的图标，而WORD.EXE本身也有自己的图标，不论是程序，还是和程序关联的文件，每一种文件的图标。如何比较快速的实现呢？

[gmc007]

每一种文件的类型都可以在注册表里找到它的键值，
从那里你就可以找到它的图标信息。
========
我记得以前有人问过，你可以搜索一下，在那里我可能讲得更清楚些。

[sonicdater]

HKEY_CLASSES_ROOT 下面有。

[xuqiang007]

楼上会加分的（其实楼上说的我也知道），希望能有示例或者代码可以参考一下。

[xuqiang007]

谢谢楼上两位，希望还有人能讨论一下。

[DeityFox]

以下是Form1的代码

VERSION 5.00
Begin VB.Form ShowIconsForm
Caption = "ShowIcons"
ClientHeight = 4245
ClientLeft = 1650
ClientTop = 1545
ClientWidth = 3375
LinkTopic = "Form1"
ScaleHeight = 283
ScaleMode = 3 'Pixel
ScaleWidth = 225
Begin VB.TextBox PatternText
Height = 285
Left = 0
TabIndex = 5
Text = "*.*"
Top = 3960
Width = 2175
End
Begin VB.FileListBox FileList
Height = 2235
Left = 0
TabIndex = 4
Top = 1680
Width = 2175
End
Begin VB.DirListBox DirList
Height = 1215
Left = 0
TabIndex = 3
Top = 360
Width = 2175
End
Begin VB.DriveListBox DriveList
Height = 315
Left = 0
TabIndex = 2
Top = 0
Width = 2175
End
Begin VB.PictureBox LargeIconPicture
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 480
Left = 2280
ScaleHeight = 32
ScaleMode = 3 'Pixel
ScaleWidth = 32
TabIndex = 1
Top = 360
Width = 480
End
Begin VB.PictureBox SmallIconPicture
AutoSize = -1 'True
BorderStyle = 0 'None
Height = 360
Left = 2280
ScaleHeight = 24
ScaleMode = 3 'Pixel
ScaleWidth = 24
TabIndex = 0
Top = 1320
Width = 360
End
Begin VB.Label SmallIconLabel
Height = 255
Left = 2280
TabIndex = 7
Top = 960
Width = 975
End
Begin VB.Label LargeIconLabel
Height = 255
Left = 2280
TabIndex = 6
Top = 0
Width = 975
End
End
Attribute VB_Name = "ShowIconsForm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private Type TypeIcon
cbSize As Long
picType As PictureTypeConstants
hIcon As Long
End Type

Private Type CLSID
id(16) As Byte
End Type

Private Const MAX_PATH = 260
Private Type SHFILEINFO
hIcon As Long ' out: icon
iIcon As Long ' out: icon index
dwAttributes As Long ' out: SFGAO_ flags
szDisplayName As String * MAX_PATH ' out: display name (or path)
szTypeName As String * 80 ' out: type name
End Type

Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" (pDicDesc As TypeIcon, riid As CLSID, ByVal fown As Long, lpUnk As Object) As Long
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long

Private Const SHGFI_ICON = &H100
Private Const SHGFI_LARGEICON = &H0
Private Const SHGFI_SMALLICON = &H1

' Convert an icon handle into an IPictureDisp.
Private Function IconToPicture(hIcon As Long) As IPictureDisp
Dim cls_id As CLSID
Dim hRes As Long
Dim new_icon As TypeIcon
Dim lpUnk As IUnknown

With new_icon
.cbSize = Len(new_icon)
.picType = vbPicTypeIcon
.hIcon = hIcon
End With
With cls_id
.id(8) = &HC0
.id(15) = &H46
End With
hRes = OleCreatePictureIndirect(new_icon, _
cls_id, 1, lpUnk)
If hRes = 0 Then Set IconToPicture = lpUnk
End Function

Private Function GetIcon(filename As String, icon_size As Long) As IPictureDisp
Dim index As Integer
Dim hIcon As Long
Dim item_num As Long
Dim icon_pic As IPictureDisp
Dim sh_info As SHFILEINFO

SHGetFileInfo filename, 0, sh_info, _
Len(sh_info), SHGFI_ICON + icon_size
hIcon = sh_info.hIcon
Set icon_pic = IconToPicture(hIcon)
Set GetIcon = icon_pic
End Function

Private Sub DirList_Change()
FileList.Path = DirList.Path
End Sub
Private Sub DriveList_Change()
On Error GoTo DriveError
DirList.Path = DriveList.Drive
Exit Sub

DriveError:
DriveList.Drive = DirList.Path
Exit Sub
End Sub

Private Sub FileList_Click()
Dim fname As String

On Error GoTo LoadPictureError

fname = FileList.Path + "\" + FileList.filename
Caption = "ShowIcons [" & fname & "]"

SmallIconPicture.Picture = _
GetIcon(fname, SHGFI_SMALLICON)
SmallIconLabel.Caption = _
Format$(SmallIconPicture.ScaleWidth) & _
"x" & _
Format$(SmallIconPicture.ScaleHeight)

LargeIconPicture.Picture = _
GetIcon(fname, SHGFI_LARGEICON)
LargeIconLabel.Caption = _
Format$(LargeIconPicture.ScaleWidth) & _
"x" & _
Format$(LargeIconPicture.ScaleHeight)

Exit Sub

LoadPictureError:
Beep
Caption = "ShowIcons [Invalid picture]"
Exit Sub
End Sub

Private Sub Form_Resize()
Dim wid As Integer
Dim hgt As Integer

If WindowState = vbMinimized Then Exit Sub

PatternText.Move _
0, ScaleHeight - PatternText.Height

hgt = (PatternText.Top - DriveList.Top - _
DriveList.Height) / 2
If hgt < 10 Then hgt = 10
wid = DriveList.Width
DirList.Move 0, DriveList.Top + _
DriveList.Height, wid, hgt
FileList.Move 0, DirList.Top + _
DirList.Height, wid, hgt
End Sub


Private Sub PatternText_Change()
FileList.Pattern = PatternText.Text
End Sub

[DeityFox]

以上程序显示与文件关联的大（32×32）、小（16×16）图标。
在win2k＋vb6 SP5中调试通过