|
|
![]() |
|
||
|
|
|||
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
Visual Basic File API Routines FindFirstFile: Determining the Oldest Folder (Recursive) |
|
| Posted: | Tuesday September 06, 2005 |
| Updated: | Monday December 26, 2011 |
| Applies to: | VB4-32, VB5, VB6 |
| Developed with: | VB6, Windows XP Pro |
| OS restrictions: | None |
| Author: | VBnet - Randy Birch |
|
Related: |
FindFirstFile: Changing File and/or Folder Attributes Recursively
FindFirstFile: Determining the Oldest Folder (Recursive) FindFirstFile: Recursive File Search for Single or Multiple File Types (minimal code) FindFirstFile: Recursive File Search Including/Excluding Single or Multiple File Types (minimal code) FindFirstFile: Recursive Search for Folders Using a Folder Mask (minimal code) FindFirstFile: Recursive File Search (minimal code) FindFirstFile: Recursive Search for Folders (minimal code) FindFirstFile: Fast Directory File Count FindFirstFile: Performance Comparison - FSO vs. API |
| Prerequisites |
| None. |
|
|
The
code on this page takes the basic methodology from
FindFirstFile: Fast Directory File Count and adds code to
determine the file date/time. The result is a set of routines that will return the name and date of the
oldest folder found under the specified path.As with all my other FindFirstFile demos, the code presumes no folder will start with a period - a typical UNIX convention. If the code is for non-Windows machines, you'll want to modify the If Then test in the GetOldestFolder routine to explicitly test for the strings "." and "..", rather than 'vbDot' as used in the demo.
|
| BAS Module Code |
| None. |
|
|
| Form Code |
|
|
| Create a new project with a form containing three text boxes (Text1, Text2, Text3), a check boxes (Check1), and a command button (Command1). The Load event sets up the captions. Add labels as desired, along with the following code: |
|
|
Option Explicit '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved. ' Some pages may also contain other copyrights by the author. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Distribution: You can freely use this code in your own ' applications, but you may not reproduce ' or publish this code on any web site, ' online service, or distribute as source ' on any media without express permission. '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Private Const vbDirDot = 46
Private Const MAX_PATH As Long = 260
Private Const INVALID_HANDLE_VALUE = -1
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 SYSTEMTIME
wYear As Integer
wMonth As Integer
wDayOfWeek As Integer
wDay As Integer
wHour As Integer
wMinute As Integer
wSecond As Integer
wMilliseconds As Long
End Type
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 Declare Function lstrlen Lib "kernel32" _
Alias "lstrlenW" (ByVal lpString As Long) As Long
Private Declare Function FileTimeToSystemTime Lib "kernel32" _
(lpFileTime As FILETIME, _
lpSystemTime As SYSTEMTIME) As Long
Private Declare Function FileTimeToLocalFileTime Lib "kernel32" _
(lpFileTime As FILETIME, _
lpLocalFileTime As FILETIME) As Long
Private Sub Form_Load()
Text1.Text = "c:\windows\"
Text2.Text = ""
Text3.Text = ""
Check1.Caption = "Recurse"
Command1.Caption = "Get Oldest Folder"
End Sub
Private Sub Command1_Click()
Dim sOldestFolder As String
Dim sFileRoot As String
Dim bRecurse As Boolean
'this is used to pass data back and forth
'between recursive calls
Dim dwDate As Double
sFileRoot = QualifyPath(Text1.Text)
Text1.Text = sFileRoot
bRecurse = Check1.Value = vbChecked
Call GetOldestFolder(sFileRoot, bRecurse, dwDate, sOldestFolder)
Text2.Text = sOldestFolder
Text3.Text = FormatDateTime(dwDate)
End Sub
Private Sub GetOldestFolder(sRoot As String, _
bRecurse As Boolean, _
dwTemp As Double, _
sOldestFolder As String)
Dim wfd As WIN32_FIND_DATA
Dim hFile As Long
Dim sFolder As String
Dim dwDateBuff As Double
hFile = FindFirstFile(sRoot & "*.*", wfd)
If hFile <> INVALID_HANDLE_VALUE Then
Do
If Asc(wfd.cFileName) <> vbDirDot Then
If (wfd.dwFileAttributes And vbDirectory) Then
dwDateBuff = GetFolderCreatedDate(wfd)
sFolder = sRoot & TrimNull(wfd.cFileName)
'first time through ...
If dwTemp = 0 Then
dwTemp = dwDateBuff
sOldestFolder = sFolder
Else
If dwTemp >= dwDateBuff Then
dwTemp = dwDateBuff
sOldestFolder = sFolder
End If 'dwTemp >= dwDateBuff
End If 'dwTemp = 0
If bRecurse Then
Call GetOldestFolder(QualifyPath(sFolder), _
bRecurse, _
dwTemp, _
sOldestFolder)
End If 'fp.bRecurse
End If 'WFD.dwFileAttributes
End If 'Asc(wfd.cFileName)
Loop While FindNextFile(hFile, wfd)
End If 'hFile
Call FindClose(hFile)
End Sub
Private Function GetFolderCreatedDate(wfd As WIN32_FIND_DATA) As Double
Dim ft As FILETIME
Dim st As SYSTEMTIME
Dim ft_local As FILETIME
Dim ds As Double
Dim ts As Double
ft.dwHighDateTime = wfd.ftCreationTime.dwHighDateTime
ft.dwLowDateTime = wfd.ftCreationTime.dwLowDateTime
If FileTimeToLocalFileTime(ft, ft_local) = 1 Then
If FileTimeToSystemTime(ft_local, st) = 1 Then
ds = DateSerial(st.wYear, st.wMonth, st.wDay)
ts = TimeSerial(st.wHour, st.wMinute, st.wSecond)
GetFolderCreatedDate = ds + ts
End If 'FileTimeToSystemTime
End If 'FileTimeToLocalFileTime
End Function
Private Function QualifyPath(sPath As String) As String
If Len(sPath) > 0 Then
If Right$(sPath, 1) <> "\" Then
QualifyPath = sPath & "\"
Else
QualifyPath = sPath
End If
Else
QualifyPath = ""
End If
End Function
Private Function TrimNull(startstr As String) As String
TrimNull = Left$(startstr, lstrlen(StrPtr(startstr)))
End Function
|
| Comments |
| Before running, assure that any hard-coded paths reflect accurate paths on your system.
Note: While it may be convenient to utilize VB's built-in constants in place of the FILE_ATTRIBUTE_* API values, care must be taken. There is a difference between related constant values that may cause unexpected performance at some point. For example, the constant 'vbNormal' is defined as having a value of 0, whereas the API FILE_ATTRIBUTE_NORMAL has a value of &H80 (decimal 128). |
|
|
|
|
|
|||||
|
|||||
|
|
|||||
|
Copyright ©1996-2011 VBnet and Randy Birch. All Rights Reserved. |
![]() |