浏览器

开发平台：
Visual Basic

mFindFile.bas：源码内容
							Attribute VB_Name = "mFindFile"
Option Explicit
'Create a form with a command button (command1), a list box (list1)
'and four text boxes (text1, text2, text3 and text4).
'Type in the first textbox a startingpath like c:
'and in the second textbox you put a pattern like *.* or *.txt
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 GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As Long) As Long
'Private Declare Function PathFileExists Lib "shlwapi.dll" Alias "PathFileExistsA" (ByVal pszPath As String) As Long
Const MAX_PATH = 260
Const MAXDWORD = &HFFFF
Const INVALID_HANDLE_VALUE = -1
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_TEMPORARY = &H100
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 Function StripNulls(OriginalStr As String) As String
    If (InStr(OriginalStr, Chr(0)) > 0) Then
        OriginalStr = Left(OriginalStr, InStr(OriginalStr, Chr(0)) - 1)
    End If
    StripNulls = OriginalStr
End Function
'---------------------------------------------------------------------------------------
' Procedure : FindFilesAPI
' DateTime  : 2005-4-19 01:19
' Author    : Lingll
' Purpose   : 查找文件
'---------------------------------------------------------------------------------------
Public Function FindFilesAPI(path$, SearchStr$, _
        FileCount&, FileNames() As String, ForFile As Boolean, Optional getHidden As Boolean = True)
    'KPD-Team 1999
    'E-Mail: KPDTeam@Allapi.net
    'URL: http://www.allapi.net/
    Dim FileName As String ' Walking filename variable...
'    Dim i As Integer ' For-loop counter...
    Dim hSearch As Long ' Search Handle
    Dim WFD As WIN32_FIND_DATA
    Dim Cont As Integer
    If Right(path, 1) <> "" Then path = path & ""
    FileCount = 0
    ReDim FileNames(0 To FileCount)
    ' Walk through this directory and sum file sizes.
    hSearch = FindFirstFile(path & SearchStr, WFD)
    Cont = True
    If hSearch <> INVALID_HANDLE_VALUE Then
        While Cont
            If ForFile Then
                If WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
                Else
                    If getHidden Or ((WFD.dwFileAttributes And FILE_ATTRIBUTE_HIDDEN) = 0) Then
                        FileName = StripNulls(WFD.cFileName)
                        If (FileName <> ".") And (FileName <> "..") Then
                            FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
                            FileCount = FileCount + 1
                            ReDim Preserve FileNames(0 To FileCount)
                            FileNames(FileCount) = FileName
                        End If
                    End If
                End If
            Else
                If WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY Then
                    If getHidden Or ((WFD.dwFileAttributes And FILE_ATTRIBUTE_HIDDEN) = 0) Then
                        FileName = StripNulls(WFD.cFileName)
                        If (FileName <> ".") And (FileName <> "..") Then
                            FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
                            FileCount = FileCount + 1
                            ReDim Preserve FileNames(0 To FileCount)
                            FileNames(FileCount) = FileName
                        End If
                    End If
                End If
            End If
            
            Cont = FindNextFile(hSearch, WFD) ' Get next file
        Wend
        Cont = FindClose(hSearch)
    End If
End Function
'---------------------------------------------------------------------------------------
' Procedure : FileExist
' DateTime  : 2005-4-18 22:42
' Author    : Lingll
' Purpose   : 判断文件(夹)是否存在
'---------------------------------------------------------------------------------------
Public Function FileExist(FileName As String, Optional ForFile As Boolean = True) As Boolean
    Dim hSearch As Long ' Search Handle
    Dim WFD As WIN32_FIND_DATA
    Dim rtn As Boolean
    hSearch = FindFirstFile(FileName, WFD)
    rtn = False
    If hSearch = INVALID_HANDLE_VALUE Then
        If Not ForFile Then
            rtn = DriveExist(FileName)
        End If
    Else
        If GetFileAttributes(FileName) And FILE_ATTRIBUTE_DIRECTORY Then
            rtn = Not ForFile
        Else
            rtn = ForFile
        End If
        Call FindClose(hSearch)
    End If
    FileExist = rtn
End Function
'---------------------------------------------------------------------------------------
' Procedure : DriveExist
' DateTime  : 2005-4-18 22:17
' Author    : Lingll
' Purpose   : 判断某个逻辑盘是否存在
'---------------------------------------------------------------------------------------
Public Function DriveExist(ByVal vDriveName As String) As Boolean
Dim tBff() As Byte
Dim tDrv() As String
Dim tLen&
Dim i&, ub&
Select Case Len(vDriveName)
    Case 1
        vDriveName = vDriveName & ":"
    Case 2
        vDriveName = vDriveName & ""
    Case 3
    Case Else
        DriveExist = False
        Exit Function
End Select
ReDim tBff(0 To 256)
tLen = GetLogicalDriveStrings(256, VarPtr(tBff(0)))
ReDim Preserve tBff(0 To tLen - 2)
tDrv = Split(StrConv(tBff, vbUnicode), vbNullChar)
ub = UBound(tDrv)
vDriveName = LCase(vDriveName)
DriveExist = False
For i = 0 To ub
    If LCase$(tDrv(i)) = vDriveName Then
        DriveExist = True
        Exit For
    End If
Next i
End Function

						