'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 *.txtPrivate 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 LongConst 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 = &H100Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End TypePrivate 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
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 FunctionFunction FindFilesAPI(path As String, SearchStr As String, FileCount As Integer, DirCount As Integer)
    'KPD-Team 1999
    'E-Mail: [email protected]    Dim FileName As String ' Walking filename variable...
    Dim DirName As String ' SubDirectory Name
    Dim dirNames() As String ' Buffer for directory name entries
    Dim nDir As Integer ' Number of directories in this path
    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 & "\"
    ' Search for subdirectories.
    nDir = 0
    ReDim dirNames(nDir)
    Cont = True
    hSearch = FindFirstFile(path & "*", WFD)
    If hSearch <> INVALID_HANDLE_VALUE Then
        Do While Cont
        DirName = StripNulls(WFD.cFileName)
        ' Ignore the current and encompassing directories.
        If (DirName <> ".") And (DirName <> "..") Then
            ' Check for directory with bitwise comparison.
            If GetFileAttributes(path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
                dirNames(nDir) = DirName
                DirCount = DirCount + 1
                nDir = nDir + 1
                ReDim Preserve dirNames(nDir)
            End If
        End If
        Cont = FindNextFile(hSearch, WFD) 'Get next subdirectory.
        Loop
        Cont = FindClose(hSearch)
    End If
    ' Walk through this directory and sum file sizes.
    hSearch = FindFirstFile(path & SearchStr, WFD)
    Cont = True
    If hSearch <> INVALID_HANDLE_VALUE Then
        While Cont
            FileName = StripNulls(WFD.cFileName)
            If (FileName <> ".") And (FileName <> "..") Then
                FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
                FileCount = FileCount + 1
                List1.AddItem path & FileName
            End If
            Cont = FindNextFile(hSearch, WFD) ' Get next file
        Wend
        Cont = FindClose(hSearch)
    End If
    ' If there are sub-directories...
    If nDir > 0 Then
        ' Recursively walk into them...
        For I = 0 To nDir - 1
            FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(I) & "\", SearchStr, FileCount, DirCount)
        Next I
    End If
End Function
Sub Command1_Click()
    Dim SearchPath As String, FindStr As String
    Dim FileSize As Long
    Dim NumFiles As Integer, NumDirs As Integer
    Screen.MousePointer = vbHourglass
    List1.Clear
    SearchPath = Text1.Text
    FindStr = Text2.Text
    FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
    Text3.Text = NumFiles & " Files found in " & NumDirs + 1 & " Directories"
    Text4.Text = "Size of files found under " & SearchPath & " = " & Format(FileSize, "#,###,###,##0") & " Bytes"
    Screen.MousePointer = vbDefault
End Sub

解决方案 »

  1.   

    使用API都能得到
    Public Declare Function GetFileSecurity Lib "advapi32.dll" Alias "GetFileSecurityA" (ByVal lpFileName As String, ByVal RequestedInformation As Long, pSecurityDescriptor As SECURITY_DESCRIPTOR, ByVal nLength As Long, lpnLengthNeeded As Long) As Long
    Public Declare Function GetFileSize Lib "kernel32" Alias "GetFileSize" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
    Public Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As Long
    Public Declare Function GetFileTime Lib "kernel32" Alias "GetFileTime" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
    Public Declare Function GetFileType Lib "kernel32" Alias "GetFileType" (ByVal hFile As Long) As Long
    Public Type FILETIME
            dwLowDateTime As Long
            dwHighDateTime As Long
    End Type
    Public Type SECURITY_DESCRIPTOR
            Revision As Byte
            Sbz1 As Byte
            Control As Long
            Owner As Long
            Group As Long
            Sacl As ACL
            Dacl As ACL
    End Type
      

  2.   

    Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA" (ByVal lpFileName As String) As LongThe GetFileAttributes function returns attributes for a specified file or directory.&#65399; lpFileName
    Points to a null-terminated string that specifies the name of a file or directory.
    Windows NT:
    There is a default string size limit for paths of MAX_PATH characters. This limit is related to how the GetFileAttributes function parses paths. An application can transcend this limit and send in paths longer than MAX_PATH characters by calling the wide (W) version of GetFileAttributes and prepending 貼\?\&#12539;to the path. The 貼\?\&#12539;tells the function to turn off path parsing; it lets paths longer than MAX_PATH be used with GetFileAttributesW. This also works with UNC names. The 貼\?\&#12539;is ignored as part of the path. For example, 貼\?\C:\myworld\private&#12539;is seen as 鼎:\myworld\private&#12539; and 貼\?\UNC\bill_g_1\hotstuff\coolapps&#12539;is seen as 貼\bill_g_1\hotstuff\coolapps&#12539;
    Windows 95:
    The lpFileName string must not exceed MAX_PATH characters. Windows 95 does not support the 貼\?\&#12539;prefix.'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 *.txtPrivate 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 LongConst 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 = &H100Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
    End TypePrivate 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
    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 FunctionFunction FindFilesAPI(path As String, SearchStr As String, FileCount As Integer, DirCount As Integer)
        'KPD-Team 1999
        'E-Mail: [email protected]
        'URL: http://www.allapi.net/    Dim FileName As String ' Walking filename variable...
        Dim DirName As String ' SubDirectory Name
        Dim dirNames() As String ' Buffer for directory name entries
        Dim nDir As Integer ' Number of directories in this path
        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 & "\"
        ' Search for subdirectories.
        nDir = 0
        ReDim dirNames(nDir)
        Cont = True
        hSearch = FindFirstFile(path & "*", WFD)
        If hSearch <> INVALID_HANDLE_VALUE Then
            Do While Cont
            DirName = StripNulls(WFD.cFileName)
            ' Ignore the current and encompassing directories.
            If (DirName <> ".") And (DirName <> "..") Then
                ' Check for directory with bitwise comparison.
                If GetFileAttributes(path & DirName) And FILE_ATTRIBUTE_DIRECTORY Then
                    dirNames(nDir) = DirName
                    DirCount = DirCount + 1
                    nDir = nDir + 1
                    ReDim Preserve dirNames(nDir)
                End If
            End If
            Cont = FindNextFile(hSearch, WFD) 'Get next subdirectory.
            Loop
            Cont = FindClose(hSearch)
        End If
        ' Walk through this directory and sum file sizes.
        hSearch = FindFirstFile(path & SearchStr, WFD)
        Cont = True
        If hSearch <> INVALID_HANDLE_VALUE Then
            While Cont
                FileName = StripNulls(WFD.cFileName)
                If (FileName <> ".") And (FileName <> "..") Then
                    FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * MAXDWORD) + WFD.nFileSizeLow
                    FileCount = FileCount + 1
                    List1.AddItem path & FileName
                End If
                Cont = FindNextFile(hSearch, WFD) ' Get next file
            Wend
            Cont = FindClose(hSearch)
        End If
        ' If there are sub-directories...
        If nDir > 0 Then
            ' Recursively walk into them...
            For i = 0 To nDir - 1
                FindFilesAPI = FindFilesAPI + FindFilesAPI(path & dirNames(i) & "\", SearchStr, FileCount, DirCount)
            Next i
        End If
    End Function
    Sub Command1_Click()
        Dim SearchPath As String, FindStr As String
        Dim FileSize As Long
        Dim NumFiles As Integer, NumDirs As Integer
        Screen.MousePointer = vbHourglass
        List1.Clear
        SearchPath = Text1.Text
        FindStr = Text2.Text
        FileSize = FindFilesAPI(SearchPath, FindStr, NumFiles, NumDirs)
        Text3.Text = NumFiles & " Files found in " & NumDirs + 1 & " Directories"
        Text4.Text = "Size of files found under " & SearchPath & " = " & Format(FileSize, "#,###,###,##0") & " Bytes"
        Screen.MousePointer = vbDefault
    End Sub
      

  3.   

    'This program needs a Dialog box, named CDBox1
    '  (To add the Common Dialog Box to your tools menu, go to Project->Components (or press CTRL-T)
    '   and select Microsoft Common Dialog control)
    Private Type FILETIME
        dwLowDateTime As Long
        dwHighDateTime As Long
    End Type
    Private Type SHFILEOPSTRUCT
        hWnd As Long
        wFunc As Long
        pFrom As String
        pTo As String
        fFlags As Integer
        fAborted As Boolean
        hNameMaps As Long
        sProgress As String
    End Type
    Private Type SYSTEMTIME
        wYear As Integer
        wMonth As Integer
        wDayOfWeek As Integer
        wDay As Integer
        wHour As Integer
        wMinute As Integer
        wSecond As Integer
        wMilliseconds As Integer
    End Type
    Private Const GENERIC_WRITE = &H40000000
    Private Const OPEN_EXISTING = 3
    Private Const FILE_SHARE_READ = &H1
    Private Const FILE_SHARE_WRITE = &H2
    Private Const FO_DELETE = &H3
    Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
    Private Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" (ByVal lpPathName As String, lpSecurityAttributes As Long) As Long
    Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
    Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
    Private Declare Function GetFileTime Lib "kernel32" (ByVal hFile As Long, lpCreationTime As FILETIME, lpLastAccessTime As FILETIME, lpLastWriteTime As FILETIME) As Long
    Private Declare Function MoveFile Lib "kernel32" Alias "MoveFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String) As Long
    Private Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, lpSecurityAttributes As Long, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
    Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
    Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" (lpFileOp As SHFILEOPSTRUCT) As Long
    Private Declare Function FileTimeToSystemTime Lib "kernel32" (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long
    Private Declare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long
    Private Sub Form_Load()
        'KPD-Team 1998
        'URL: http://www.allapi.net/
        'E-Mail: [email protected]
        Dim lngHandle As Long, SHDirOp As SHFILEOPSTRUCT, lngLong As Long
        Dim Ft1 As FILETIME, Ft2 As FILETIME, SysTime As SYSTEMTIME
        'Set the dialog's title
        CDBox.DialogTitle = "Choose a file ..."
        'Raise an error when the user pressed cancel
        CDBox.CancelError = True
        'Show the 'Open File'-dialog
        CDBox.ShowOpen
        'Create a new directory
        CreateDirectory "C:\KPD-Team", ByVal &H0
        'Copy the selected file to our new directory
        CopyFile CDBox.filename, "C:\KPD-Team\" + CDBox.FileTitle, 0
        'Rename the file
        MoveFile "C:\KPD-Team\" + CDBox.FileTitle, "C:\KPD-Team\test.kpd"
        'Open the file
        lngHandle = CreateFile("C:\KPD-Team\test.kpd", GENERIC_WRITE, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0, 0)
        'Get the file's size
        MsgBox "The size of the selected file is" + Str$(GetFileSize(lngHandle, lngLong)) + " bytes."
        'Get the fil's time
        GetFileTime lngHandle, Ft1, Ft1, Ft2
        'Convert the file time to the local file time
        FileTimeToLocalFileTime Ft2, Ft1
        'Convert the file time to system file time
        FileTimeToSystemTime Ft1, SysTime
        MsgBox "The selected file was created on" + Str$(SysTime.wMonth) + "/" + Ltrim(Str$(SysTime.wDay)) + "/" + Ltrim(Str$(SysTime.wYear))
        'Close the file
        CloseHandle lngHandle
        'Delete the file
        DeleteFile "C:\KPD-Team\test.kpd"
        With SHDirOp
            .wFunc = FO_DELETE
            .pFrom = "C:\KPD-Team"
        End With
        'Delete the directory
        SHFileOperation SHDirOp
        End
    End Sub
      

  4.   

    to playyuer(女㊣爱)
    如何使用fso