Visual Basic, .NET, ASP, VBA, VBScript
 
  Библиотека кодов  
  Работа с WINDOWS  
     
  Получение сведений о зарегистрированных типах файлов в системе  
  Данный пример позволяет узнать о всех зарегистрированных типов файлов в системе, а также получить рисунок иконки, присущий данному типу файлов

Расположите на форме элемент ListBox и элемент PictureBox. Для более наглядного отображения информации установите свойство .Sorted элемента ListBox как True.


Option Explicit
'Aaron Young http://www.pressenter.com/~ajyoung
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 DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags 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 aIcons() As String

Private Sub Form_Load()
Dim sType As String
Dim sName As String
Dim sFile As String
Dim iIndex As Integer
Dim lRegKey As Long
Dim iFoundCount As Integer
iIndex = 1
iFoundCount = 1
sType = Space(255)
'Перечисление всех расширений
Do While RegEnumKey(HKEY_CLASSES_ROOT, iIndex, ByVal sType, 255) = 0
If Left(sType, 1) <> "." Then
Else
'Сохранение информации об иконке
ReDim Preserve aIcons(iIndex - 1)
sType = Left(sType, InStr(sType, Chr(0)) - 1)
'Получить имя расширения, (к примеру - .zip = WinZip)
If RegOpenKey(HKEY_CLASSES_ROOT, ByVal sType, 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)
Call RegCloseKey(lRegKey)
If Len(Trim(sName)) Then
'Поиск иконки по умолчанию для расширения
If RegOpenKey(HKEY_CLASSES_ROOT, sName & "\DefaultIcon\", lRegKey) = 0 Then
sFile = Space(255)
Call RegQueryValueEx(lRegKey, ByVal "", 0&, 1, ByVal sFile, 255)
If InStr(sFile, Chr(0)) Then sFile = Left(sFile, InStr(sFile, Chr(0)) - 1)
Call RegCloseKey(lRegKey)
aIcons(iFoundCount - 1) = sFile
End If
End If
End If
List1.AddItem Left(sType & Space(10), 10) & " - " & sName
iFoundCount = iFoundCount + 1
End If
sType = Space(255)
iIndex = iIndex + 1
Loop
End Sub

Private Sub List1_Click()
Dim sFile As String
Dim iIndex As Integer
Dim lIcon As Long
Picture1.Cls
On Error GoTo IconErr
'Получить иконку для данного типа расширения
sFile = Left$(aIcons(List1.ListIndex), InStr(aIcons(List1.ListIndex), ",") - 1)
iIndex = Val(Mid$(aIcons(List1.ListIndex), InStr(aIcons(List1.ListIndex), ",") + 1))
lIcon = ExtractIcon(App.hInstance, sFile, iIndex)
Call DrawIconEx(Picture1.hdc, 0, 0, lIcon, 32, 32, 0, 0, 3)
IconErr:
End Sub
 
     
  VBNet online (всего: 51216)  
 

Логин:

Пароль:

Регистрация, забыли пароль?


В чате сейчас человек
 
     
  VBNet рекомендует  
   
     
  Лучшие материалы  
 
ActiveX контролы (112)
Hitman74_Library (36119)
WindowsXPControls (20739)
FlexGridPlus (19374)
DSMAniGifControl (18295)
FreeButton (15157)
Примеры кода (546)
Parol (18027)
Passworder (9299)
Screen saver (7654)
Kerish AI (5817)
Folder_L (5768)
Статьи по VB (136)
Мое второе впечатление... (11236)
VB .NET: дорога в будущее (11161)
Основы SQL (9225)
Сообщения Windows в Vi... (8788)
Классовая теория прогр... (8619)
 
     
Техническая поддержка MTW-хостинг | © Copyright 2002-2011 VBNet.RU | Пишите нам