Public Declare Function FindFirstFile _<br>
Lib "kernel32" Alias "FindFirstFileA" _<br>
(ByVal lpFileName As String, _<br>
lpFindFileData As WIN32_FIND_DATA) As Long<br>
<br>
Public Declare Function FindNextFile _<br>
Lib "kernel32" Alias "FindNextFileA" _<br>
(ByVal hFindFile As Long, _<br>
lpFindFileData As WIN32_FIND_DATA) As Long<br>
<br>
Public Declare Function FindClose _<br>
Lib "kernel32" (ByVal hFindFile As Long) As Long<br>
<br>
Public Const MAX_PATH = 260<br>
<br>
Public Type FILETIME<br>
dwLowDateTime As Long<br>
dwHighDateTime As Long<br>
End Type<br>
<br>
Public Type WIN32_FIND_DATA<br>
dwFileAttributes As Long<br>
ftCreationTime As FILETIME<br>
ftLastAccessTime As FILETIME<br>
ftLastWriteTime As FILETIME<br>
nFileSizeHigh As Long<br>
nFileSizeLow As Long<br>
dwReserved0 As Long<br>
dwReserved1 As Long<br>
cFileName As String * MAX_PATH<br>
cAlternate As String * 14<br>
End Type<br>
<br>
Type SHELLEXECUTEINFO<br>
cbSize As Long<br>
fMask As Long<br>
hwnd As Long<br>
lpVerb As String<br>
lpFile As String<br>
lpParameters As String<br>
lpDirectory As String<br>
nShow As Long<br>
hInstApp As Long<br>
lpIDList As Long 'Optional parameter<br>
lpClass As String 'Optional parameter<br>
hkeyClass As Long 'Optional parameter<br>
dwHotKey As Long 'Optional parameter<br>
hIcon As Long 'Optional parameter<br>
hProcess As Long 'Optional parameter<br>
End Type<br>
<br>
Public Const SEE_MASK_INVOKEIDLIST = &HC<br>
Public Const SEE_MASK_NOCLOSEPROCESS = &H40<br>
Public Const SEE_MASK_FLAG_NO_UI = &H400<br>
<br>
Declare Function ShellExecuteEX _<br>
Lib "shell32.dll" Alias "ShellExecuteEx" _<br>
(SEI As SHELLEXECUTEINFO) As Long<br>
<br>
To a project form add :<br>
four command buttons (cmdDriveProperties, cmdFolderProperties, cmdFileProperties, cmdEnd) <br>
two list boxes (FolderList, FilesList) <br>
a DriveListBox (Drive1) <br>
a Label (lbCurrPath). <br>
Add the following to the form:<br>
<br>
Option Explicit<br>
<br>
Private Sub Form_Load()<br>
<br>
Me.Move (Screen.Width - Me.Width) \ 2, (Screen.Height - Me.Height) \ 2<br>
LoadFolderInfo<br>
<br>
End Sub<br>
<br>
<br>
Private Sub cmdEnd_Click()<br>
<br>
Unload Me<br>
<br>
End Sub<br>
<br>
<br>
Private Sub cmdFileProperties_Click()<br>
<br>
'pass the selected item. Bracketing the list item assures <br>
'that the text is passed, rather than the list property. <br>
ShowProperties (FilesList.List(FilesList.ListIndex))<br>
<br>
End Sub<br>
<br>
<br>
Private Sub cmdFolderProperties_Click()<br>
<br>
ShowProperties (FolderList.List(FolderList.ListIndex))<br>
<br>
End Sub<br>
<br>
<br>
Private Sub cmdDriveProperties_Click()<br>
<br>
ShowProperties (Drive1.List(Drive1.ListIndex))<br>
<br>
End Sub<br>
<br>
<br>
Private Sub Drive1_Change()<br>
<br>
'trap a drive not ready error <br>
On Local Error GoTo Drive1_Error<br>
<br>
'change to the selected drive <br>
ChDrive Drive1.Drive<br>
<br>
'get the info <br>
LoadFolderInfo<br>
<br>
Exit Sub<br>
<br>
Drive1_Error:<br>
<br>
MsgBox "The selected drive is not ready.", _<br>
vbCritical, "File and Property Demo"<br>
<br>
End Sub<br>
<br>
<br>
Private Sub FilesList_Click()<br>
<br>
'only enable the properies button if both an item is <br>
'selected, and that item is not the 'no files' message <br>
cmdFileProperties.Enabled = (FilesList.ListIndex > -1) And _<br>
(FilesList.List(FilesList.ListIndex)) <> ""<br>
<br>
End Sub<br>
<br>
<br>
Private Sub FilesList_DblClick()<br>
<br>
'add double-click fuctionality <br>
ShowProperties (FilesList.List(FilesList.ListIndex))<br>
<br>
End Sub<br>
<br>
<br>
Private Sub FolderList_Click()<br>
<br>
cmdFolderProperties.Enabled = (FolderList.ListIndex > -1)<br>
<br>
End Sub<br>
<br>
<br>
Private Sub FolderList_DblClick()<br>
<br>
'add double-click fuctionality <br>
Dim newPath As String<br>
<br>
newPath = Trim$(FolderList.List(FolderList.ListIndex))<br>
<br>
'Required to validate the path <br>
If Right$(CurDir, 1) <> "\" Then<br>
ChDir CurDir + "\" + newPath<br>
Else: ChDir CurDir + newPath<br>
End If<br>
<br>
'Get items for the new folder <br>
LoadFolderInfo<br>
<br>
End Sub<br>
<br>
<br>
Private Function TrimNull(item As String)<br>
<br>
'Return a string without the chr$(0) terminator. <br>
Dim pos As Integer<br>
<br>
pos = InStr(item, Chr$(0))<br>
<br>
If pos Then<br>
TrimNull = Left$(item, pos - 1)<br>
Else: TrimNull = item<br>
End If<br>
<br>
<br>
End Function<br>
<br>
<br>
Private Sub ShowProperties(filename As String)<br>
<br>
Dim SEI As SHELLEXECUTEINFO<br>
Dim r As Long<br>
<br>
With SEI<br>
.cbSize = Len(SEI)<br>
.fMask = SEE_MASK_NOCLOSEPROCESS Or SEE_MASK_INVOKEIDLIST Or SEE_MASK_FLAG_NO_UI<br>
.hwnd = Me.hwnd<br>
.lpVerb = "properties"<br>
.lpFile = filename<br>
.lpParameters = vbNullChar<br>
.lpDirectory = vbNullChar<br>
.nShow = 0<br>
.hInstApp = 0<br>
.lpIDList = 0<br>
End With<br>
<br>
r = ShellExecuteEX(SEI)<br>
<br>
End Sub<br>
<br>
<br>
Private Sub LoadFolderInfo()<br>
<br>
'Display the contents of a drive/folder.<br>
<br>
Dim hFile As Long<br>
Dim fname As String<br>
Dim WFD As WIN32_FIND_DATA<br>
<br>
lbCurrPath.Caption = " Reading files and directories...."<br>
FilesList.Clear<br>
FolderList.Clear<br>
cmdFileProperties.Enabled = False<br>
cmdFolderProperties.Enabled = False<br>
<br>
'Get the first file in the directory (it will usually return "."

<br>
hFile = FindFirstFile("*.*" & Chr$(0), WFD)<br>
<br>
'If nothing returned, bail out. <br>
If hFile < 0 Then Exit Sub<br>
<br>
Do<br>
<br>
'list the directories in the FolderList. <br>
If (WFD.dwFileAttributes And vbDirectory) Then<br>
<br>
'strip the trailing chr$(0) and add to the folder list. <br>
FolderList.AddItem TrimNull(WFD.cFileName)<br>
<br>
Else<br>
<br>
'strip the trailing chr$(0) and add to the file list. <br>
FilesList.AddItem TrimNull(WFD.cFileName)<br>
<br>
End If<br>
<br>
<br>
Loop While FindNextFile(hFile, WFD)<br>
<br>
'Close the search handle <br>
Call FindClose(hFile)<br>
<br>
'update both the current path label and the filelist <br>
If FilesList.ListCount = 0 Then FilesList.AddItem ""<br>
lbCurrPath.Caption = CurDir<br>
<br>
End Sub<br>