home *** CD-ROM | disk | FTP | other *** search
/ Chip 1999 May / Chip_1999-05_cd.bin / zkuste / vbasic / Data / Priklady / findfile.bas < prev    next >
BASIC Source File  |  1999-02-22  |  3KB  |  94 lines

  1. Attribute VB_Name = "Module1"
  2. Public Const MAX_PATH = 260
  3. Private Const INVALID_HANDLE_VALUE = -1
  4. Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
  5.  
  6. Private Type FILETIME
  7.    dwLowDateTime As Long
  8.    dwHighDateTime As Long
  9. End Type
  10.  
  11. Private Type WIN32_FIND_DATA
  12.    dwFileAttributes As Long
  13.    ftCreationTime As FILETIME
  14.    ftLastAccessTime As FILETIME
  15.    ftLastWriteTime As FILETIME
  16.    nFileSizeHigh As Long
  17.    nFileSizeLow As Long
  18.    dwReserved0 As Long
  19.    dwReserved1 As Long
  20.    cFileName As String * MAX_PATH
  21.    cAlternate As String * 14
  22. End Type
  23.  
  24. Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
  25. Private Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
  26. Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
  27.  
  28. Public Sub FindFiles(strRootFolder As String, strFolder As String, strFile As String, colFilesFound As Collection)
  29.  
  30.     Dim lngSearchHandle As Long
  31.     Dim udtFindData As WIN32_FIND_DATA
  32.     Dim strTemp As String, lngRet As Long
  33.         
  34.     'Check that folder name ends with "\"
  35.     If Right$(strRootFolder, 1) <> "\" Then strRootFolder = strRootFolder & "\"
  36.     
  37.     'Find first file/folder in current folder
  38.     lngSearchHandle = FindFirstFile(strRootFolder & "*", udtFindData)
  39.     
  40.     'Check that we received a valid handle
  41.     If lngSearchHandle = INVALID_HANDLE_VALUE Then Exit Sub
  42.     
  43.     lngRet = 1
  44.     
  45.     Do While lngRet <> 0
  46.         
  47.         'Trim nulls from filename
  48.         strTemp = TrimNulls(udtFindData.cFileName)
  49.         
  50.         If (udtFindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
  51.             'It's a dir - make sure it isn't . or .. dirs
  52.             If strTemp <> "." And strTemp <> ".." Then
  53.                 'It's a normal dir: let's dive straight
  54.                 'into it...
  55.                 Call FindFiles(strRootFolder & strTemp, strFolder, strFile, colFilesFound)
  56.             End If
  57.         Else
  58.             'It's a file. First check if the current folder matches
  59.             'the folder path in strFolder
  60.             If (strRootFolder Like strFolder) Then
  61.                 'Folder matches, what about file?
  62.                 If (strTemp Like strFile) Then
  63.                     'Found one!
  64.                     colFilesFound.Add strRootFolder & strTemp
  65.                 End If
  66.             End If
  67.         End If
  68.         
  69.         'Get next file/folder
  70.         lngRet = FindNextFile(lngSearchHandle, udtFindData)
  71.         
  72.     Loop
  73.     
  74.     'Close find handle
  75.     Call FindClose(lngSearchHandle)
  76.     
  77. End Sub
  78.  
  79. Public Function TrimNulls(strString As String) As String
  80.    
  81.    Dim l As Long
  82.    
  83.    l = InStr(1, strString, Chr(0))
  84.    
  85.    If l = 1 Then
  86.       TrimNulls = ""
  87.    ElseIf l > 0 Then
  88.       TrimNulls = Left$(strString, l - 1)
  89.    Else
  90.       TrimNulls = strString
  91.    End If
  92.    
  93. End Function
  94.