VBNet - Форум - Получение иконки по расширению файла

Вопрос: Получение иконки по расширению файла Добавлено: 04.11.04 18:20

Автор вопроса: Comanche

Для определения иконки, сопоставленной типу (расширению) файла, пользуюсь вот таким кодом:

Option Explicit

Private Type PICTDESC
    cbSize As Long
    pictType As Long
    hIcon As Long
    hPal As Long
End Type

Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" _
    (lpPictDesc As PICTDESC, riid As Any, ByVal fOwn As Long, _
    ipic As IPicture) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegEnumKey Lib "advapi32.dll" Alias "RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As String, ByVal cbName As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function ExtractIcon Lib "shell32.dll" Alias "ExtractIconA" (ByVal hInst As Long, ByVal lpszExeFileName As String, ByVal nIconIndex As Long) As Long

Private Const HKEY_CLASSES_ROOT = &H80000000

Private Sub Command1_Click()
    Set Picture1.Picture = GetFileTypeIcon(Text1.Text)
End Sub

Function GetFileTypeIcon(ByVal fileExtension As String) As StdPicture
    Dim lRegKey As Long
    Dim sName As String
    Dim sOld As String
    Dim sFileAndIndex As String
    Dim sFile As String
    Dim iIndex As Integer
    Dim lIcon As Long

    Set GetFileTypeIcon = Nothing
    If Left$(fileExtension, 1) <> "." Then fileExtension = "." & fileExtension

    If RegOpenKey(HKEY_CLASSES_ROOT, ByVal fileExtension, lRegKey) = 0 Then

        sName = Space$(255)
        Call RegQueryValueEx(lRegKey, ByVal "", 0&, 1, ByVal sName, 255)
        If InStr(sName, Chr$(0)) Then sName = Left$(sName, InStr(sName, Chr$(0)) - 1)
        Log sName

        Call RegCloseKey(lRegKey)

        If Len(Trim$(sName)) > 0 Then
            If RegOpenKey(HKEY_CLASSES_ROOT, sName & "\DefaultIcon\", lRegKey) = 0 Then
                sFileAndIndex = Space$(255)
                Call RegQueryValueEx(lRegKey, ByVal "", 0&, 1, ByVal sFileAndIndex, 255)
                If InStr(sFileAndIndex, Chr$(0)) Then sFileAndIndex = Left$(sFileAndIndex, InStr(sFileAndIndex, Chr$(0)) - 1)
                Call RegCloseKey(lRegKey)
                Log sFileAndIndex
                sFile = Left$(sFileAndIndex, InStr(sFileAndIndex, ",") - 1)
                iIndex = Val(Mid$(sFileAndIndex, InStr(sFileAndIndex, ",") + 1))
                lIcon = ExtractIcon(App.hInstance, sFile, iIndex)
                Set GetFileTypeIcon = IconToPicture(lIcon)
            End If
        End If

    End If
End Function

Private Function IconToPicture(ByVal hIcon As Long) As Picture
    Dim pic As PICTDESC
    Dim guid(0 To 3) As Long

    pic.cbSize = Len(pic)
    pic.pictType = vbPicTypeIcon
    pic.hIcon = hIcon
    ' IPicture GUID {7BF80980-BF32-101A-8BBB-00AA00300CAB}
    guid(0) = &H7BF80980
    guid(1) = &H101ABF32
    guid(2) = &HAA00BB8B
    guid(3) = &HAB0C3000
    OleCreatePictureIndirect pic, guid(0), True, IconToPicture
End Function

Private Sub Log(ByVal st As String)
    Text2.SelStart = Len(Text2.Text)
    Text2.SelText = st & vbNewLine
End Sub

У меня на компе (Win2000SP4) установлен текстовый редактор UltraEdit, который зарегистрировал за собой расширение TXT. Плюс ещё я сам зарегистрировал за ним расширения INI и LOG. Так что в ветке реестра "HKEY_CLASSES_ROOT\.ini" теперь прописан новый тип - "UltraEdit.ini". Если в "HKEY_CLASSES_ROOT" спуститься до ветки "HKEY_CLASSES_ROOT\UltraEdit.ini", то видно, что в ней ОТСУТСТВУЕТ параметр "DefaultIcon", и поэтому вышеприведённый код не находит связанного приложения и возвращает пустую картинку. Но ведь вместе с этим, на моём компе у всех файлов с расширением INI иконка отображается корректно - т.е. берётся иконка редактора UltraEdit! Откуда же винды её берут?! берут они её явно не как в этом коде - хотя этот код и предлагается везде в Сети для данных целей.

Дальше - больше. Иду в Проводник, в меню "Сервис" выбираю "Свойства папки", а там - "Типы файлов". Вот что можно прочитать, если щёлкнуть по строчке с "INI" (иконка у которой отображается "правильно", т.е. она Ультраэдитовская):
- Тип файлов: "Параметры конфигурации" - это полностью согласуется с дефолтовым параметром ветки "HKEY_CLASSES_ROOT\UltraEdit.ini";
- Приложение: "UltraEdit-32 Professional Text/Hex Editor" - по идее, это тоже должно согласовываться с какой-либо записью реестра.

Ну, думаю, сейчас наконец-то найду, откуда винды берут иконку. Делаю поиск в реестре на строку "UltraEdit-32 Professional Text/Hex Editor" - и нахожу какую-то фигню, явно не имеющую отношения к иконкам. Всё, тупик!

Что же это за такой "хитрый" способ создания файловой ассоциации, которым пользуется редактор UltraEdit? нет чтобы просто переопределить параметр "DefaultIcon"...
Ответить

Ответы Всего ответов: 13

Номер ответа: 1 Автор ответа: cresta Вопросов: 117 Ответов: 1538	Профиль \| \| #1	Добавлено: 04.11.04 18:49
	К чему такие ужасы? Есть ведь SHGetFileInfo + SHGFI_SYSICONINDEX: Private Const SHGFI_LARGEICON = &H0 Private Const SHGFI_SYSICONINDEX = &H4000 Private Const ILD_TRANSPARENT = &H1 Private Type SHFILEINFO hIcon As Long iIcon As Long dwAttributes As Long szDisplayName As String * 260 szTypeName As String * 80 End Type 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 Declare Function ImageList_Draw Lib "comctl32.dll" (ByVal himl As Long, ByVal i As Long, ByVal hdcDst As Long, ByVal x As Long, ByVal y As Long, ByVal fStyle As Long) As Long Private Declare Function ImageList_DrawEx Lib "comctl32.dll" (ByVal himl As Long, ByVal i As Long, ByVal hdcDst As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal rgbBk As Long, ByVal rgbFg As Long, ByVal fStyle As Long) As Long Private Sub Form_Load() Dim hIcon As Long, SFI As SHFILEINFO Me.AutoRedraw = True hIcon = SHGetFileInfo("c:\upx.exe", ByVal 0&, SFI, Len(SFI), SHGFI_SYSICONINDEX Or SHGFI_LARGEICON) ImageList_Draw hIcon, SFI.iIcon, Me.hDC, 0, 0, ILD_TRANSPARENT End Sub Ответить

Номер ответа: 2 Автор ответа: Comanche Вопросов: 87 Ответов: 459	Профиль \| \| #2	Добавлено: 04.11.04 18:56
	Я знаю этот способ, но там мы пляшем от существующего файла (в твоём примере - от "c:\upx.exe". А мне нужно "плясать" только лишь от файлового расширения (от "exe", к примеру). Ответить

Номер ответа: 3 Автор ответа: cresta Вопросов: 117 Ответов: 1538	Профиль \| \| #3	Добавлено: 04.11.04 19:49
	Ну так сделай какой-нибудь временный файл, пусть даже пустой, дай ему интересующее тебя расширение, и получи икону для этого расширения. Потом можешь и удалить этот файл В чём проблема? Ответить

Номер ответа: 4 Автор ответа: Comanche Вопросов: 87 Ответов: 459	Профиль \| \| #4	Добавлено: 04.11.04 20:28
	"...пусть даже пустой..." - просто как всё гениальное! Огромное спасибо! PS: и как я не допёр?! ) Ответить

Номер ответа: 5 Автор ответа: Comanche Вопросов: 87 Ответов: 459	Профиль \| \| #5	Добавлено: 04.11.04 20:43
	Однако, полученная твоим способом hIcon не хочет превращаться в StdPicture с помощью моей функции IconToPicture. В чём тут м.б. дело?! Ответить

Номер ответа: 6 Автор ответа: Comanche Вопросов: 87 Ответов: 459	Профиль \| \| #6	Добавлено: 04.11.04 20:52
	Пардон, разобрался: hIcon = SHGetFileInfo("c:\abc.ini", ByVal 0&, SFI, Len(SFI), SHGFI_ICON Or SHGFI_LARGEICON) Set Picture1.Picture = IconToPicture(SFI.hIcon) Слава богу, что есть API Guide ) Ответить

