Finds the file on any connected drive

Category:

Files and Directories

Type:

Snippets

Difficulty:

Advanced

Author: Waty

Version Compatibility:

More information:

Send this class only a filename And it finds the file on *any* connected drive. No need To send a full path! It searches the local hard drive, connected network drives, etc. You even have the Option of choosing whether Or Not you want to include the floppy, CD-Rom, Or remote drive(s) In the search.

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
' (None)

Code:

' #VBIDEUtils#************************************************************
' * Programmer Name  : Adrian Maull
' * Web Site         : www.geocities.com/ResearchTriangle/6311/
' * E-Mail           : adrianm@zebra.net
' * Date             : 28/06/99
' * Time             : 12:48
' **********************************************************************
' * Comments         : Finds the file on *any* connected drive
' *
' * Send this class only a filename And it finds the file
' * On *any* connected drive. No need To send a full path!
' * It searches the local hard drive, connected network drives, etc.
' * You even have the Option of choosing whether Or Not you want
' * To include the floppy, CD-Rom, Or remote drive(s) In the search.
' * If you don't download anything else you've got to get this one!
' *
' **********************************************************************

Option Explicit

'private consts

Private Const MAX_PATH = 260
Private Const SLASH = "\"
Private Const VB_EMPTYSTRING = ""

'GetDriveType return values
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6
'------------------------------------------------------------------

'private types

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 declares

Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
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 members

Private msDriveArray()  As String
Private mbSkipFloppy    As Boolean
Private mbSkipCD        As Boolean
Private mbSkipRemote    As Boolean
Private mbStopFlag      As Boolean
Private msFullPath      As String  'this only gets set in StartSearch if path is found

Public Property Let SkipFloppy(b As Boolean)
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 27/04/99
   ' * Time             : 14:12
   ' * Module Name      : class_Search
   ' * Module Filename  : Search.cls
   ' * Procedure Name   : SkipFloppy
   ' * Parameters       :
   ' *                    b As Boolean
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************

mbSkipFloppy = b
End Property

Public Property Let SkipCD(b As Boolean)
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 27/04/99
   ' * Time             : 14:12
   ' * Module Name      : class_Search
   ' * Module Filename  : Search.cls
   ' * Procedure Name   : SkipCD
   ' * Parameters       :
   ' *                    b As Boolean
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************

mbSkipCD = b
End Property

Public Property Let SkipRemote(b As Boolean)
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 27/04/99
   ' * Time             : 14:12
   ' * Module Name      : class_Search
   ' * Module Filename  : Search.cls
   ' * Procedure Name   : SkipRemote
   ' * Parameters       :
   ' *                    b As Boolean
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************

mbSkipRemote = b
End Property

Private Sub GetSystemDrives()
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 27/04/99
   ' * Time             : 14:12
   ' * Module Name      : class_Search
   ' * Module Filename  : Search.cls
   ' * Procedure Name   : GetSystemDrives
   ' * Parameters       :
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************

Dim sDrives          As String
   Dim sCurrentDrive    As String
   Dim lUbound          As Long
   Dim lIndex           As Long
   Dim lret             As Long

ReDim msDriveArray(0)
   lIndex = 0

sDrives = GetDrives()

Do Until sDrives = Chr$(0)

'strip off one drive item from the sDrives$
      sCurrentDrive = StripNulls(sDrives)

'check to see if drive is fixed...
      lret = GetDriveType(sCurrentDrive)

'could place the reptitious in-line code below with a
      'function or procedure but it's only four cases and in-line
      'code runs faster...
      Select Case lret
         Case DRIVE_REMOVABLE
            If Not mbSkipFloppy Then
               'add to the drive array
               msDriveArray(lIndex) = sCurrentDrive
               lIndex = lIndex + 1
               lUbound = UBound(msDriveArray)
               ReDim Preserve msDriveArray(lUbound + 1)
            End If
         Case DRIVE_FIXED
            msDriveArray(lIndex) = sCurrentDrive
            lIndex = lIndex + 1
            lUbound = UBound(msDriveArray)
            ReDim Preserve msDriveArray(lUbound + 1)
         Case DRIVE_REMOTE
            'take into account the skip options
            If Not mbSkipRemote Then
               msDriveArray(lIndex) = sCurrentDrive
               lIndex = lIndex + 1
               lUbound = UBound(msDriveArray)
               ReDim Preserve msDriveArray(lUbound + 1)
            End If
         Case DRIVE_CDROM
            If Not mbSkipCD Then
               msDriveArray(lIndex) = sCurrentDrive
               lIndex = lIndex + 1
               lUbound = UBound(msDriveArray)
               ReDim Preserve msDriveArray(lUbound + 1)
            End If
      End Select
   Loop

End Sub

Private Function GetDrives() As String
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 27/04/99
   ' * Time             : 14:12
   ' * Module Name      : class_Search
   ' * Module Filename  : Search.cls
   ' * Procedure Name   : GetDrives
   ' * Parameters       :
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************

'returns a single string of available drive
   'letters, each separated by a chr$(0)

Dim lret             As Long
   Dim sTmp             As String

sTmp = Space$(255)
   lret = GetLogicalDriveStrings(Len(sTmp), sTmp)

GetDrives = Trim$(sTmp)

End Function

