Attribute VB_Name = "modFindFile_API" Option Explicit '============================================================================================================= ' ' modFindFile_API Module ' ---------------------- ' ' Created By : Kevin Wilson ' http://www.TheVBZone.com ( The VB Zone ) ' http://www.TheVBZone.net ( The VB Zone .net ) ' ' Last Update : October 12, 2000 ' ' VB Versions : 5.0 / 6.0 ' ' Requires : NOTHING ' ' Description : This module was created to make it easy to search for a specified file, or type of file in a ' specified folder, or on a specified drive or drives. This module allows you several search ' options as well to make the searching process as customizable as possible. ' ' This module also has functionity that allows you to easily tell if a specified file, folder, ' or drive exists on the user's computer. ' ' See Also : modFindFile_FSO (Same as this module, but uses the FileSystemObject) ' ' Example Use : (This example will search the C:\ drive for all copies of the file ' "Kernel32.dll" and will put the results of the find in Text1 & 2) ' ' Dim Paths As String ' Dim nFound As Long ' ' If FF_FindFile("Kernel32.dll", Paths, nFound, "WholeDrive", _ ' False, C, False, True, False) = True Then ' Text1.Text = Paths ' Text2.Text = CStr(nFound) & " Matching Files Found" ' End If ' ' (See Also - FF_SearchCallback) ' '============================================================================================================= ' ' LEGAL: ' ' You are free to use this code as long as you keep the above heading information intact and unchanged. Credit ' given where credit is due. Also, it is not required, but it would be appreciated if you would mention ' somewhere in your compiled program that that your program makes use of code written and distributed by ' Kevin Wilson (www.TheVBZone.com). Feel free to link to this code via your web site or articles. ' ' You may NOT take this code and pass it off as your own. You may NOT distribute this code on your own server ' or web site. You may NOT take code created by Kevin Wilson (www.TheVBZone.com) and use it to create products, ' utilities, or applications that directly compete with products, utilities, and applications created by Kevin ' Wilson, TheVBZone.com, or Wilson Media. You may NOT take this code and sell it for profit without first ' obtaining the written consent of the author Kevin Wilson. ' ' These conditions are subject to change at the discretion of the owner Kevin Wilson at any time without ' warning or notice. Copyright© by Kevin Wilson. All rights reserved. ' '============================================================================================================= ' Enumeration - Drives Public Enum DriveLetters [Unknown] a = 65 B = 66 c = 67 d E F G H I J k L M n O P Q r s T U v W X Y Z End Enum ' Enumeration - DriveTypes Public Enum DriveTypes DRIVE_UNKNOWN = 0 ' The drive type cannot be determined. DRIVE_NO_ROOT_DIR = 1 ' The root directory does not exist. DRIVE_REMOVABLE = 2 ' The disk can be removed from the drive. DRIVE_FIXED = 3 ' The disk cannot be removed from the drive. DRIVE_REMOTE = 4 ' The drive is a remote (network) drive. DRIVE_CDROM = 5 ' The drive is a CD-ROM drive. DRIVE_RAMDISK = 6 ' The drive is a RAM disk. End Enum ' Type - DriveInfo Public Type DriveInfo SectorsPerCluster As Long BytesPerSector As Long TotalBytes As String FreeBytes As String TotalSize As String FreeSpace As String SpaceUsed As String DriveLetter As String DriveType As DriveTypes 'Long Exists As Boolean FileSystem As String Path As String SerialNumber As String VolumeName As String End Type ' Type - FILETIME 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 * 260 ' MAX_PATH cAlternate As String * 14 End Type ' Constants - General Private Const MAX_PATH = 260 ' Constants - FindFolder Private Const INVALID_HANDLE_VALUE = -1 ' Constants - FindFirstFile(lpFindFileData.dwFileAttributes) Private Const FILE_ATTRIBUTE_READONLY = &H1 ' The file or directory is read-only. Applications can read the file but cannot write to it or delete it. In the case of a directory, applications cannot delete it. Private Const FILE_ATTRIBUTE_HIDDEN = &H2 ' The file or directory is hidden. It is not included in an ordinary directory listing. Private Const FILE_ATTRIBUTE_SYSTEM = &H4 ' The file or directory is part of the operating system or is used exclusively by the operating system. Private Const FILE_ATTRIBUTE_DIRECTORY = &H10 ' The handle identifies a directory. Private Const FILE_ATTRIBUTE_ARCHIVE = &H20 ' The file or directory is an archive file or directory. Applications use this attribute to mark files for backup or removal. Private Const FILE_ATTRIBUTE_DEVICE = &H40 ' [ Undocumented ] Private Const FILE_ATTRIBUTE_NORMAL = &H80 ' The file or directory has no other attributes set. This attribute is valid only if used alone. Private Const FILE_ATTRIBUTE_TEMPORARY = &H100 ' The file is being used for temporary storage. File systems attempt to keep all of the data in memory for quicker access, rather than flushing it back to mass storage. A temporary file should be deleted by the application as soon as it is no longer needed. Private Const FILE_ATTRIBUTE_SPARSE_FILE = &H200 ' The file is a sparse file. Private Const FILE_ATTRIBUTE_REPARSE_POINT = &H400 ' The file has an associated reparse point. Private Const FILE_ATTRIBUTE_COMPRESSED = &H800 ' The file or directory is compressed. For a file, this means that all of the data in the file is compressed. For a directory, this means that compression is the default for newly created files and subdirectories. Private Const FILE_ATTRIBUTE_OFFLINE = &H1000 ' The file data is not immediately available. Indicates that the file data has been physically moved to offline storage. Private Const FILE_ATTRIBUTE_NOT_CONTENT_INDEXED = &H2000 ' [ Undocumented ] Private Const FILE_ATTRIBUTE_ENCRYPTED = &H4000 ' The file or directory is encrypted. For a file, this means that all data streams are encrypted. For a directory, this means that encryption is the default for newly created files and subdirectories. Private Const FILE_ATTRIBUTE_FLAGS = FILE_ATTRIBUTE_ARCHIVE Or FILE_ATTRIBUTE_HIDDEN Or FILE_ATTRIBUTE_NORMAL Or FILE_ATTRIBUTE_READONLY ' Constants - GetVolumeInformation(lpFileSystemFlags) Private Const FILE_CASE_SENSITIVE_SEARCH = &H1 ' [ See FS_CASE_SENSITIVE ] Private Const FILE_CASE_PRESERVED_NAMES = &H2 ' [ See FS_CASE_IS_PRESERVED ] Private Const FILE_UNICODE_ON_DISK = &H4 ' [ See FS_UNICODE_STORED_ON_DISK ] Private Const FILE_PERSISTENT_ACLS = &H8 ' [ See FS_PERSISTENT_ACLS ] Private Const FILE_FILE_COMPRESSION = &H10 ' [ See FS_FILE_COMPRESSION ] Private Const FILE_VOLUME_QUOTAS = &H20 ' The file system supports disk quotas. Private Const FILE_SUPPORTS_SPARSE_FILES = &H40 ' The file system supports sparse files. Private Const FILE_SUPPORTS_REPARSE_POINTS = &H80 ' The file system supports reparse points. Private Const FILE_VOLUME_IS_COMPRESSED = &H8000 ' [ See FS_VOL_IS_COMPRESSED ] Private Const FILE_SUPPORTS_ENCRYPTION = &H20000 ' The file system supports the Encrypted File System (EFS). Private Const FILE_SUPPORTS_OBJECT_IDS = &H10000 ' The file system supports object identifiers. Private Const FS_CASE_IS_PRESERVED = FILE_CASE_PRESERVED_NAMES ' The file system preserves the case of filenames when it places a name on disk. Private Const FS_CASE_SENSITIVE = FILE_CASE_SENSITIVE_SEARCH ' The file system supports case-sensitive filenames. Private Const FS_UNICODE_STORED_ON_DISK = FILE_UNICODE_ON_DISK ' The file system supports Unicode in filenames as they appear on disk. Private Const FS_PERSISTENT_ACLS = FILE_PERSISTENT_ACLS ' The file system preserves and enforces ACLs. For example, NTFS preserves and enforces ACLs, and FAT does not. Private Const FS_VOL_IS_COMPRESSED = FILE_VOLUME_IS_COMPRESSED ' The specified volume is a compressed volume; for example, a DoubleSpace volume. Private Const FS_FILE_COMPRESSION = FILE_FILE_COMPRESSION ' The file system supports file-based compression. Private Const FS_FILE_ENCRYPTION = FILE_SUPPORTS_ENCRYPTION Private TheDrives(65 To 90) As DriveInfo Private Initialized As Boolean Private InitFailed As Boolean '--------------------------------------------------------------------------------- ' * IMPORTANT - Set this global variable to TRUE to abort a search '--------------------------------------------------------------------------------- Public FF_CancelSearch As Boolean '--------------------------------------------------------------------------------- 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 GetDriveType Lib "KERNEL32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long Private Declare Function GetLogicalDrives Lib "KERNEL32" () As Long Private Declare Function GetLogicalDriveStrings Lib "KERNEL32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long Private Declare Function GetDiskFreeSpace Lib "KERNEL32" Alias "GetDiskFreeSpaceA" (ByVal lpRootPathName As String, ByRef lpSectorsPerCluster As Long, ByRef lpBytesPerSector As Long, ByRef lpNumberOfFreeClusters As Long, ByRef lpTotalNumberOfClusters) As Long Private Declare Function GetDiskFreeSpaceEx Lib "KERNEL32" Alias "GetDiskFreeSpaceExA" (ByVal lpRootPathName As String, lpFreeBytesAvailableToCaller As Currency, lpTotalNumberOfBytes As Currency, lpTotalNumberOfFreeBytes As Currency) As Long Private Declare Function GetVolumeInformation Lib "KERNEL32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, ByRef lpVolumeSerialNumber As Long, ByRef lpMaximumComponentLength As Long, ByRef lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long '--------------------------------------------------------------------------------- ' FF_FindFile ' ' Purpose: ' Function that searches the specified folder, drive, or drives for a specified ' file. This function can also search for all files containing the specified ' string by setting the WildCardSearch parameter to true. ' ' Perameter: Use: ' --------------------------------------- ' FileName Specifies the file to search for. ' If the WildCardSearch is set to TRUE, files that contain ' this value somewhere in them are returned as a match. ' Return_Paths Returns the file path(s) of matching files seperated ' by a CRLF (vbCrLf). ' Return_nFound Returns the number of matches found. ' SearchPath Optional. If this value is specified, this function ' searches just the specified path for the file ' SearchAllDrives Optional. If this is set to TRUE, and the SearchPath ' parameter is not set, then all valid drives are searched. ' DriveToSearch Optional. If the SearchPath is not specified, and the ' SearchAllDrives parameter is FALSE, then this specifies ' which drive to search. ' WildCardSearch Optional. If this is set to FALSE, only exactly matching ' files will match the specified search file. If this is ' set to TRUE, all files containing the text in the ' FileName paremter will match. ' SearchSubfolders Optional. If this is set to TRUE, subfolders will be ' searched for matching files. ' StopSearchingWhenFound Optional. If this is set to TRUE, the search will stop ' once a matching file is found. ' SearchRemoveableDrives Optional. This parameter only applies of the ' SearchAllDrives parameter is set to TRUE and the ' SearchPath parameter is not specified. If set to FALSE, ' removable drives like Floppy drives and ZIP drives will ' not be searched. ' SearchRemoteDrives Optional. This parameter only applies if the ' SearchAllDrives parameter is set to TRUE and the ' SearchPath parameter is not specified. If set to FALSE, ' Network drives that are currently mapped will not be ' searched. ' ' Return: ' Returns TRUE if the search succeeded. ' Returns FALSE if the search failed. ' '--------------------------------------------------------------------------------- Public Function FF_FindFile(ByVal FileName As String, _ ByRef Return_Paths As String, _ ByRef Return_nFound As Long, _ Optional ByVal SearchPath As String = "WholeDrive", _ Optional ByVal SearchAllDrives As Boolean = False, _ Optional ByVal DriveToSearch As DriveLetters = c, _ Optional ByVal WildCardSearch As Boolean = False, _ Optional ByVal SearchSubfolders As Boolean = True, _ Optional ByVal StopSearchingWhenFound As Boolean = False, _ Optional ByVal SearchRemoveableDrives As Boolean = False, _ Optional ByVal SearchRemoteDrives As Boolean = False) As Boolean On Error GoTo ErrorTrap Dim MyCounter As Long Dim FileCount As Long Dim FileNames() As String Dim FilePaths() As String Dim FileIsDir() As Boolean ' Make sure there's a valid search file If Trim(FileName) = "" Then Exit Function End If ' Make sure that information on the system's drives has been retrieved If CheckInitialized = False Then Exit Function End If ' Clear the return values to start fresh Return_Paths = "" Return_nFound = 0 ' Set a public variable to tell what's being searched FF_CancelSearch = False ' ** Search specified directory only ** If Trim(UCase(SearchPath)) <> "WHOLEDRIVE" And Trim(SearchPath) <> "" Then If GetFilesAndFolders(FileName, Trim(SearchPath), SearchSubfolders, StopSearchingWhenFound, WildCardSearch, FileCount, FileNames, FilePaths, FileIsDir) = True Then FF_FindFile = True Else GoTo ExitOut End If ' ** Search specified drive letter only ** ElseIf SearchAllDrives = False And DriveToSearch <> Unknown Then With TheDrives(CInt(DriveToSearch)) ' Check if specified drive exists on the user's system and that it's ok to search it If .Exists = False Then GoTo ExitOut ElseIf SearchRemoteDrives = False And .DriveType = DRIVE_REMOTE Then GoTo ExitOut ElseIf SearchRemoveableDrives = False And .DriveType = DRIVE_REMOVABLE Then GoTo ExitOut End If ' Search the drive If GetFilesAndFolders(FileName, .Path, SearchSubfolders, StopSearchingWhenFound, WildCardSearch, FileCount, FileNames, FilePaths, FileIsDir) = True Then FF_FindFile = True Else GoTo ExitOut End If End With ' ** Search ALL drives ** ElseIf SearchAllDrives = True Then For MyCounter = 65 To 90 With TheDrives(MyCounter) ' Check if specified drive exists on the user's system and that it's ok to search it If .Exists = False Then GoTo Continue ElseIf SearchRemoteDrives = False And .DriveType = DRIVE_REMOTE Then GoTo Continue ElseIf SearchRemoveableDrives = False And .DriveType = DRIVE_REMOVABLE Then GoTo Continue End If ' Search the drive If GetFilesAndFolders(FileName, .Path, SearchSubfolders, StopSearchingWhenFound, WildCardSearch, FileCount, FileNames, FilePaths, FileIsDir) = True Then FF_FindFile = True Else GoTo ExitOut End If End With Continue: Next ' ** Unknown Search ** Else GoTo ExitOut End If ' Assemble the paths For MyCounter = 1 To FileCount If WildCardSearch = True Then If InStr(UCase(FileNames(MyCounter)), UCase(FileName)) > 0 Then Return_Paths = Return_Paths & FilePaths(MyCounter) & vbCrLf Return_nFound = Return_nFound + 1 End If Else If UCase(FileNames(MyCounter)) = UCase(FileName) Then Return_Paths = Return_Paths & FilePaths(MyCounter) & vbCrLf Return_nFound = Return_nFound + 1 End If End If Next ' Strip off extra CRLF at end of path If Right(Return_Paths, 2) = vbCrLf Then Return_Paths = Left(Return_Paths, Len(Return_Paths) - 2) End If ExitOut: Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Unknown Error MsgBox Err.Source & " encountered the following error:" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, " Error - " & Err.Description Err.Clear Err.Number = 0 End If End Function ' Function that checks the specified drive letter to see if it exists on the user's machine Public Function FF_DriveExists(ByVal DriveToCheck As DriveLetters) As Boolean On Error GoTo ErrorTrap ' Make sure the specified drive is valid If CLng(DriveToCheck) < 65 Then MsgBox "Specified drive to search is invalid.", vbOKOnly + vbExclamation, " Invalid Drive Letter" ElseIf CLng(DriveToCheck) > 90 Then MsgBox "Specfied drive to search is invalid. You can only search one drive at a time. To search multiple drives, call the FindFile function multiple times with different drive letters. If the drive doesn't exist, no error occurs... instead the return is false.", vbOKOnly + vbExclamation, " Invalid Drive Specified" Exit Function End If ' Make sure that information on the system's drives has been retrieved If CheckInitialized = False Then Exit Function End If FF_DriveExists = TheDrives(CInt(DriveToCheck)).Exists = True Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Unknown Error MsgBox Err.Source & " encountered the following error:" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, " Error - " & Err.Description Err.Clear Err.Number = 0 End If End Function ' Function that returns what type of drive the specified drive is (Fixed, Remote, CD-ROM, etc.) Public Function FF_DriveType(ByVal DriveToCheck As DriveLetters) As DriveTypes On Error GoTo ErrorTrap ' Make sure the specified drive is valid If CLng(DriveToCheck) < 65 Then MsgBox "Specified drive to search is invalid.", vbOKOnly + vbExclamation, " Invalid Drive Letter" ElseIf CLng(DriveToCheck) > 90 Then MsgBox "Specfied drive to search is invalid. You can only search one drive at a time. To search multiple drives, call the FindFile function multiple times with different drive letters. If the drive doesn't exist, no error occurs... instead the return is false.", vbOKOnly + vbExclamation, " Invalid Drive Specified" Exit Function End If ' Make sure that information on the system's drives has been retrieved If CheckInitialized = False Then Exit Function End If FF_DriveType = TheDrives(CInt(DriveToCheck)).DriveType Exit Function ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Unknown Error MsgBox Err.Source & " encountered the following error:" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, " Error - " & Err.Description Err.Clear Err.Number = 0 End If End Function ' Function that checks the specified folder to see if it exists on the user's machine Private Function FF_FolderExists(ByVal FolderPath As String) As Boolean On Error Resume Next Dim hFile As Long Dim WFD As WIN32_FIND_DATA ' Make sure the path passed is valid FolderPath = UCase(Trim(FolderPath)) If FolderPath = "" Then Exit Function ElseIf Left(FolderPath, 1) = "\" Then FolderPath = Right(FolderPath, Len(FolderPath) - 1) End If ' Make sure that information on the system's drives has been retrieved If CheckInitialized = False Then Exit Function End If ' Call the API pasing the folder path hFile = FindFirstFile(FolderPath, WFD) ' Check that the handle returned is valid and that the DIRECTORY attribute is set If (hFile <> INVALID_HANDLE_VALUE) And ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> 0) Then FF_FolderExists = True End If ' Close the opened folder FindClose hFile End Function ' Function that checks the specified file to see if it exists on the user's machine Public Function FF_FileExists(ByVal FilePath As String) As Boolean On Error Resume Next Dim hFile As Long Dim WFD As WIN32_FIND_DATA ' Make sure the path passed is valid FilePath = UCase(Trim(FilePath)) If FilePath = "" Then Exit Function End If ' Make sure that information on the system's drives has been retrieved If CheckInitialized = False Then Exit Function End If ' Call the API pasing the file path hFile = FindFirstFile(FilePath, WFD) ' Check that the handle returned is valid and that the DIRECTORY flag is *NOT* set If (hFile <> INVALID_HANDLE_VALUE) And ((WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = 0) Then FF_FileExists = True End If ' Close the opened file FindClose hFile End Function ' Function that converts a drive letter string like "C:\" into a "DriveLetters" enumeration Public Function FF_CDrive(ByVal DriveLetter As String) As DriveLetters On Error Resume Next ' Get just the first letter by taking the first non-space character of the ' string passed to this function and making it UPPER CASE DriveLetter = UCase(Left(Trim(DriveLetter), 1)) ' Check for a valid drive letter If DriveLetter = "" Then FF_CDrive = Unknown Exit Function End If ' Check which drive letter it is Select Case DriveLetter Case "A" FF_CDrive = a Case "B" FF_CDrive = B Case "C" FF_CDrive = c Case "D" FF_CDrive = d Case "E" FF_CDrive = E Case "F" FF_CDrive = F Case "G" FF_CDrive = G Case "H" FF_CDrive = H Case "I" FF_CDrive = I Case "J" FF_CDrive = J Case "K" FF_CDrive = k Case "L" FF_CDrive = L Case "M" FF_CDrive = M Case "N" FF_CDrive = n Case "O" FF_CDrive = O Case "P" FF_CDrive = P Case "Q" FF_CDrive = Q Case "R" FF_CDrive = r Case "S" FF_CDrive = s Case "T" FF_CDrive = T Case "U" FF_CDrive = U Case "V" FF_CDrive = v Case "W" FF_CDrive = W Case "X" FF_CDrive = X Case "Y" FF_CDrive = Y Case "Z" FF_CDrive = Z Case Else FF_CDrive = Unknown End Select End Function '--------------------------------------------------------------------------------- ' FF_SearchCallBack ' ' Purpose: ' Sub that is called from the "FF_FindFile" funtion to let you know what file is ' currently being checked. ' ' *CAUTION: ' Be carefull about how much code you put into this Sub because it can potentially ' get called thousands of times within a single search and that can slow the ' search down ' ' Perameter: Use: ' --------------------------------------- ' SearchFile The file being searched for ' CurrentFolder The current search folder ' CurrentFile The file currently being checked ' WildCardSearch If TRUE, the user is searching for all files containing ' the specified search. ' If FALSE, the user is looking for an EXACT match ' (Searches are NOT case sensative because the file system ' also is not case sensative) ' ' Return: ' ( NOTHING ) ' '--------------------------------------------------------------------------------- Public Sub FF_SearchCallback(ByVal SearchFile As String, ByVal CurrentFolder As String, ByVal CurrentFile As String, ByVal WildCardSearch As Boolean) ' ' Put your search display code here. For example: ' If Form1.lblFolder.Caption <> CurrentFolder Then ' Form1.lblFolder.Caption = CurrentFolder ' Form1.lblFolder.Refresh ' End If ' If Form1.lblFile.Caption <> CurrentFile Then ' Form1.lblFile.Caption = CurrentFile ' Form1.lblFile.Refresh ' End If ' ' If WildCardSearch = True Then ' If InStr(UCase(CurrentFile), UCase(SearchFile)) > 0 Then ' Form1.txtResults.Text = Form1.txtResults.Text & CurrentFolder & "\" & CurrentFile & vbCrLf ' End If ' Else ' If UCase(SearchFile) = UCase(CurrentFile) Then ' Form1.txtResults.Text = Form1.txtResults.Text & CurrentFolder & "\" & CurrentFile & vbCrLf ' End If ' End If End Sub 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX Private Function CheckInitialized() As Boolean ' If init failed previously, don't try again If InitFailed = True Then Exit Function End If ' Check if the information was previously initialized to avoid doing it again If Initialized = False Then ' Attemp to initialize the drive information If GetDrives = False Then InitFailed = True Exit Function Else Initialized = True CheckInitialized = True End If Else CheckInitialized = True End If End Function Private Function GetDrives() As Boolean Dim DiskVoumeBuffer As String Dim FileSystemBuffer As String Dim DriveBits As Long Dim MyCounter As Long Dim SerialNum As Long Dim SystemFlags As Long Dim lSectorsPerCluster As Long Dim lBytesPerSector As Long Dim lFreeClusters As Long Dim lTotalClusters As Long Dim dTotalSpace As Double Dim dFreeSpace As Double Dim BytesFreeToCalller As Currency Dim TotalBytes As Currency Dim TotalFreeBytes As Currency Dim TotalBytesUsed As Currency ' Get the information about the drives on this system DriveBits = GetLogicalDrives If DriveBits = 0 Then Exit Function End If ' Put in the default initialization values For MyCounter = 65 To 90 TheDrives(MyCounter).DriveLetter = Chr(MyCounter) TheDrives(MyCounter).Path = Chr(MyCounter) & ":\" TheDrives(MyCounter).Exists = False Next ' Get the details about each drive For MyCounter = 1 To 26 ' 1 to 26 = A to Z If CheckBit(DriveBits, MyCounter) = True Then With TheDrives(MyCounter + 64) .Exists = True .DriveType = GetDriveType(.Path & Chr(0)) ' Try to get the extended information (This requires Win95 OSR2 or better) If GetDiskFreeSpaceEx(.Path & Chr(0), BytesFreeToCalller, TotalBytes, TotalFreeBytes) <> 0 Then ' Get the Sectors/Cluster and Bytes/Cluster If GetDiskFreeSpace(.Path & Chr(0), lSectorsPerCluster, lBytesPerSector, lFreeClusters, lTotalClusters) <> 0 Then .SectorsPerCluster = lSectorsPerCluster .BytesPerSector = lBytesPerSector Else .SectorsPerCluster = 0 .BytesPerSector = 0 End If ' Multiply the returned value by 10000 to adjust for the 4 decimal places that the currency data type returns .TotalBytes = CStr(TotalBytes * 10000) .FreeBytes = CStr(TotalFreeBytes * 10000) .TotalSize = CStr(Val(.TotalBytes) / 1024) .TotalSize = Format(Val(.TotalSize) / 1000, "#,###.00") & " MB" .FreeSpace = CStr(Val(.FreeBytes) / 1024) .FreeSpace = Format(Val(.FreeSpace) / 1000, "#,###.00") & " MB" .SpaceUsed = CStr((TotalBytes - TotalFreeBytes) * 10000) .SpaceUsed = CStr(Val(.SpaceUsed) / 1024) .SpaceUsed = Format(Val(.SpaceUsed) / 1000, "#,##0.00") & " MB" ' If GetDiskFreeSpaceEx fails, it means that the user is on a Windows 95A machine ElseIf GetDiskFreeSpace(.Path & Chr(0), lSectorsPerCluster, lBytesPerSector, lFreeClusters, lTotalClusters) <> 0 Then .SectorsPerCluster = lSectorsPerCluster .BytesPerSector = lBytesPerSector .TotalBytes = lTotalClusters * lSectorsPerCluster * lBytesPerSector .FreeBytes = lFreeClusters * lSectorsPerCluster * lBytesPerSector ' If the GetDiskFreeSpace API succeeds, but the lTotalClusters = 0 then HDD > 2GB If lTotalClusters = 0 Then .TotalSize = "1999.99 MB" Else dTotalSpace = (lTotalClusters * lSectorsPerCluster * lBytesPerSector) / 1024 dTotalSpace = dTotalSpace / 1000 .TotalSize = Format(dTotalSpace, "#,###.00") & " MB" End If ' If the GetDiskFreeSpace API succeeds, but the lFreeClusters = 0 then HDD > 2GB If lFreeClusters = 0 Then .FreeSpace = "1999.99 MB" Else dFreeSpace = (lFreeClusters * lSectorsPerCluster * lBytesPerSector) / 1024 dFreeSpace = dFreeSpace / 1000 .FreeSpace = Format(dFreeSpace, "#,###.00") & " MB" End If ' Get the space used by subtracting the free space from the total space If .TotalBytes <> 0 And .FreeBytes <> 0 Then .SpaceUsed = Format(.TotalBytes - .FreeBytes, "#,###.00") & " MB" Else .SpaceUsed = "Unknown" End If ' If both GetDiskFreeSpace and GetDiskFreeSpaceEx fail, it most likely means that ' the drive is a removable drive and is not ready to be read Else .SectorsPerCluster = 0 .BytesPerSector = 0 .TotalBytes = "0" .FreeBytes = "0" .TotalSize = "0 MB" .FreeSpace = "0 MB" .SpaceUsed = "0 MB" End If ' Get the disk volume information DiskVoumeBuffer = String(255, Chr(0)) FileSystemBuffer = String(255, Chr(0)) If GetVolumeInformation(.Path, DiskVoumeBuffer, 255, SerialNum, 255, SystemFlags, FileSystemBuffer, 255) <> 0 Then .VolumeName = Left(DiskVoumeBuffer, InStr(DiskVoumeBuffer, Chr(0)) - 1) .SerialNumber = CStr(Hex((SerialNum And &HFFFF0000) \ &H10000)) & " " & CStr(Hex(SerialNum And &HFFFF&)) .FileSystem = Left(FileSystemBuffer, InStr(FileSystemBuffer, Chr(0)) - 1) End If End With End If Next GetDrives = True Initialized = True End Function Private Function GetFilesAndFolders(ByVal FileName As String, _ ByVal FolderPath As String, _ ByVal SearchSubfolders As Boolean, _ ByVal StopSearchingWhenFound As Boolean, _ ByVal WildCardSearch As Boolean, _ ByRef Return_FileCount As Long, _ ByRef Return_FileNames() As String, _ ByRef Return_FilePaths() As String, _ ByRef Return_FileIsDir() As Boolean) As Boolean On Error GoTo ErrorTrap Dim FileInfo As WIN32_FIND_DATA Dim RootHandle As Long Dim ReturnValue As Long Dim TempFile As String DoEvents If FF_CancelSearch = True Then GetFilesAndFolders = True Exit Function End If ' Make sure the path is in the right format FolderPath = Trim(FolderPath) If Right(FolderPath, 1) = "\" Then FolderPath = Left(FolderPath, Len(FolderPath) - 1) End If ' Make sure the specified path is valid If FolderPath = "" Then Exit Function End If ' Find the first file in the specified folder and get it's infor RootHandle = FindFirstFile(FolderPath & "\*" & Chr(0), FileInfo) ' This line will search for ALL files in the directory specified and all subdirectories too 'RootHandle = FindFirstFile(FolderPath & "\" & FileName & Chr(0), FileInfo) ' This line will search just for specified file, but it won't search subdirectories If RootHandle = INVALID_HANDLE_VALUE Then GetFilesAndFolders = True Exit Function Else ' Get the file info about the first file found GoSub GetInfo GoSub CheckOutInfo Do ' While the return is valid, continue searching DoEvents If FF_CancelSearch = True Then GetFilesAndFolders = True GoTo CleanUp End If ReturnValue = FindNextFile(RootHandle, FileInfo) If ReturnValue <> 0 Then ' Get the info for the current file GoSub GetInfo GoSub CheckOutInfo End If Loop While ReturnValue <> 0 End If GetFilesAndFolders = True CleanUp: FindClose RootHandle Exit Function GetInfo: ' Strip off NULL characters and test the file name TempFile = Left(FileInfo.cFileName, InStr(FileInfo.cFileName, Chr(0)) - 1) If TempFile = "." Or TempFile = ".." Then Return End If ' Increment the file info buffers Return_FileCount = Return_FileCount + 1 ReDim Preserve Return_FileIsDir(1 To Return_FileCount) As Boolean ReDim Preserve Return_FileNames(1 To Return_FileCount) As String ReDim Preserve Return_FilePaths(1 To Return_FileCount) As String ' Get the info and store it in variables for use later Return_FileNames(Return_FileCount) = TempFile Return_FilePaths(Return_FileCount) = FolderPath & "\" & TempFile If (FileInfo.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> 0 Then Return_FileIsDir(Return_FileCount) = True Else Return_FileIsDir(Return_FileCount) = False End If ' Make a call to the "FF_SearchCallback" sub to tell it what the current search item is If Return_FileIsDir(Return_FileCount) = False Then FF_SearchCallback FileName, FolderPath, Return_FileNames(Return_FileCount), WildCardSearch End If Return CheckOutInfo: ' If the user specified to stop searching once the file is found and file matches, exit If Return_FileCount <> 0 Then If (StopSearchingWhenFound = True) And _ (UCase(Return_FileNames(Return_FileCount)) = UCase(FileName)) And _ (Return_FileIsDir(Return_FileCount) = False) Then GetFilesAndFolders = True GoTo CleanUp End If End If ' If the user specified to search subdirectories and one is found, search it too If SearchSubfolders = True Then If (FileInfo.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) <> 0 And _ Left(FileInfo.cFileName, InStr(FileInfo.cFileName, Chr(0)) - 1) <> "." And _ Left(FileInfo.cFileName, InStr(FileInfo.cFileName, Chr(0)) - 1) <> ".." Then If GetFilesAndFolders(FileName, Return_FilePaths(Return_FileCount), SearchSubfolders, StopSearchingWhenFound, WildCardSearch, Return_FileCount, Return_FileNames, Return_FilePaths, Return_FileIsDir) = False Then GoTo CleanUp End If End If End If Return ErrorTrap: If Err.Number = 0 Then ' No Error Resume Next ElseIf Err.Number = 20 Then ' Resume Without Error Resume Next Else ' Unknown Error MsgBox Err.Source & " encountered the following error:" & Chr(13) & Chr(13) & "Error Number = " & CStr(Err.Number) & Chr(13) & "Error Description = " & Err.Description, vbOKOnly + vbExclamation, " Error - " & Err.Description Err.Clear Err.Number = 0 End If End Function Private Function CheckBit(ByVal CheckNumber As Long, ByVal BitPosition As Byte) As Boolean Dim CompareVal As Long Dim MyCounter As Byte ' Make sure BitPosition is valid If (BitPosition < 1) Or (BitPosition > 32) Then Exit Function ' There's a maximum of 26 drives (A - Z), so exit function for any BitPosition greater than 26) ElseIf BitPosition > 26 Then Exit Function End If ' Get compare value For MyCounter = 1 To BitPosition If MyCounter = 1 Then CompareVal = 1 Else CompareVal = CompareVal * 2 End If Next ' Compare the bit If (CheckNumber And CompareVal) <> 0 Then CheckBit = True End If End Function