Номер ответа: 7 Автор ответа: cresta Вопросов: 117 Ответов: 1538	Профиль \| \| #7	Добавлено: 04.11.04 21:21
	Видишь, как всё здорово? А пустой файл можно и для FindExecutable например, использовать. Ответить

Номер ответа: 8 Автор ответа: Comanche Вопросов: 87 Ответов: 459	Профиль \| \| #8	Добавлено: 05.11.04 01:11
	YES!!! И эта твоя мысль пришлась как нельзя вовремя! Ещё раз спасибо. Ответить

Номер ответа: 9 Автор ответа: dNW Вопросов: 30 Ответов: 683	Профиль \| \| #9	Добавлено: 05.11.04 07:39
	Едрит твою налево! Какие ужасные вещи тут летят! Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" (ByVal hInst As Long, ByVal lpIconPath As String, lpiIcon As Long) As Long Вот и ВСЕ! Ответить

Номер ответа: 10 Автор ответа: cresta Вопросов: 117 Ответов: 1538	Профиль \| \| #10	Добавлено: 05.11.04 13:43
	Вот и ВСЕ! Ну вроде как раз и совсем не всё. Можно сказать, вообще ничего. Этот код что-нибудь делает, кроме того, что декларирует ф-цию? SHGetFileInfo тоже одной строкой декларируется. И чем лучше ExtractAssociatedIcon? Ну кроме того, что он нее не добьёшься например hIconSmall, или не получишь индекс иконки в системном imagelist'e? И ещё много какой информации о файле (см msdn). Есть ли у неё ещё "преимущества" ? Ответить

Номер ответа: 11 Автор ответа: dNW Вопросов: 30 Ответов: 683	Профиль \| \| #11	Добавлено: 05.11.04 14:25
	Ну ладно. Так уж и быть AutoRedraw = True DrawIcon hdc, 10, 10, ExtractAssociatedIcon(App.hInstance, "c:\abc.ini", 2) Ответить

Номер ответа: 12 Автор ответа: Александр Разработчик Offline Client ICQ: 204034 Вопросов: 106 Ответов: 1919	Профиль \| \| #12	Добавлено: 05.11.04 20:19
	А меня этот код почему-то не пашет... Щас пойду разбираться. Ответить

Номер ответа: 13 Автор ответа: Александр Разработчик Offline Client ICQ: 204034 Вопросов: 106 Ответов: 1919	Профиль \| \| #13	Добавлено: 05.11.04 20:19
	А меня этот код почему-то не пашет... Щас пойду разбираться. Ответить

Страница: 1 |