home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Chip 1999 May
/
Chip_1999-05_cd.bin
/
zkuste
/
vbasic
/
Data
/
Priklady
/
findfile.bas
< prev
next >
Wrap
BASIC Source File
|
1999-02-22
|
3KB
|
94 lines
Attribute VB_Name = "Module1"
Public Const MAX_PATH = 260
Private Const INVALID_HANDLE_VALUE = -1
Private Const FILE_ATTRIBUTE_DIRECTORY = &H10
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 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
Public Sub FindFiles(strRootFolder As String, strFolder As String, strFile As String, colFilesFound As Collection)
Dim lngSearchHandle As Long
Dim udtFindData As WIN32_FIND_DATA
Dim strTemp As String, lngRet As Long
'Check that folder name ends with "\"
If Right$(strRootFolder, 1) <> "\" Then strRootFolder = strRootFolder & "\"
'Find first file/folder in current folder
lngSearchHandle = FindFirstFile(strRootFolder & "*", udtFindData)
'Check that we received a valid handle
If lngSearchHandle = INVALID_HANDLE_VALUE Then Exit Sub
lngRet = 1
Do While lngRet <> 0
'Trim nulls from filename
strTemp = TrimNulls(udtFindData.cFileName)
If (udtFindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY Then
'It's a dir - make sure it isn't . or .. dirs
If strTemp <> "." And strTemp <> ".." Then
'It's a normal dir: let's dive straight
'into it...
Call FindFiles(strRootFolder & strTemp, strFolder, strFile, colFilesFound)
End If
Else
'It's a file. First check if the current folder matches
'the folder path in strFolder
If (strRootFolder Like strFolder) Then
'Folder matches, what about file?
If (strTemp Like strFile) Then
'Found one!
colFilesFound.Add strRootFolder & strTemp
End If
End If
End If
'Get next file/folder
lngRet = FindNextFile(lngSearchHandle, udtFindData)
Loop
'Close find handle
Call FindClose(lngSearchHandle)
End Sub
Public Function TrimNulls(strString As String) As String
Dim l As Long
l = InStr(1, strString, Chr(0))
If l = 1 Then
TrimNulls = ""
ElseIf l > 0 Then
TrimNulls = Left$(strString, l - 1)
Else
TrimNulls = strString
End If
End Function