Explore.frm

 VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form frmExplore
   Caption         =   "File Explorer"
   ClientHeight    =   7935
   ClientLeft      =   1770
   ClientTop       =   1950
   ClientWidth     =   11385
   ClipControls    =   0   'False
   Icon            =   "Explore.frx":0000
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   7935
   ScaleWidth      =   11385
   StartUpPosition =   2  'CenterScreen
   WhatsThisHelp   =   -1  'True
   Begin VB.PictureBox picSplitter
      BackColor       =   &H00808080&
      BorderStyle     =   0  'None
      FillColor       =   &H00808080&
      Height          =   5175
      Left            =   9870
      ScaleHeight     =   2253.417
      ScaleMode       =   0  'User
      ScaleWidth      =   312
      TabIndex        =   5
      Top             =   390
      Visible         =   0   'False
      Width           =   30
   End
   Begin MSComctlLib.ImageList ilSmall
      Left            =   3330
      Top             =   1800
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
         NumListImages   =   2
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
            Picture         =   "Explore.frx":058A
            Key             =   "genericSmall"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
            Picture         =   "Explore.frx":06E4
            Key             =   "fldrClosed"
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.ImageList ilMain
      Left            =   3330
      Top             =   1080
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   16
      ImageHeight     =   16
      MaskColor       =   16711935
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
         NumListImages   =   7
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
            Picture         =   "Explore.frx":0C7E
            Key             =   "fldrClosed"
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
            Picture         =   "Explore.frx":1218
            Key             =   "fldrOpen"
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
            Picture         =   "Explore.frx":17B2
            Key             =   "drive"
         EndProperty
         BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
            Picture         =   "Explore.frx":1D4C
            Key             =   "explorer"
         EndProperty
         BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
            Picture         =   "Explore.frx":22E6
            Key             =   "genericLarge"
         EndProperty
         BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
            Picture         =   "Explore.frx":2980
            Key             =   "genericMedium"
         EndProperty
         BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
            Picture         =   "Explore.frx":2C9A
            Key             =   "genericSmall"
         EndProperty
      EndProperty
   End
   Begin MSComctlLib.ListView lvListView
      Height          =   5175
      Left            =   3210
      TabIndex        =   3
      Top             =   390
      Width           =   6495
      _ExtentX        =   11456
      _ExtentY        =   9128
      View            =   3
      LabelEdit       =   1
      Sorted          =   -1  'True
      MultiSelect     =   -1  'True
      LabelWrap       =   -1  'True
      HideSelection   =   -1  'True
      _Version        =   393217
      Icons           =   "ilMain"
      SmallIcons      =   "ilSmall"
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      BorderStyle     =   1
      Appearance      =   1
      NumItems        =   4
      BeginProperty ColumnHeader(1) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         Key             =   "name"
         Text            =   "Name"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(2) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         Alignment       =   1
         SubItemIndex    =   1
         Key             =   "size"
         Text            =   "Size"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(3) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         SubItemIndex    =   2
         Key             =   "type"
         Text            =   "Type"
         Object.Width           =   2540
      EndProperty
      BeginProperty ColumnHeader(4) {BDD1F052-858B-11D1-B16A-00C0F0283628}
         SubItemIndex    =   3
         Key             =   "modified"
         Text            =   "Modified"
         Object.Width           =   2540
      EndProperty
   End
   Begin MSComctlLib.TreeView tvTreeView
      Height          =   5160
      Left            =   30
      TabIndex        =   0
      Top             =   390
      Width           =   3120
      _ExtentX        =   5503
      _ExtentY        =   9102
      _Version        =   393217
      Indentation     =   529
      LabelEdit       =   1
      LineStyle       =   1
      Sorted          =   -1  'True
      Style           =   7
      ImageList       =   "ilMain"
      BorderStyle     =   1
      Appearance      =   1
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin MSComctlLib.StatusBar sbStatusBar
      Align           =   2  'Align Bottom
      Height          =   285
      Left            =   0
      TabIndex        =   1
      Top             =   7650
      Width           =   11385
      _ExtentX        =   20082
      _ExtentY        =   503
      _Version        =   393216
      BeginProperty Panels {8E3867A5-8586-11D1-B16A-00C0F0283628}
         NumPanels       =   3
         BeginProperty Panel1 {8E3867AB-8586-11D1-B16A-00C0F0283628}
            AutoSize        =   1
            Object.Width           =   15364
            MinWidth        =   2558
         EndProperty
         BeginProperty Panel2 {8E3867AB-8586-11D1-B16A-00C0F0283628}
            Style           =   5
            AutoSize        =   2
            Object.Width           =   1588
            MinWidth        =   1587
            TextSave        =   "9:50 AM"
         EndProperty
         BeginProperty Panel3 {8E3867AB-8586-11D1-B16A-00C0F0283628}
            Style           =   6
            AutoSize        =   2
            TextSave        =   "1/16/2005"
         EndProperty
      EndProperty
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
   End
   Begin VB.Image imgSplitter
      Height          =   5160
      Left            =   3120
      MousePointer    =   9  'Size W E
      Top             =   390
      Width           =   150
   End
   Begin VB.Label lblPath
      Caption         =   "File info"
      Height          =   195
      Left            =   3225
      TabIndex        =   4
      Top             =   150
      Width           =   6465
   End
   Begin VB.Line lnLine1
      BorderColor     =   &H00808080&
      X1              =   60
      X2              =   9900
      Y1              =   15
      Y2              =   15
   End
   Begin VB.Label Label1
      Caption         =   "Folders"
      Height          =   195
      Left            =   60
      TabIndex        =   2
      Top             =   150
      Width           =   3060
   End
   Begin VB.Line lnLine2
      BorderColor     =   &H00FFFFFF&
      BorderWidth     =   2
      X1              =   60
      X2              =   9900
      Y1              =   30
      Y2              =   30
   End
   Begin VB.Menu mnu_File
      Caption         =   "&File"
      Begin VB.Menu mnu_FileExit
         Caption         =   "E&xit"
      End
   End
