Ejemplos usando el Api de windows para Visual basic

28 - Cuadro de diálogo descargar archivo de internet y Buscar carpeta

Actualizado

Este es el mismo proyecto para desplegar el cuadro de selección de directorio mediante la función del Api SHBrowseForFolder, pero usando un módulo de clase

Descargar

Código fuente para el cuadro de diálogo Buscar y Seleccionar Carpeta de Windows - Api SHBrowseForFolder

Vista del cuadro de diálogo para buscar carpeta

Vista previa del cuadro de diálogo para Seleccionar carpeta de Windows mediante el Api SHBrowseForFolder

El Api para llamar a este cuadro de diálogo es: SHBrowseForFolder, aunque también se utilizan otras como: SHGetPathFromIDList, lstrcat y CoTaskMemFree

Esta tiene una estructura llamada BrowseInfo que devemos llenar antes para pasarle a la función SHBrowseForFolder.

A hWndOwner le debemos enviar el hWnd del formulario que llama al cuadro de diálogo, ya que si no se indica este parámetro de la estructura, el mismo contendrá el valor 0, y esto hará que el diálogo para buscar carpeta se visualice en forma No modal. Por eso para poder visualizarlo en forma Modal, hay que indicar el Handle del formulario o ventana que hace la llamada a SHBrowseForFolder

lpszTitle se utiliza para especificar el titulo o leyenda del cuadro de diálogo.

Código fuente en un formulario con un control Command1

' Estructura BrowseInfo requerida para el Api SHBrowseForFolder Private Type BrowseInfo hWndOwner As Long pIDLRoot As Long pszDisplayName As Long lpszTitle As Long ulFlags As Long lpfnCallback As Long lParam As Long iImage As Long End Type ' Constantes Const BIF_RETURNONLYFSDIRS = 1 Const MAX_PATH = 260 ' Para Buffer de caracteres del path ' Funcion Api CoTaskMemFree Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal hMem As Long) ' Funcion Api CoTaskMemFree lstrcat Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" ( _ ByVal lpString1 As String, _ ByVal lpString2 As String) As Long ' Funcion Api SHBrowseForFolder Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long ' Funcion Api SHGetPathFromIDList Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList _ As Long, ByVal lpBuffer As String) As Long Private Sub Command1_Click() Dim Nulo As Integer Dim Id_List As Long Dim El_Path As String Dim t_Explorar_dir As BrowseInfo With t_Explorar_dir 'Pasamos el hwnd de nuestro form .hWndOwner = Me.hWnd 'Establecemos la leyenda del cuadro y Retorna la dirección de memoria .lpszTitle = lstrcat("C:\", "") 'Retornar solo si el usuario selecciona un dir .ulFlags = BIF_RETURNONLYFSDIRS End With 'Mostrar el cuadro de dialogo Buscar carpeta Id_List = SHBrowseForFolder(t_Explorar_dir) If Id_List Then El_Path = String$(MAX_PATH, 0) 'Llamamos a la APi y recuperamos el id del path y en _ El_Path obtenemos el path seleccionado Call SHGetPathFromIDList(Id_List, El_Path) 'Liberamos el bloque de memoria Call CoTaskMemFree(Id_List) 'Busca la posición del primer caracter nulo Nulo = InStr(El_Path, vbNullChar) If Nulo Then 'Formateamos la cadena anterior eliminado los espacios nulos del path El_Path = Left$(El_Path, Nulo - 1) End If End If 'Mostramos el Path elegido MsgBox " El directorio seleccionado es: " & El_Path, vbInformation End Sub Private Sub Form_Load() Command1.Caption = " Buscar y Seleccionar Carpeta de Windows " End Sub

Nota : para poder visualizar el botón "Crear nueva carpeta" ubicado en la parte inferior , se puede indicar en la opción flags de la estructura de datos BrowseInfo

Descargar proyecto de ejemplo

Mostrar el diálogo en un path concreto

A la función BrowseForFolder, pasarle el path inicial, por ejemplo :

Retorno = BrowseForFolder ("c:\windows")

1 - Agregar un Command1

Código fuente en un formulario

