Sección de códigos , trucos y ejemplos para visual basic

496 - Obtener elementos de Mi Pc, panel de control y carpetas especiales

Contenido

Obtener elementos de Mi PC y el panel de control
Obtener carpetas especiales
Enlaces relacionados

Obtener elementos de Mi PC y el panel de control

Este ejemplo muestra como cargar en un control ListView ( Aunque se podria también usar un Treeview) algunos elementos de la sección Mi PC del explorador de windows y algunas carpetas y opciones del panel de control, mostrando el ícono de cada item, y también una función para poder abrir dicha opción mediante el comando Shell de visual basic.

Para poder acceder , ya sea para recuperar la imagen de ícono como para abrir la carpeta, se accede mediante el CLSID de cada elemento.

Los elementos que se pueden obtener son

Conexiones de red y Mis sitios de red
La papelera
El item del panel de control y sistema
Impresoras y Faxes
Herramientas administrativas
Carpetas web y fuentes

Ejemplo

Agregar un módulo de clase. Renombrar el módulo a cSFolders
Agregar al formulario un control ListView, dos ImageList
Agregar dos botones en un array ( Command1(0) y Command1(1))

Código fuente en el módulo de clase

Option Explicit '--------------------------------------------------------------------------- '--------------------------------------------------------------------------- ' -- Descripción : Simple módulo de código para obtener Items de windows (Panel de control, mi pc etc..) y carpetas especiales junto con las imagenes e íconos ' -- Autor : Luciano Lodola -- http://www.recursosvisualbasic.com.ar/ '--------------------------------------------------------------------------- '--------------------------------------------------------------------------- ' -- Enum para Carpetas / Directorios especiales de Windows '--------------------------------------------------------------------------- Enum eCSIDL_SPECIAL_FOLDERS e_ADMINTOOLS = &H30 e_ALTSTARTUP = &H1D e_APPDATA = &H1A e_BITBUCKET = &HA e_COMMON_ADMINTOOLS = &H2F e_COMMON_ALTSTARTUP = &H1E e_COMMON_APPDATA = &H23 e_COMMON_DESKTOPDIRECTORY = &H19 e_COMMON_DOCUMENTS = &H2E e_COMMON_FAVORITES = &H1F e_COMMON_PROGRAMS = &H17 e_COMMON_STARTMENU = &H16 e_COMMON_STARTUP = &H18 e_COMMON_TEMPLATES = &H2D e_CONNECTIONS = &H31 e_CONTROLS = &H3 e_COOKIES = &H21 e_DESKTOP = &H0 e_DESKTOPDIRECTORY = &H10 e_DRIVES = &H11 e_FAVORITES = &H6 e_FLAG_DONT_VERIFY = &H4000 e_FLAG_MASK = &HFF00& e_FLAG_PFTI_TRACKTARGET = e_FLAG_DONT_VERIFY e_FONTS = &H14 e_INTERNET = &H1 e_HISTORY = &H22 e_INTERNET_CACHE = &H20 e_LOCAL_APPDATA = &H1C e_MYPICTURES = &H27 e_NETHOOD = &H13 e_NETWORK = &H12 e_PERSONAL = &H5 e_PRINTERS = &H4 e_PRINTHOOD = &H1B e_PROFILE = &H28 e_PROGRAM_FILES = &H26 e_PROGRAM_FILES_COMMON = &H2B e_PROGRAM_FILES_COMMONX86 = &H2C e_PROGRAM_FILESX86 = &H2A e_PROGRAMS = &H2 e_RECENT = &H8 e_SENDTO = &H9 e_STARTMENU = &HB e_STARTUP = &H7 e_SYSTEM = &H25 e_SYSTEMX86 = &H29 e_TEMPLATES = &H15 e_WINDOWS = &H24 End Enum Enum eSystemItems [e_MI_PC] = 0 [e_PAPELERA] = 1 [e_MIS_SITIOS_DE_RED] = 2 [e_PANEL_DE_CONTROL] = 3 [e_IMPRESORAS_FAX] = 4 [e_CARPETAS_WEB] = 5 [e_HERRAMIENTAS_ADMINISTRATIVAS] = 6 [e_CONEXIONES_DE_RED] = 7 [e_FUENTES] = 8 End Enum Const MAX_PATH = 260 ' -- Type para la función api ShellFileInfo Private Type ShellFileInfoType hIcon As Long iIcon As Long dwAttributes As Long szDisplayName As String * 260 szTypeName As String * 80 End Type ' -- Tamaño de íconos de archivos y drives (para la función SHGetFileInfo) Enum eIconSize eSmallIcon = 257 eLargeIcon = 256 End Enum ' -- Para la función SHGetFileInfo Private Type IconType cbSize As Long picType As PictureTypeConstants hIcon As Long End Type ' -- Para la función SHGetFileInfo Private Type CLSIdType id(16) As Byte End Type Private Type SHITEMID cb As Long abID As Byte End Type Private Type ITEMIDLIST mkid As SHITEMID End Type ' -- Funciones de windows '------------------------------------------- ' Función para recuperar las carpetas a partir del ID Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" (ByVal hwndOwner As Long, ByVal nFolder As Long, pidl As ITEMIDLIST) As Long Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long ' Función para obtener información varia de un archivo Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As ShellFileInfoType, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" (pDicDesc As IconType, riid As CLSIdType, ByVal fown As Long, lpUnk As Object) As Long ' Función para obtener el nombre de usuario actual Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long ' -- Colecciones, variables Private mColSFolderCurrentUser As Collection Private mColSFolderAllUsers As Collection Private mColSystemPaths As Collection ' ------------------------------------------------------------------------------- '\\ -- Carpetas del usuario actual ' ------------------------------------------------------------------------------- Property Get ColSFolderCurrentUser() As Collection Set ColSFolderCurrentUser = mColSFolderCurrentUser End Property ' ------------------------------------------------------------------------------- '\\ -- Carpetas de todos los usuarios ' ------------------------------------------------------------------------------- Property Get ColSFolderAllUsers() As Collection Set ColSFolderAllUsers = mColSFolderAllUsers End Property ' ------------------------------------------------------------------------------- '\\ -- Otras carpetas de windows ' ------------------------------------------------------------------------------- Property Get ColSystemPaths() As Collection Set ColSystemPaths = mColSystemPaths End Property ' ------------------------------------------------------------------------------- '\\ -- Abrir un item del sistema con el comando shell de vb ' ------------------------------------------------------------------------------- Sub OpenItem(lOption As eSystemItems) If lOption = e_MI_PC Then Shell "explorer " & "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}", vbNormalFocus If lOption = e_PAPELERA Then Shell "explorer " & "::{645FF040-5081-101B-9F08-00AA002F954E}", vbNormalFocus If lOption = e_MIS_SITIOS_DE_RED Then Shell "explorer " & "::{208D2C60-3AEA-1069-A2D7-08002B30309D}", vbNormalFocus If lOption = e_PANEL_DE_CONTROL Then Shell "explorer " & "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\::{21EC2020-3AEA-1069-A2DD-08002B30309D}", vbNormalFocus If lOption = e_IMPRESORAS_FAX Then Shell "explorer " & "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\::{2227A280-3AEA-1069-A2DE-08002B30309D}", vbNormalFocus If lOption = e_CARPETAS_WEB Then Shell "explorer " & "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\::{BDEADF00-C265-11D0-BCED-00A0C90AB50F}", vbNormalFocus If lOption = e_HERRAMIENTAS_ADMINISTRATIVAS Then Shell "explorer " & "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\::{21EC2020-3AEA-1069-A2DD-08002B30309D}\::{D20EA4E1-3957-11d2-A40B-0C5020524153}", vbNormalFocus If lOption = e_CONEXIONES_DE_RED Then Shell "explorer " & "::{7007ACC7-3202-11D1-AAD2-00805FC1270E}", vbNormalFocus If lOption = e_FUENTES Then Shell "explorer " & "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\::{21EC2020-3AEA-1069-A2DD-08002B30309D}\::{D20EA4E1-3957-11d2-A40B-0C5020524152}", vbNormalFocus End Sub ' ------------------------------------------------------------------------------- '\\ -- Retornar íconos (16 y 32 pixeles ) de algunos items de windows : Mi pc, red, panel de control ... ' ------------------------------------------------------------------------------- Function GetIconSystemItems(lIconSize As eIconSize, lItem As eSystemItems) As IPictureDisp If lItem = e_MI_PC Then Set GetIconSystemItems = LoadIcon(lIconSize, "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}") If lItem = e_PAPELERA Then Set GetIconSystemItems = LoadIcon(lIconSize, "::{645FF040-5081-101B-9F08-00AA002F954E}") If lItem = e_MIS_SITIOS_DE_RED Then Set GetIconSystemItems = LoadIcon(lIconSize, "::{208D2C60-3AEA-1069-A2D7-08002B30309D}") If lItem = e_PANEL_DE_CONTROL Then Set GetIconSystemItems = LoadIcon(lIconSize, "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\::{21EC2020-3AEA-1069-A2DD-08002B30309D}") If lItem = e_IMPRESORAS_FAX Then Set GetIconSystemItems = LoadIcon(lIconSize, "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\::{2227A280-3AEA-1069-A2DE-08002B30309D}") If lItem = e_CARPETAS_WEB Then Set GetIconSystemItems = LoadIcon(lIconSize, "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\::{BDEADF00-C265-11D0-BCED-00A0C90AB50F}") If lItem = e_HERRAMIENTAS_ADMINISTRATIVAS Then Set GetIconSystemItems = LoadIcon(lIconSize, "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\::{21EC2020-3AEA-1069-A2DD-08002B30309D}\::{D20EA4E1-3957-11d2-A40B-0C5020524153}") If lItem = e_CONEXIONES_DE_RED Then Set GetIconSystemItems = LoadIcon(lIconSize, "::{7007ACC7-3202-11D1-AAD2-00805FC1270E}") If lItem = e_FUENTES Then Set GetIconSystemItems = LoadIcon(lIconSize, "::{20D04FE0-3AEA-1069-A2D8-08002B30309D}\::{21EC2020-3AEA-1069-A2DD-08002B30309D}\::{D20EA4E1-3957-11d2-A40B-0C5020524152}") End Function ' ------------------------------------------------------------------------------- '\\ -- Retorna la ruta de las carpetas especiales de windows ' ------------------------------------------------------------------------------- Function GetPath(SpecialFolder As eCSIDL_SPECIAL_FOLDERS) As String Dim lRet As Long Dim IDL As ITEMIDLIST Dim Spath As String ' -- Obtener el ID del path lRet = SHGetSpecialFolderLocation(100, SpecialFolder, IDL) If lRet = 0 Then ' -- Crear Buffer de caracteres para el path Spath$ = Space$(512) ' -- Recuperamos el path desde el ID lRet = SHGetPathFromIDList(ByVal IDL.mkid.cb, ByVal Spath$) ' -- Eliminr nulos y retornar GetPath = Left$(Spath, InStr(Spath, Chr$(0)) - 1) End If End Function ' ----------------------------------------------------------------------------------------- ' \\ -- Devolver el ícono de un archivo o recurso del sistema ( un drive, Item del panel de control etc ..) como IPictureDisp ' ----------------------------------------------------------------------------------------- Function LoadIcon(lIconSize As eIconSize, ByVal sFileName As String) As IPictureDisp Dim ret As Long Dim Unkown As IUnknown Dim Icon As IconType Dim CLSID As CLSIdType Dim ShellInfo As ShellFileInfoType Call SHGetFileInfo(sFileName, 0, ShellInfo, Len(ShellInfo), lIconSize) With Icon .cbSize = Len(Icon) .picType = 3 .hIcon = ShellInfo.hIcon End With With CLSID .id(8) = &HC0 .id(15) = &H46 End With ret = OleCreatePictureIndirect(Icon, CLSID, 1, Unkown) Set LoadIcon = Unkown End Function ' ----------------------------------------------------------------------------------------- ' \\ -- Iniciar ' ----------------------------------------------------------------------------------------- Private Sub Class_Initialize() On Error GoTo error_handler Dim i As Long Dim sPathSpecialFolder As String Dim sPathCurrentUser As String Dim sPathAllUsers As String ' -- Inicio de variables Set mColSFolderCurrentUser = New Collection Set mColSFolderAllUsers = New Collection Set mColSystemPaths = New Collection ' -- Obtener ruta base del usuario actual sPathCurrentUser = Environ("USERPROFILE") ' -- Obtener ruta base de la carpeta de todos los usuarios sPathAllUsers = Environ("ALLUSERSPROFILE") ' -- Recorrer y Obtener las carpetas especiales de windows For i = 1 To 100 sPathSpecialFolder = GetPath(i) ' -- Comprobar el path If sPathSpecialFolder <> "" Then ' -- Si es el usuario actual agregarlo a la colección ... If InStr(sPathSpecialFolder, sPathCurrentUser) Then mColSFolderCurrentUser.Add sPathSpecialFolder ' -- Si es la de todos los usuarios ... ElseIf InStr(sPathSpecialFolder, sPathAllUsers) Then mColSFolderAllUsers.Add sPathSpecialFolder ' -- Sino otras carpetas ( windows, archivos de programa, ...) Else mColSystemPaths.Add sPathSpecialFolder, sPathSpecialFolder End If End If Next ' -- Error Exit Sub error_handler: If Err.Number = 457 Then Resume Next Else MsgBox Err.Description, vbCritical, "N° de error: " & CStr(Err.Number) End If End Sub Function GetFolderName(ByVal Spath As String) On Error GoTo error_handler If Right(Spath, 1) = "\" Then Spath = Left(Spath, Len(Spath) - 1) Dim arrFolders() As String arrFolders = Split(Spath, "\") GetFolderName = arrFolders(UBound(arrFolders)) Exit Function error_handler: End Function ' ----------------------------------------------------------------------------------------- ' \\ -- Terminar ' ----------------------------------------------------------------------------------------- Private Sub Class_Terminate() Set mColSFolderCurrentUser = Nothing Set mColSFolderAllUsers = Nothing Set mColSystemPaths = Nothing End Sub

Código fuente en el formulario

Option Explicit Private clsSF As cSFolders ' ------------------------------------------------------------------------------------- ' \\ ' -- Botón para cambiar el modo de vista ' ------------------------------------------------------------------------------------- Private Sub Command1_Click(Index As Integer) With ListView1 Select Case Index Case 1: .View = lvwReport Case 0: .View = lvwIcon End Select End With End Sub ' ------------------------------------------------------------------------------------- ' \\ --Inicio ' ------------------------------------------------------------------------------------- Private Sub Form_Load() Dim xLvItem As ListItem Set clsSF = New cSFolders With clsSF ' -- Agregar imágenes pequeñas ImageList1.ListImages.Add , , .GetIconSystemItems(eSmallIcon, e_PANEL_DE_CONTROL) ImageList1.ListImages.Add , , .GetIconSystemItems(eSmallIcon, e_MI_PC) ImageList1.ListImages.Add , , .GetIconSystemItems(eSmallIcon, e_MIS_SITIOS_DE_RED) ImageList1.ListImages.Add , , .GetIconSystemItems(eSmallIcon, e_IMPRESORAS_FAX) ImageList1.ListImages.Add , , .GetIconSystemItems(eSmallIcon, e_PAPELERA) ImageList1.ListImages.Add , , .GetIconSystemItems(eSmallIcon, e_CARPETAS_WEB) ImageList1.ListImages.Add , , .GetIconSystemItems(eSmallIcon, e_HERRAMIENTAS_ADMINISTRATIVAS) ImageList1.ListImages.Add , , .GetIconSystemItems(eSmallIcon, e_CONEXIONES_DE_RED) ImageList1.ListImages.Add , , .GetIconSystemItems(eSmallIcon, e_FUENTES) ' -- Agregar imágenes grandes ImageList2.ListImages.Add , , .GetIconSystemItems(eLargeIcon, e_PANEL_DE_CONTROL) ImageList2.ListImages.Add , , .GetIconSystemItems(eLargeIcon, e_MI_PC) ImageList2.ListImages.Add , , .GetIconSystemItems(eLargeIcon, e_MIS_SITIOS_DE_RED) ImageList2.ListImages.Add , , .GetIconSystemItems(eLargeIcon, e_IMPRESORAS_FAX) ImageList2.ListImages.Add , , .GetIconSystemItems(eLargeIcon, e_PAPELERA) ImageList2.ListImages.Add , , .GetIconSystemItems(eLargeIcon, e_CARPETAS_WEB) ImageList2.ListImages.Add , , .GetIconSystemItems(eLargeIcon, e_HERRAMIENTAS_ADMINISTRATIVAS) ImageList2.ListImages.Add , , .GetIconSystemItems(eLargeIcon, e_CONEXIONES_DE_RED) ImageList2.ListImages.Add , , .GetIconSystemItems(eLargeIcon, e_FUENTES) End With With ListView1 ' -- Enlazar los imagelist a los listview Set .SmallIcons = ImageList1 Set .Icons = ImageList2 ' -- Agregar el texto de los items Set xLvItem = .ListItems.Add(, , "Panel de control", 1, 1) Set xLvItem = .ListItems.Add(, , "Mi pc", 2, 2) Set xLvItem = .ListItems.Add(, , "Mis sitios de red", 3, 3) Set xLvItem = .ListItems.Add(, , "Impresoras y faxes", 4, 4) Set xLvItem = .ListItems.Add(, , "Papelera de reciclaje", 5, 5) Set xLvItem = .ListItems.Add(, , "Carpetas web", 6, 6) Set xLvItem = .ListItems.Add(, , "Herramientas administrativas", 7, 7) Set xLvItem = .ListItems.Add(, , "Conexiones de red", 8, 8) Set xLvItem = .ListItems.Add(, , "Fuentes", 9, 9) .View = lvwIcon ' -- Agregar encabezado de columna .ColumnHeaders.Add , , "Elementos del sistema", 4000 .Arrange = lvwAutoLeft ' ordenar items End With With Command1 .Item(0).Caption = "íconos grandes" .Item(1).Caption = "íconos chicos" End With Me.Caption = "Hacer Doble click para abrir la carpeta" End Sub Private Sub Form_Unload(Cancel As Integer) Set clsSF = Nothing End Sub ' \\ -- Abrir la carpeta al hacer dos clics en el elemento ' ------------------------------------------------------------------------------- Private Sub ListView1_DblClick() With ListView1 If .SelectedItem Is Nothing Then Exit Sub If .SelectedItem.Index = 1 Then Call clsSF.OpenItem(e_PANEL_DE_CONTROL) If .SelectedItem.Index = 2 Then Call clsSF.OpenItem(e_MI_PC) If .SelectedItem.Index = 3 Then Call clsSF.OpenItem(e_MIS_SITIOS_DE_RED) If .SelectedItem.Index = 4 Then Call clsSF.OpenItem(e_IMPRESORAS_FAX) If .SelectedItem.Index = 5 Then Call clsSF.OpenItem(e_PAPELERA) If .SelectedItem.Index = 6 Then Call clsSF.OpenItem(e_CARPETAS_WEB) If .SelectedItem.Index = 7 Then Call clsSF.OpenItem(e_HERRAMIENTAS_ADMINISTRATIVAS) If .SelectedItem.Index = 8 Then Call clsSF.OpenItem(e_CONEXIONES_DE_RED) If .SelectedItem.Index = 9 Then Call clsSF.OpenItem(e_FUENTES) End With End Sub