End
Attribute VB_Name = "frmExplore"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False


Option Explicit

Private mIsMoving As Boolean ' Is splitter in motion?
Const mSplitLimit = 2000 ' Minimum width for TreeView and ListView

Private Sub Form_Load()
    Dim currFldr As Folder
    Dim drv As Drive
    Dim fldr As Folder
    Dim nodRoot As Node

    Dim fso As Scripting.FileSystemObject
    Set fso = New FileSystemObject

    ' Set column widths
    With lvListView
        .ColumnHeaders(1).Width = 2790
        .ColumnHeaders(2).Width = 1080
        .ColumnHeaders(3).Width = 2880
        .ColumnHeaders(4).Width = 1080
    End With

    ' Populate level 1 of the TreeView
    DoHourglass True
    For Each drv In fso.Drives
        ' Proceed only if the drive is ready.
        ' This ignores an empty CD drive, for example.
        If drv.IsReady Then
            Set nodRoot = tvTreeView.Nodes.Add(, , drv.RootFolder.Path, drv.DriveLetter & ":")
            With nodRoot
                .Image = "drive"
                .Sorted = True
            End With

            ' Get a pointer to the root folder
            Set currFldr = drv.RootFolder

            ' Populate level 2 of the TreeView
            For Each fldr In currFldr.SubFolders
                AddTVNode nodRoot, drv.DriveLetter & fldr.Name, fldr.Name
            Next
        End If
    Next

    ' Set up the first node
    Set nodRoot = tvTreeView.Nodes(1)
    With nodRoot
        .EnsureVisible
        .Selected = True
        .Expanded = True
        lblPath.Caption = .FullPath
    End With
    tvTreeView_NodeClick nodRoot

    DoHourglass False
    DoEvents
End Sub

Private Sub Form_Resize()
    If Me.Width < 3000 Then Me.Width = 3000

    Dim formWidth As Long
    formWidth = Me.ScaleWidth

    lnLine1.X2 = formWidth - 60
    lnLine2.X2 = formWidth - 60

    tvTreeView.Height = Me.ScaleHeight - tvTreeView.Top - sbStatusBar.Height - 20

    With lvListView
        .Width = formWidth - tvTreeView.Width - 120
        .Height = tvTreeView.Height
    End With

    With imgSplitter
        .Top = tvTreeView.Top + 30
        .Height = tvTreeView.Height - 60
        SizeControls .Left
    End With
End Sub

Private Sub imgSplitter_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    ' Use the PictureBox as a marker for the new split location
    With imgSplitter
        picSplitter.Move .Left, .Top, .Width \ 4, .Height - 20
    End With
    picSplitter.Visible = True
    mIsMoving = True
End Sub

