Explorar carpetas y archivos con WebBrowser

[JBB]

Empece haciendo un explorador con listview y al final después de bastantes días de lucha, conseguí todas las funciones del explorer de windows menos mostrar imágenes en miniatura.

Todo el tiempo a la basura y empece con el WebBrowser.

Lo malo es que no encuentro como hacer que se muestren las imágenes en miniatura, iconos o detalles con código.

Con el ratón se pueden seleccionar pero al presionar para abrir una carpeta, vuelve a dejarlo todo en iconos.

A de ser con vb6

He dedicado unos cuantos días buscando por google y no he sido capaz de encontrar otra cosa que los típicos botones de navegación en modo web.

Gracias por todo lo que me podáis aportar para poder terminar este proyecto que me vuelve loco.

[LeandroA]

Hola, bienvenido al foro, con respecto al webbrowser puede que en algun momento encuentres sus contras pero bien es bueno tropezar con ellas.

bueno te cuento para cambiar las vista, cualquiera de estas lineas
WebBrowser1.Document.CurrentViewMode = 5  'Vista en miniatura
WebBrowser1.Document.CurrentViewMode = 6  'Vista en Mosicos
WebBrowser1.Document.CurrentViewMode = 1  'Vista en Iconos
WebBrowser1.Document.CurrentViewMode = 3  'Vista en Detalles
WebBrowser1.Document.CurrentViewMode = 4  'Vista en Lista

Con el ratón se pueden seleccionar pero al presionar para abrir una carpeta, vuelve a dejarlo todo en iconos.

eso no entendi, que es lo que quieres decir

[LeandroA]

Hola te tiro un tip para conocer todos las propiedades referidas al parte de explorer de webbrowser, agrega la libreria  "Microsoft Shell Controls and Automation" para eso te vas al menu Proyecto > Referencias y selecionas   "Microsoft Shell Controls and Automation"

dentro del proyecto en el formulario declaras

Código: [Seleccionar]

Dim WithEvents LocalBrowser As ShellFolderView
y bien despues si pones
Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    Set LocalBrowser = WebBrowser1.Document
End Sub

vas a tener mas eventos. pero lo bueno es que podes conocer todas las propiedades a medida que escrivis en el ide

por ejemplo cuando pones LocalBrowser. te saltan todas las propiedades


con respecto a lo que preguntas

1:

Código: [Seleccionar]

WebBrowser1.Document.SortColumns = "prop:-System.ItemTypeText;-System.ItemNameDisplay;"   'Ordena por nombre Desendente
WebBrowser1.Document.SortColumns = "prop:System.ItemTypeText;System.ItemNameDisplay;"  'Ordena por nombre ascendente
para la fecha

Código: [Seleccionar]

prop:System.DateModified;
prop:-System.DateModified;
para el tipo

Código: [Seleccionar]

prop:System.ItemTypeText;System.ItemNameDisplay;
prop:-System.ItemTypeText;-System.ItemNameDisplay;
para el tamaño

Código: [Seleccionar]

prop:-System.Size;
prop:System.Size;
y bueno después hay mas según como la columnas que muestren pero como te dije eso lo averiguas con un simple debug.print  WebBrowser1.Document.SortColumns


2:
yo alguna vez lo solucione asi

Código: [Seleccionar]

    WebBrowser1.SetFocus
    SendKeys "{DEL}"con eso eliminio el item/s selecionado/s, asi que si podes hacer lo mismo con los demas comando SendKeys "{F5}" etc.


4:
es raro si yo tiro una carpeta o lo que arrastres se actualiza solo, no se si entiendo bien la pregunta.

y lo de tropezar es porque el webbrowser tiene sus pro contras, ocupa memoria, compatibilidad según la vercion de IE instalada, no se puede navegar por algunas carpetas como Mi PC, pero bueno es la opicion mas parecida al explorador de windows, yo creo que depende tu proyecto o para que lo quieras utilizar puede ser util

Saludos.

[LeandroA]

No se bien cual pueda ser el motivo, pueden ser muchas razones, abria que ver mas en detalle, pero no da para reinstalar el visual o formatear  , algunos errores te pueden aparecer solo en el ide, una vez compilado no aparecen mas, pero por lo general es un error nro (-1)

Saludos.

[LeandroA]

 Ordena por nombre

Código: [Seleccionar]

Private Sub Command1_Click()
    WebBrowser1.Document.SortColumns = "prop:-System.ItemTypeText;-System.ItemNameDisplay;" 
End Sub

Private Sub Command2_Click()
    WebBrowser1.Document.SortColumns = "prop:System.ItemTypeText;System.ItemNameDisplay;"
End Sub

O Ordena por fecha

Código: [Seleccionar]

Private Sub Command1_Click()
    WebBrowser1.Document.SortColumns = "prop:System.DateModified;"   
End Sub

Private Sub Command2_Click()
    WebBrowser1.Document.SortColumns = "-System.DateModified;"
End Sub



por lo de el  BAKSPACE, no te compliques usa  WebBrowser1.GoBack

[JBB]

Hola Leandro.
La verdad es que ando mas que loco buscando resolver este tema y aun no tengo nada claro como hacerlo de manera que voy de cabeza y probando todas las combinaciones que encuentro por todas partes.

Hace 1 año me pasaste detalles de como poner el WB en modo de vistas y me funciona pero el tema de sortear por fecha, etc. no me aparece la forma de sacar SortColumns

Lo hago como tu me dijiste:
Añado la referencia desde la biblioteca, tal cual me indicas y luego:
Option Explicit
Dim WithEvents LocalBrowser As ShellFolderView

Private Sub Form_Load()
WebBrowser1.Navigate App.Path
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
Set LocalBrowser = WebBrowser1.Document
     LocalBrowser.CurrentViewMode = 4
     'LocalBrowser.SortColumns = "prop:-System.ItemTypeText;-System.ItemNameDisplay;"
End Sub

Y en LocalBrowser.SortColumns me salta ERROR.

Me puedes pasar un Form que funcione el sortear
Te pido el Form ya que he podido comprobar por desgracia y sin poder solucionarlo, que he descargado ejemplos de otras cosas en que todo funciona bien y cuando creo un nuevo proyecto y pego el código del ejemplo con todas sus referencias etc., ya no funciona bien, me explico mejor con el caso mas reciente y que de primeras es muy simple.
No te molestes en probarlo ya que es cosa de brujas o que los chinos dejan dentro del ordenador un chinito para que lo fastidie.

----------------------------------------------------------------
Ejemplo 1 funcionando en el form original
Option Explicit
Dim Item As ListItem '''' LV

Private Sub Lv1_DblClick()
 Set Item = Lv1.SelectedItem
    ShellExecute 0&, vbNullString, Item.Tag, vbNullString, vbNullString, vbNormalFocus
End Sub
----------------------------------------------------------------
Ejemplo 2 funcionando en el form original
Option Explicit
Dim itmx As ListItem '''' LV

Private Sub Lv1_DblClick()
 Set itmx = Lv1.SelectedItem
    ShellExecute 0&, vbNullString, Item.Tag, vbNullString, vbNullString, vbNormalFocus
End Sub
----------------------------------------------------------------
Ejemplo 3 YA NO FUNCIONA BIEN
Creo un nuevo Form y añado todo esto:
Option Explicit
Dim Item As ListItem '''' LV
Dim itmx As ListItem '''' LV

Private Sub Lv1_DblClick()
 Set Item = Lv1.SelectedItem
    ShellExecute 0&, vbNullString, Item.Tag, vbNullString, vbNullString, vbNormalFocus
End Sub

Private Sub Lv2_DblClick()
 Set itmx = Lv2.SelectedItem
    ShellExecute 0&, vbNullString, itmx.Tag, vbNullString, vbNullString, vbNormalFocus
End Sub

De locos.
----------------------------------------------------------------
----------------------------------------------------------------

Con ListView lo tengo todo controlado menos el tema de Ctrl+z y no me saca vistas en miniatura

Y es por eso por que me decanto por el WebBrowser si no me salen mas problemas claro, que siempre sale algo nuevo que me lo tira todo a la basura y ya son mas de 12 meses los que llevo detrás de esto.

Muchísimas gracias por aguantar toda esta locura.

[LeandroA]

hola, te pongo lo del webbrowser

Código: (Vb) [Seleccionar]

Option Explicit
    'Dim WithEvents LocalBrowser As ShellFolderView

Private Sub Command1_Click()
    WebBrowser1.Document.SortColumns = "prop:System.ItemNameDisplay;" 'ORDENA POR NOMBRE ASENDENTE
End Sub

Private Sub Command2_Click()
    WebBrowser1.Document.SortColumns = "prop:System.DateModified" 'ORDENA POR FECHA DE MODIFICACION ASENDENTE
End Sub

Private Sub Command3_Click()
  WebBrowser1.Document.SortColumns = "prop:System.ItemTypeText;-System.ItemNameDisplay;" 'ORDENA POR TIPO ASENDENTE
End Sub

Private Sub Command4_Click()
    WebBrowser1.Document.SortColumns = "prop:System.Size;" 'ORDENA POR TAMAÑO ASENDENTE
End Sub

Private Sub Form_Load()
    WebBrowser1.Navigate App.Path
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
    'Set LocalBrowser = WebBrowser1.Document
     WebBrowser1.Document.CurrentViewMode = 4 'DETALLES
End Sub
Puede que en el ide te de error, pero con el ejecutable compilado no. estas poniendo mal tu codigo al llamar LocalBrowser.SortColumns =   tienes que usar WebBrowser1.Document.SortColumns =

[LeandroA]

para obtener la vista en miniatura yo utlizo este codigo, primero tenes que descargarte la libreria IVBExtractImageLib.tlb  si la googleas seguro la encontras  (sino yo la use en este proyeto fijate en la carpeta cliente)

depues con este codigo

Código: (vb) [Seleccionar]

Option Explicit
Private Type PicBmp
    SIZE As Long
    Type As Long
    hBMP As Long
    hpal As Long
    Reserved As Long
End Type
Private Const MAX_PATH                  As Long = 260
Private Declare Function OleCreatePictureIndirect Lib "olepro32.dll" (PicDesc As PicBmp, RefIID As UUID, ByVal fPictureOwnsHandle As Long, IPic As IPicture) As Long
Private Declare Function SHGetDesktopFolder Lib "shell32.dll" (ppshf As IVBShellFolder) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)



Public Function GetThumbNail(ByRef sFilePath As String, ByVal lWidth As Long, ByVal lHeight As Long) As StdPicture
   
    On Error Resume Next
   
    Dim Folder          As IVBShellFolder
    Dim Item            As IVBShellFolder
    Dim ExtractImage    As IExtractImage
    Dim idEnum          As IVBEnumIDList
    Dim iidShellFolder  As UUID
    Dim iiDispatch      As UUID
    Dim iidExtractImage As UUID
    Dim tSize           As SIZE
    Dim lpPic           As PicBmp
    Dim sRet            As String
    Dim sPath           As String
    Dim sFileName       As String
    Dim sName           As String
    Dim pidlMain        As Long
    Dim pidl            As Long
    Dim hRes            As Long
   
    sPath = Left$(sFilePath, InStrRev(sFilePath, "\"))
   
    sFileName = UCase$(Mid$(sFilePath, Len(sPath) + 1))

    Call SHGetDesktopFolder(Folder)

    Folder.ParseDisplayName 0&, 0&, sPath, 0&, pidlMain, 0&
   
    IIDFromString "{000214E6-0000-0000-C000-000000000046}", iidShellFolder

    Folder.BindToObject pidlMain, 0&, iidShellFolder, Item

    If pidlMain Then CoTaskMemFree pidlMain
     
    Item.EnumObjects 0&, SHCONTF_FOLDERS Or SHCONTF_NONFOLDERS Or SHCONTF_INCLUDEHIDDEN, idEnum
     
    Do While idEnum.Next(1, pidl, 0&) = 0

        sPath = PathFromPidl(pidl)
       
        sName = UCase$(Right$(sPath, Len(sPath) - InStrRev(sPath, "\")))

        If (sName = sFileName) Then
       
            IIDFromString "{BB2E617C-0920-11d1-9A0B-00C04FC2D6C1}", iidExtractImage
           
            Item.GetUIObjectOf 0&, 1&, pidl, iidExtractImage, 0&, ExtractImage
           
            CoTaskMemFree pidl
           
            If ExtractImage Is Nothing Then Exit Function
           
            sRet = String$(MAX_PATH, 0)
           
            tSize.cx = lWidth
            tSize.cy = lHeight
           
            ExtractImage.GetLocation sRet, MAX_PATH, 0&, tSize, 32, IEIFLAG_NOBORDER Or IEIFLAG_SCREEN Or IEIFLAG_OFFLINE
           
            IIDFromString "{00020400-0000-0000-C000-000000000046}", iiDispatch
           
            If Err.Number Then Err.Clear

            With lpPic
                .SIZE = Len(lpPic)
                .Type = vbPicTypeBitmap
                ExtractImage.Extract .hBMP
                If .hBMP = 0 Then Exit Function
            End With

   
            If Err.Number Then
                Err.Clear
                Exit Function
            End If
           
            OleCreatePictureIndirect lpPic, iiDispatch, 1, GetThumbNail
         
            Exit Do
        Else
            If pidl Then CoTaskMemFree pidl
        End If

    Loop
   
End Function

Public Function PathFromPidl(ByVal pidl As Long) As String
   Dim sPath As String * MAX_PATH
   If SHGetPathFromIDList(pidl, sPath) Then
      PathFromPidl = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
   End If
End Function
un ejemplo de uso mostrando una vista previa en un formulario (cambia la ruta del archivo por uno que tenga vista miniatura )

Código: (vb) [Seleccionar]

Private Sub Form_Load()
    Me.Picture = GetThumbNail("C:\Users\Windows\Desktop\666013f5b0158e4feab3c7d8b2fcd34a.pdf", 100, 100)
End Subsi no retorna ninguna imagen es porque no hay vista en miniatura ahi tendrías que mostrar su icono.

[JBB]

Hola Leandro.
De verdad que te agradezco mucho tu ayuda pero no hay manera de que me funcione.

Quiero pedirte el favor de que me pases un Formulario en un ZIP o RAR con algo tal simple como esto:
Option Explicit
Dim WithEvents LocalBrowser As ShellFolderView

Private Sub Form_Load()
WebBrowser1.Navigate App.Path
End Sub

Private Sub WebBrowser1_DocumentComplete(ByVal pDisp As Object, URL As Variant)
     WebBrowser1.CurrentViewMode = 4
     WebBrowser1.Document.SortColumns = "prop:System.DateModified" 'ORDENA POR FECHA DE MODIFICACION ASENDENTE
End Sub

No necesito que pongas nada mas, solo que funcione.

GRACIAS