DiskPRoperty

Private Sub cmdEnd_Click()
    Unload Me
    Set Form1 = Nothing
    End
    
End Sub

Private Sub cmdFileProperties_Click()
    
    'pass the selected item.  Bracketing the list item assures
    'that the text is passed, rather than the list property.
    ShowProperties (FilesList.List(FilesList.ListIndex))
End Sub

Private Sub cmdFolderProperties_Click()
    ShowProperties (FolderList.List(FolderList.ListIndex))
End Sub

Private Sub cmdDriveProperties_Click()
    ShowProperties (Drive1.List(Drive1.ListIndex))
    
End Sub

Private Sub Drive1_Change()
    
    'trap a drive not ready error
    On Local Error GoTo Drive1_Error
    
    'change to the selected drive
    ChDrive Drive1.Drive
    
    'get the info
    LoadFolderInfo
    
    Exit Sub
    
    Drive1_Error:
    MsgBox "The selected drive is not ready.", vbCritical, "File and Property Demo"
    
End Sub

Private Sub FilesList_Click()
    
    'only enable the properies button if both an item is
    'selected, and that item is not the 'no files' message
    cmdFileProperties.Enabled = (FilesList.ListIndex > -1) _
        And (FilesList.List(FilesList.ListIndex)) <> "<no files>"
End Sub

Private Sub FilesList_DblClick()
    
    'add double-click fuctionality
    ShowProperties (FilesList.List(FilesList.ListIndex))
End Sub

Private Sub FolderList_Click()
    cmdFolderProperties.Enabled = (FolderList.ListIndex > -1)
End Sub

Private Sub FolderList_DblClick()
    
    'add double-click fuctionality
    Dim newPath As String
    
    newPath = Trim$(FolderList.List(FolderList.ListIndex))
    
    'Required to validate the path
    If Right$(CurDir, 1) <> "\" Then
        ChDir CurDir + "\" + newPath
    Else: ChDir CurDir + newPath
    End If
    
    'Get items for the new folder
    LoadFolderInfo
    
End Sub

Private Function StripNull(item As String)
    
    'Return a string without the chr$(0) terminator.
    Dim pos As Integer
    pos = InStr(item, Chr$(0))
    
    If pos Then
        StripNull = Left$(item, pos - 1)
    Else: StripNull = item
    End If
End Function

Private Sub ShowProperties(filename As String)
    
    Dim SEI As SHELLEXECUTEINFO
    Dim r As Long
    
    With SEI
        .cbSize = Len(SEI)
        .fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
        .hwnd = Me.hwnd
        .lpVerb = "properties"
        .lpFile = filename
        .lpParameters = vbNullChar
        .lpDirectory = vbNullChar
        .nShow = 0
        .hInstApp = 0
        .lpIDList = 0
    End With
    
    r = ShellExecuteEX(SEI)
    
End Sub

Private Sub LoadFolderInfo()
    
    'Display the contents of a drive/folder.
    Dim hFile As Long
    Dim r As Long
    Dim fname As String
    
    Dim WFD As WIN32_FIND_DATA
    
    lbCurrPath.Caption = " Reading files and directories...."
    FilesList.Clear
    FolderList.Clear
    cmdFileProperties.Enabled = False
    cmdFolderProperties.Enabled = False
    'Get the first file in the directory (it will usually return ".")
    hFile = FindFirstFile("*.*" + Chr$(0), WFD)
    
    'If nothing returned, bail out.
    If hFile
    'list the directories in the FolderList.
    If (WFD.dwFileAttributes And vbDirectory) Then
        
        'strip the trailing chr$(0) and add to the folder list.
        FolderList.AddItem StripNull(WFD.cFileName)
        
    Else
        
        'strip the trailing chr$(0) and add to the file list.
        FilesList.AddItem StripNull(WFD.cFileName)
        
    End If
    
    'keep looking for more
    r = FindNextFile(hFile, WFD)
    
    Loop Until r = False
    
    'Close the search handle
    r = FindClose(hFile)
    
    'update both the current path label, and the filelist
    If FilesList.ListCount = 0 Then FilesList.AddItem "<no files>"
    
    lbCurrPath.Caption = CurDir
    
End Sub

