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:
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
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:
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:
Post a Comment