Private Declare Function FindFirstFile Lib "kernel32" _
    Alias "FindFirstFileA" _
   (ByVal lpFileName As String, _
    lpFindFileData As WIN32_FIND_DATA) As Long
    
Private Declare Function FindNextFile Lib "kernel32" _
    Alias "FindNextFileA" _
   (ByVal hFindFile As Long, _
    lpFindFileData As WIN32_FIND_DATA) As Long
    
Private Declare Function FindClose Lib "kernel32" _
    (ByVal hFindFile As Long) As Long

Private Const MAX_PATH As Long = 260

Private Type FILETIME
   dwLowDateTime   As Long
   dwHighDateTime  As Long
End Type

Private 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

Private 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
    lpClass       As String   'Optional
    hkeyClass     As Long     'Optional
    dwHotKey      As Long     'Optional
    hIcon         As Long     'Optional
    hProcess      As Long     'Optional
End Type

Private Const SEE_MASK_INVOKEIDLIST = &HC
Private Const SEE_MASK_NOCLOSEPROCESS = &H40
Private Const SEE_MASK_FLAG_NO_UI = &H400

Private Declare Function ShellExecuteEx Lib "shell32" _
   Alias "ShellExecuteExA" _
  (SEI As SHELLEXECUTEINFO) As Long



Private Sub Form_Load()

   Command1.Caption = "Drive Properties"
   Command2.Caption = "Folder Properties"
   Command3.Caption = "File Properties"
   Command4.Caption = "Exit"
   
   LoadFolderInfo
  
End Sub


Private Sub Command1_Click()

   Dim tmp As String
   Dim pos As Long
   
  'on later windows versions the drive
  'label is returned as part of the
  'drive list, and needs to be removed
   tmp = Drive1.List(Drive1.ListIndex)
   pos = InStr(tmp, "[")
   
   If pos > 0 Then tmp = Left$(tmp, pos - 2)

   Call ShowProperties(tmp)
    
End Sub


Private Sub Command2_Click()

   Call ShowProperties(List1.List(List1.ListIndex))

End Sub


Private Sub Command3_Click()
   
   Call ShowProperties(List2.List(List2.ListIndex))

End Sub


Private Sub Command4_Click()
   
   Unload Me
   
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 List2_Click()
   
  'only enable the properties button if both an item is 
  'selected, and that item is not the 'no files' message           
   Command3.Enabled = (List2.ListIndex > -1) And _
                      (List2.List(List2.ListIndex)) <> ""

End Sub


Private Sub List2_DblClick()
   
  'add double-click functionality     
   ShowProperties (List2.List(List2.ListIndex))

End Sub


Private Sub List1_Click()

    Command2.Enabled = (List1.ListIndex > -1)

End Sub


Private Sub List1_DblClick()

  'add double-click functionality     
   Dim newPath As String
   
   newPath = Trim$(List1.List(List1.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 TrimNull(item As String)
   
  'Return a string without the chr$(0) terminator.   
   Dim pos As Integer

   pos = InStr(item, Chr$(0))
   If pos Then
      TrimNull = Left$(item, pos - 1)
   Else
      TrimNull = item
   End If

End Function


Private Sub ShowProperties(filename As String)
    
   Dim SEI As SHELLEXECUTEINFO
    
   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
    
   Call ShellExecuteEx(SEI)
    
End Sub


Private Sub LoadFolderInfo()
    
  'Display the contents of a drive/folder.
   Dim hFile As Long
   Dim WFD As WIN32_FIND_DATA
    
   Label1.Caption = " Reading files and directories...."
   List2.Clear
   List1.Clear
   Command3.Enabled = False
   Command2.Enabled = False
   
  'Get the first file in the directory (it will usually return ".")   
   hFile = FindFirstFile("*.*", WFD)
   
  'If nothing returned, bail out.   
   If hFile < 0 Then Exit Sub

   Do
 
     'list the directories in the List1.       
      If (WFD.dwFileAttributes And vbDirectory) Then
         List1.AddItem TrimNull(WFD.cFileName)
      Else
        List2.AddItem TrimNull(WFD.cFileName)
      End If
      
   Loop While FindNextFile(hFile, WFD)
    
  'Close the search handle           
   Call FindClose(hFile)
   
   If List2.ListCount = 0 Then List2.AddItem ""
   Label1.Caption = CurDir
   
End Sub