|
|
||||||||||||||||||||||||||||||||||||||||||||||||||||||||
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. |