Option Explicit
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
(ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
(ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public Const MAX_PATH = 260
Public Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Public Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
Public Const SEE_MASK_INVOKEIDLIST = &HC
Public Const SEE_MASK_NOCLOSEPROCESS = &H40
Public Const SEE_MASK_FLAG_NO_UI = &H400
Type SHELLEXECUTEINFO
cbSize As Long
fMask As Long
hwnd As Long
lpVerb As String
lpFile As String
lpParameters As String
lpDirectory As String
nShow As Long
hInstApp As Long

lpIDList As Long 'Optional parameter
lpClass As String 'Optional parameter
hkeyClass As Long 'Optional parameter
dwHotKey As Long 'Optional parameter
hIcon As Long 'Optional parameter
hProcess As Long 'Optional parameter
End Type
Declare Function ShellExecuteEX Lib "shell32.dll" Alias "ShellExecuteEx" _
(SEI As SHELLEXECUTEINFO) As Long
'Add the following routines to Form1.

Private Sub Form_Load()

'Show the contents of the start directory.

LoadFolderInfo
End Sub

Private Sub cmdEnd_Click()
Unload Me
Set Form1 = Nothing
End

End Sub

Private Sub cmdFileProperties_Click()

'pass the selected item. Bracketing the list item assures

'that the text is passed, rather than the list property.

ShowProperties (FilesList.List(FilesList.ListIndex))
End Sub

Private Sub cmdFolderProperties_Click()
ShowProperties (FolderList.List(FolderList.ListIndex))
End Sub

Private Sub cmdDriveProperties_Click()
ShowProperties (Drive1.List(Drive1.ListIndex))

End Sub

Private Sub Drive1_Change()

'trap a drive not ready error

On Local Error GoTo Drive1_Error

'change to the selected drive

ChDrive Drive1.Drive

'get the info

LoadFolderInfo

Exit Sub

Drive1_Error:
MsgBox "The selected drive is not ready.", vbCritical, "File and Property Demo"

End Sub

Private Sub FilesList_Click()

'only enable the properies button if both an item is

'selected, and that item is not the 'no files' message

cmdFileProperties.Enabled = (FilesList.ListIndex > -1) _
And (FilesList.List(FilesList.ListIndex)) <> "<no files>"
End Sub

Private Sub FilesList_DblClick()

'add double-click fuctionality

ShowProperties (FilesList.List(FilesList.ListIndex))
End Sub

Private Sub FolderList_Click()
cmdFolderProperties.Enabled = (FolderList.ListIndex > -1)
End Sub

Private Sub FolderList_DblClick()

'add double-click fuctionality

Dim newPath As String

newPath = Trim$(FolderList.List(FolderList.ListIndex))

'Required to validate the path

If Right$(CurDir, 1) <> "\" Then
ChDir CurDir + "\" + newPath
Else: ChDir CurDir + newPath
End If

'Get items for the new folder

LoadFolderInfo

End Sub

Private Function StripNull(item As String)

'Return a string without the chr$(0) terminator.

Dim pos As Integer
pos = InStr(item, Chr$(0))

If pos Then
StripNull = Left$(item, pos - 1)
Else: StripNull = item
End If
End Function

Private Sub ShowProperties(filename As String)

Dim SEI As SHELLEXECUTEINFO
Dim r As Long

With SEI
.cbSize = Len(SEI)
.fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI
.hwnd = Me.hwnd
.lpVerb = "properties"
.lpFile = filename
.lpParameters = vbNullChar
.lpDirectory = vbNullChar
.nShow = 0
.hInstApp = 0
.lpIDList = 0
End With

r = ShellExecuteEX(SEI)

End Sub

Private Sub LoadFolderInfo()

'Display the contents of a drive/folder.

Dim hFile As Long
Dim r As Long
Dim fname As String

Dim WFD As WIN32_FIND_DATA

lbCurrPath.Caption = " Reading files and directories...."
FilesList.Clear
FolderList.Clear
cmdFileProperties.Enabled = False
cmdFolderProperties.Enabled = False
'Get the first file in the directory (it will usually return ".")

hFile = FindFirstFile("*.*" + Chr$(0), WFD)

'If nothing returned, bail out.

If hFile
'list the directories in the FolderList.

If (WFD.dwFileAttributes And vbDirectory) Then

'strip the trailing chr$(0) and add to the folder list.

FolderList.AddItem StripNull(WFD.cFileName)

Else

'strip the trailing chr$(0) and add to the file list.

FilesList.AddItem StripNull(WFD.cFileName)

End If

'keep looking for more

r = FindNextFile(hFile, WFD)

Loop Until r = False

'Close the search handle

r = FindClose(hFile)

'update both the current path label, and the filelist

If FilesList.ListCount = 0 Then FilesList.AddItem "<no files>"

lbCurrPath.Caption = CurDir

End Sub