Private Function StripNulls(sStringIn As String) As String
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 27/04/99
   ' * Time             : 14:12
   ' * Module Name      : class_Search
   ' * Module Filename  : Search.cls
   ' * Procedure Name   : StripNulls
   ' * Parameters       :
   ' *                    sStringIn As String
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************

'Take a string separated by a chr$(0), and split off 1 item, and
   'shorten the string so that the next item is ready for removal.

Dim iPos As Integer

iPos = InStr(sStringIn, Chr$(0))

If iPos Then
      StripNulls = Mid$(sStringIn, 1, iPos - 1)
      sStringIn = Mid$(sStringIn, iPos + 1, Len(sStringIn))
      Exit Function
   Else
      sStringIn = Trim$(sStringIn)
   End If

End Function

Public Function FindFullPath(sFileToRun As String) As String
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 27/04/99
   ' * Time             : 14:12
   ' * Module Name      : class_Search
   ' * Module Filename  : Search.cls
   ' * Procedure Name   : FindFullPath
   ' * Parameters       :
   ' *                    sFileToRun As String
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************

'this is the function exposed to the world.  Accepts a full
   'path to a file.

Dim l As Long
   Dim lUbound As Long

'find all drives to build the drive array
   GetSystemDrives

lUbound = UBound(msDriveArray)
   If lUbound = 0 Then Exit Function

'search all the drives in the array for the file wanted
   For l = 0 To lUbound - 1
      If mbStopFlag Then Exit For
      StartSearch msDriveArray(l), sFileToRun
   Next

'this is an empty string if the file was not found
   FindFullPath = msFullPath

End Function

Private Function StartSearch(sPathIn As String, sFileToRun As String) As String
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 27/04/99
   ' * Time             : 14:12
   ' * Module Name      : class_Search
   ' * Module Filename  : Search.cls
   ' * Procedure Name   : StartSearch
   ' * Parameters       :
   ' *                    sPathIn As String
   ' *                    sFileToRun As String
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************

'In this search routine I ReDim the file array every 50 items.
   'That way I don't have to ReDim Preserve for every item added to
   'the array -- that's slow.

Dim sFileArray()     As String
   Dim wfdStruct        As WIN32_FIND_DATA
   Dim hFile            As Long
   Dim sFile            As String
   Dim sPath            As String
   Dim i                As Integer
   Dim iFound           As Integer
   Dim lret             As Long

'find the first file matching the parameter .*
   hFile = FindFirstFile(sPathIn & "*.*" & Chr$(0), wfdStruct)

iFound = 0
   ReDim sFileArray(50)

If hFile <> -1 Then
      sFile = StripNulls(wfdStruct.cFileName)

'check for file match here.  I had to add this code here
      'because on floppies the file wanted may be the very
      'first one...
      If UCase(sFile) = UCase(sFileToRun) Then
         'this is it; flag stop true; assign path to
         'function
         mbStopFlag = True
         msFullPath = sPathIn & sFile
         Exit Function
      End If

wfdStruct.dwFileAttributes = vbDirectory

While FindNextFile(hFile, wfdStruct)

sFile = StripNulls(wfdStruct.cFileName)

'ignore the 2 standard root entries
         If (sFile <> ".") And (sFile <> "..") Then

If (wfdStruct.dwFileAttributes And vbDirectory) Then

iFound = iFound + 1
               'if iFound is at 50, then add some more array elements
               If iFound Mod 50 = 0 Then ReDim Preserve sFileArray(iFound + 50)

sFileArray(iFound) = sPathIn & sFile
            Else
               If UCase(sFile) = UCase(sFileToRun) Then
                  'this is it; flag stop true; assign path to
                  'function
                  mbStopFlag = True
                  msFullPath = sPathIn & sFile
                  Exit Function
               End If
            End If
         End If
      Wend
   End If

lret = FindClose(hFile)

'trim down the array to equal the elements found...
   ReDim Preserve sFileArray(iFound)

'recursion is necessary to search all subfolders...
   For i = 1 To iFound
      '...unless I already found the file
      If mbStopFlag Then Exit For
      sPath = sFileArray(i) & SLASH
      StartSearch sPath, sFileToRun
   Next

End Function

Private Sub Class_Initialize()
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 27/04/99
   ' * Time             : 14:12
   ' * Module Name      : class_Search
   ' * Module Filename  : Search.cls
   ' * Procedure Name   : Class_Initialize
   ' * Parameters       :
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************

'init the skip drive bools
   mbSkipFloppy = True
   mbSkipCD = True

'just making sure...
   mbStopFlag = False

msFullPath = VB_EMPTYSTRING

End Sub

Private Sub Class_Terminate()
   ' #VBIDEUtils#************************************************************
   ' * Programmer Name  : Waty Thierry
   ' * Web Site         : www.geocities.com/ResearchTriangle/6311/
   ' * E-Mail           : waty.thierry@usa.net
   ' * Date             : 27/04/99
   ' * Time             : 14:12
   ' * Module Name      : class_Search
   ' * Module Filename  : Search.cls
   ' * Procedure Name   : Class_Terminate
   ' * Parameters       :
   ' **********************************************************************
   ' * Comments         :
   ' *
   ' *
   ' **********************************************************************

'free array space used
   ReDim msDriveArray(0)

End Sub