Carpetas especiales

Este ejemplo agrega las carpetas especiales del usuario actual o de todos los usuarios ( Carpeta de Inicio, Programas, mi música, videos, documentos, archivos temporales de internet, cookies, historial, plantillas, escritorio etc ..) y algunas otras carpetas de sistema.

Ejemplo

Agregar el módulo de clase del ejemplo anterior. Renombrar el módulo a cSFolders
Agregar al formulario un control ListView, dos ImageList

Agregar 5 botones en un arreglo

Command1(0) : Para las carpetas del usuario actual
Command1(1) : Todos los usuarios
Command1(2) : carpetas del sistema : Archivos de programa, system32, windows, archivos comunes
Command1(3) : Vista de Iconos chicos
Command1(4)) : Vista de Iconos grandes

código fuente en el form

Option Explicit ' \\ Declaraciones Apis ( para el manifest y los temas de windows) ' ------------------------------------------------------------------------------------------ Private Declare Function SetErrorMode Lib "kernel32" (ByVal wMode As Long) As Long Private Declare Sub InitCommonControls Lib "Comctl32" () Private clsSF As cSFolders Private Sub Command1_Click(Index As Integer) With clsSF Select Case Index Case 0: Call LoadListView(.ColSFolderCurrentUser) Case 1: Call LoadListView(.ColSFolderAllUsers) Case 2: Call LoadListView(.ColSystemPaths) Case 3: ListView1.View = lvwReport Case 4: ListView1.View = lvwIcon End Select End With End Sub ' ---------------------------------------------------------------------------------- ' \\ -- Inicio ' ---------------------------------------------------------------------------------- Private Sub Form_Load() Set clsSF = New cSFolders ' -- Configurar controles With ListView1 .View = lvwIcon .ColumnHeaders.Add , , "Carpeta", 4000 .Arrange = lvwAutoLeft End With With Command1 .Item(0).Caption = "Usuario actual" .Item(1).Caption = "Todos" .Item(2).Caption = "Otras" .Item(3).Caption = "íconos chicos" .Item(4).Caption = "íconos grandes" End With End Sub ' \\ -- Cargar Private Sub LoadListView(pCol As Collection) Dim xPath As Variant Dim xLvItem As ListItem ' -- Quitar el enlace de los controles Set ListView1.Icons = Nothing Set ListView1.SmallIcons = Nothing ' -- Eliminar elementos de los controles ( Lv y lista de imágenes ) ImageList1.ListImages.Clear ImageList2.ListImages.Clear ListView1.ListItems.Clear ' -- Recorrer colección y agregar los items al listview y al imagelist With clsSF For Each xPath In pCol Set xLvItem = ListView1.ListItems.Add(, xPath, .GetFolderName(xPath)) ' -- recuperar el ícono y agregarlo ImageList1.ListImages.Add , , .LoadIcon(eSmallIcon, xPath) ImageList2.ListImages.Add , , .LoadIcon(eLargeIcon, xPath) ' -- Enlazar imágenes al listview If ListView1.SmallIcons Is Nothing Or ListView1.Icons Is Nothing Then Set ListView1.SmallIcons = ImageList1 Set ListView1.Icons = ImageList2 End If ' -- Asignar el ícono xLvItem.SmallIcon = ImageList1.ListImages.Count xLvItem.Icon = ImageList2.ListImages.Count Next End With End Sub Private Sub Form_Unload(Cancel As Integer) Set clsSF = Nothing End Sub ' ------------------------------------------------------------------------------------ ' \\ -- Mostrar la ruta en la barra de titulo ' ------------------------------------------------------------------------------------ Private Sub ListView1_ItemClick(ByVal Item As ComctlLib.ListItem) Me.Caption = Item.Key End Sub

Enlaces relacionados

Acceder a elementos del shell y visualizarlos en forma de árbol.

Ejemplo del sitio web Visual basic Accelerator, que muestra como acceder a los elementos del shell o sistema usando la referencia a Microsoft Shell controls and Automation, cargando los items en un control Treeview en forma jerárquica.

Ver ejemplo

Paths del sistema

Ejemplo para recuperar los paths del sistema usando las funciones del api de windows SHGetSpecialFolderLocation y SHGetPathFromIDList

Ver ejemplo

Buscar en Recursos vb