Option Explicit Public Function BrowseForFolder(PathInicial As String) As String Dim Browse_for_folder As BROWSEINFOTYPE Dim itemID As Long Dim selectedPathPointer As Long Dim tmpPath As String * 256 Dim CheckPath As String CheckPath = PathInicial If Len(CheckPath) > 0 Then If Not Right$(CheckPath, 1) <> "\" Then CheckPath = Left$(CheckPath, Len(CheckPath) - 1) End If End If PathInicial = CheckPath With Browse_for_folder .hOwner = Me.hWnd ' título del diálogo .lpszTitle = "Titulo" ' CallBack Function .lpfn = FunctionPointer(AddressOf BrowseCallbackProcStr) selectedPathPointer = LocalAlloc(LPTR, Len(PathInicial) + 1) CopyMemory ByVal selectedPathPointer, ByVal PathInicial, Len(PathInicial) + 1 .lParam = selectedPathPointer End With itemID = SHBrowseForFolder(Browse_for_folder) If itemID Then If SHGetPathFromIDList(itemID, tmpPath) Then BrowseForFolder = Left$(tmpPath, InStr(tmpPath, vbNullChar) - 1) End If Call CoTaskMemFree(itemID) End If Call LocalFree(selectedPathPointer) End Function Private Sub Command1_Click() Dim ret As String ret = BrowseForFolder("c:\windows") If ret = "" Then MsgBox " No se seleccionó ninguna carpeta !", vbInformation Else MsgBox "Carpeta seleccionada: " & ret, vbInformation End If End Sub

Código fuente en un módulo

Option Explicit Public Type BROWSEINFOTYPE 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 Public Declare Function SHBrowseForFolder Lib "shell32.dll" Alias _ "SHBrowseForFolderA" ( _ lpBROWSEINFOTYPE As BROWSEINFOTYPE) As Long Public Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias _ "SHGetPathFromIDListA" ( _ ByVal pidl As Long, _ ByVal pszPath As String) As Long Public Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long) Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" ( _ ByVal hWnd As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ lParam As Any) As Long Public Declare Sub CopyMemory Lib "kernel32" Alias _ "RtlMoveMemory" ( _ pDest As Any, _ pSource As Any, _ ByVal dwLength As Long) Public Const WM_USER = &H400 Public Const BFFM_SETSELECTIONA As Long = (WM_USER + 102) Public Const BFFM_SETSELECTIONW As Long = (WM_USER + 103) Public Declare Function LocalAlloc Lib "kernel32" ( _ ByVal uFlags As Long, _ ByVal uBytes As Long) As Long Public Declare Function LocalFree Lib "kernel32" ( _ ByVal hMem As Long) As Long Public Const LPTR = (&H0 Or &H40) Public Function BrowseCallbackProcStr(ByVal hWnd As Long, _ ByVal uMsg As Long, _ ByVal lParam As Long, _ ByVal lpData As Long) As Long If uMsg = 1 Then Call SendMessage(hWnd, BFFM_SETSELECTIONA, True, ByVal lpData) End If End Function Public Function FunctionPointer(FunctionAddress As Long) As Long FunctionPointer = FunctionAddress End Function

Cuadro de diálogo de windows descargar archivo

Este cuadro de diálogo de windows para descargar un archivo de internet se llama mediante la función DoFileDownload, en la cual el único parámetro que le debemos pasar es un string con la Url del fichero para que se abra el cuadro de diálogo anterior, y automaticamente luego se abra el cuadro de diálogo Guardar como de Windows.

Antes de enviar la cadena, es decir la url, devemos convertirla a o codificarla a Unicode, mediante la función StrConv de Visual Basic con la constante vbUnicode

Vista del cuadro de diálogo para descargar archivo de internet

Vista previa del cuadro de diálogo de windows para descargar archivo de internet.

Código fuente en un formulario

'Función Api para abrir el cuadro de diálogo Descargar archivo Url Private Declare Function DoFileDownload Lib "shdocvw.dll" _ (ByVal lpszFile As String) As Long Private Sub Command1_Click() ' A la función Api solo devemos enviarle la dirección url DoFileDownload StrConv("http://www.yahoo.com", vbUnicode) End Sub

Nota: En esta página hay una función que permite también descargar un fichero desde una url, pero sin abrir el cuadro de diálogo : Función URLDownloadToFile

vb 6.0 - Enlaces relacionados

vb.net - Enlaces relacionados

Control FolderBrowserDialog

Buscar en Recursos vb