Private Sub imgSplitter_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim sglPos As Single

    If mIsMoving Then
        sglPos = X + imgSplitter.Left
        If sglPos < mSplitLimit Then
            picSplitter.Left = mSplitLimit
        ElseIf sglPos > Me.Width - mSplitLimit Then
            picSplitter.Left = Me.Width - mSplitLimit
        Else
            picSplitter.Left = sglPos
        End If
    End If
End Sub

Private Sub imgSplitter_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    SizeControls picSplitter.Left
    picSplitter.Visible = False
    mIsMoving = False
End Sub

Private Sub mnu_FileExit_Click()
  Unload Me
End Sub

Private Sub tvTreeView_NodeClick(ByVal Node As Node)
    Dim currFldr As Folder
    Dim fldr As Folder

    Dim fso As Scripting.FileSystemObject
    Set fso = New FileSystemObject

    Set currFldr = fso.GetFolder(Node.FullPath)
    lblPath = Node.FullPath

    DoHourglass True

    ' Add child nodes only if there aren't any now
    If Node.Children = 0 Then
        For Each fldr In currFldr.SubFolders
            AddTVNode Node, Node.Key & fldr.Name, fldr.Name
        Next
    End If
    Node.Sorted = True
    Node.Expanded = True

    ' Add files to the ListView
    lvListView.ListItems.Clear
    Dim fl As File
    Dim totalFileSize As Long

    For Each fl In currFldr.Files
        totalFileSize = totalFileSize + fl.Size
        AddListItem "", fl.Name, fl.Size, fl.Type, fl.DateLastModified
    Next

    ' Show total files and space occupied
    Dim fileCtr As Integer
    Dim message As String

    fileCtr = currFldr.Files.Count
    message = fileCtr & " file" & IIf(fileCtr = 1, "  ", "s  ")
    message = message & Format(totalFileSize, "###,###,##0") & " bytes"
    sbStatusBar.Panels(1).Text = message
    DoHourglass False

    DoEvents
End Sub

Private Sub AddListItem(itemKey As String, _
    itemText As String, itemSize As String, itemType As String, _
    itemModified As Long)

    ' Add a ListItem, then additional columns as ListSubItems.
    Dim liListItem As ListItem
    Set liListItem = lvListView.ListItems.Add(, , itemText, _
        "genericMedium", "genericSmall")

    With liListItem.ListSubItems
        .Add , Text:=itemSize
        .Add , Text:=itemType
        .Add , Text:=CDate(itemModified)
    End With
End Sub

Private Sub AddTVNode(ByRef ParentNode As Node, ByVal nodeKey As String, _
    ByVal nodeText As String)
    ' Add a new TreeView node.
    Dim newNode As Node
    Set newNode = tvTreeView.Nodes.Add(ParentNode, tvwChild, nodeKey, _
        nodeText, "fldrClosed", "fldrOpen")
End Sub

Private Sub DoHourglass(ByVal showHourglass As Boolean)
    ' Turns hourglass display on/off.
    ' Keeps track of how many nested calls have been made to the hourglass function.

    ' Was the cursor already an hourglass?
    Dim isHourglassPrev As Boolean
    ' Is the cursor an hourglass now?
    Dim isHourglassNow As Boolean
    ' How many nested routines have turned on the hourglass?
    Static hourGlassCtr As Integer

    ' Note the current state of the cursor, then
    ' update the hourglass counter.
    isHourglassPrev = (hourGlassCtr > 0)
    If showHourglass Then
        hourGlassCtr = hourGlassCtr + 1
    Else
        hourGlassCtr = hourGlassCtr - 1
    End If
    If hourGlassCtr < 0 Then hourGlassCtr = 0

    ' Set the cursor, but only if it's different from what it is now.
    isHourglassNow = (hourGlassCtr > 0)
    If isHourglassNow <> isHourglassPrev Then
        If hourGlassCtr > 0 Then
            Me.MousePointer = vbHourglass
        Else
            Me.MousePointer = vbDefault
        End If
    End If
End Sub

Sub SizeControls(X As Single)
    ' Set sizes and locations for the movable controls
    On Error Resume Next

    'Set the TreeView's width
    If X < 1500 Then X = 1500
    If X > (Me.Width - 1500) Then X = Me.Width - 1500
    tvTreeView.Width = X
    imgSplitter.Left = X

    ' Set up the ListView
    With lvListView
        .Left = X + 75
        .Width = Me.Width - (tvTreeView.Width + 190)
        lblPath.Left = .Left + 30
        lblPath.Width = .Width - 60
    End With
End Sub

Project Homepage: