Thursday, December 15, 2011

Description: Explores the directory structure, returns basic file information
Minimum requirements: VB5 Pro or Any Version of VB u have just u need to know ur Controls and how tot use it.
Download: source code
Screenshot:
Directory Browser (8 KB)
Project: Standard EXE
ActiveX Controls/Objects: comctl32.ocx
Controls: File1 (FileListBox), Dir1 (DirListBox), Drive1 (DriveListBox), _
   lvw (ListView), iml (ImageList)
Code:
Option Explicit

Private Sub Form_Load()
    GetFiles ""
End Sub

Private Sub GetFiles(ByVal sPath As String)
    Dim i As Integer
    Dim r As Integer
    Dim li As ListItem
    Dim fp As String
   
    On Error GoTo errLocal
    lvw.ListItems.Clear
    If sPath <> "" Then
        If InStr(sPath, "[") <> 0 Then sPath = Trim(Left(sPath, InStr(sPath, "[") - 1))
        If Right(sPath, 1) = ":" Then sPath = sPath & "\" Else r = 1
        Me.Caption = sPath
        Dir1.Path = sPath
        Dir1.Refresh
        fp = Left(sPath, InStrRev(sPath, "\") - 1)
        If InStr(fp, "\") = 0 Then fp = ""
        lvw.ListItems.Add , fp, ". .", 2, 2
        For i = 0 To Dir1.ListCount - 1
            lvw.ListItems.Add , Dir1.List(i), Mid(Dir1.List(i), Len(Dir1.Path) + 1 + r), 2, 2
        Next
        File1.Path = sPath
        File1.Refresh
        For i = 0 To File1.ListCount - 1
            fp = sPath & "\" & File1.List(i)
            fp = Replace(fp, "\\", "\")
            Set li = lvw.ListItems.Add(, fp, File1.List(i), 3, 3)
            li.SubItems(1) = FileLen(fp)
            li.SubItems(2) = FileDateTime(fp)
        Next
    End If
errBack:
    For i = 0 To Drive1.ListCount - 1
        lvw.ListItems.Add , Drive1.List(i), Drive1.List(i), 1, 1
    Next
    Exit Sub
errLocal:
    MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Error"
    GoTo errBack
End Sub

Private Sub Form_Resize()
    lvw.Width = Me.Width - 120
    lvw.Height = Me.Height - 400
End Sub

Private Sub lvw_DblClick()
    If lvw.SelectedItem.Icon <> 3 Then
        GetFiles lvw.SelectedItem.Key
    Else
        MsgBox lvw.SelectedItem.Key
    End If
End Sub

No comments: