Trucos Seleccionar un ordenador o un recurso compartido

Podemos usar la función del API SHBrowseForFolder para selecionar uno de los ordenadores o recursos compartidos de nuestra red.

Para ello declaramos :

Private Const ERROR_SUCCESS As Long = 0
Private Const MAX_PATH As Long = 260
Private Const CSIDL_NETWORK As Long = &H12
Private Const BIF_RETURNONLYFSDIRS As Long = &H1
Private Const BIF_BROWSEFORCOMPUTER As Long = &H1000

Private Type BROWSEINFO 'BI
   hOwner As Long
   pidlRoot As Long
   pszDisplayName As String
   lpszTitle As String
   ulFlags As Long
   lpfn As Long
   lParam As Long
   iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib "shell32.dll" _
   Alias "SHGetPathFromIDListA" _
  (ByVal pidl As Long, _
   ByVal pszPath As String) As Long

Private Declare Function SHBrowseForFolder Lib "shell32.dll" _
   Alias "SHBrowseForFolderA" _
  (lpBrowseInfo As BROWSEINFO) As Long

Private Declare Function SHGetSpecialFolderLocation _
   Lib "shell32.dll" _
  (ByVal hwndOwner As Long, _
   ByVal nFolder As Long, _
   pidl As Long) As Long

Emplearemos esta función auxiliar para tratar las cadenas devueltas por el API :

Function AsciiZ(texto As String) As String
'esta función se utiliza para devolver la parte del string
'hasta el primer chr(0). Las funciones del API suelen emplear
'un chr(0) para marcar el final de las cadenas de texto
Dim i As Long
i = InStr(texto, Chr(0))
If i = 0 Then
    AsciiZ = texto
Else
    AsciiZ = Left(texto, i - 1)
End If
End Function

Y luego esta función nos devolverá un nombre de máquina o de recurso compartido en notación UNC (\\NombreOrdenador\NombreRecurso) :

Private Function BrowseForShares() As String

  'mostrar sólo ordenadores y recursos compartidos
   Dim BI As BROWSEINFO
   Dim pidl As Long
   Dim sPath As String
   Dim pos As Integer

  'obtener el pidl de la carpeta 'Entorno de red'
   If SHGetSpecialFolderLocation(Me.hWnd, CSIDL_NETWORK, pidl) = ERROR_SUCCESS Then
     'rellenar la estructura limitando a ordenadores especificando
     'el pidl devuelto como pidl raíz
      With BI
         .hOwner = Me.hWnd
         .pidlRoot = pidl
         .pszDisplayName = Space$(MAX_PATH)
         .lpszTitle = "Seleccione un ordenador o un recurso compartido :"
         .ulFlags = BIF_RETURNONLYFSDIRS
      End With
     'mostrar el diálogo de búsqueda
      pidl = SHBrowseForFolder(BI)
      If pidl <> 0 Then
        'comprobar que es un pidl válido
         sPath = Space$(MAX_PATH)
         If SHGetPathFromIDList(ByVal pidl, ByVal sPath) Then
           'es válido, se trata de un recurso compartido
            BrowseForShares = AsciiZ(sPath)
         Else
            'se ha seleccionado un ordenador
             BrowseForShares = "\\" & AsciiZ(BI.pszDisplayName)
         End If
      End If
   End If
End Function



Trucos Trucos

Visual Basic Página de Visual Basic

Página principal Página principal

www.jrubi.com