如何将某个目录下的某一类文件全部查询出来?

http://vb110.myrice.com/text/file/53.HTM

Method 1: Using the Windows API
Start a new Standard EXE project in Visual Basic. Form1 is created by default.
Add a CommandButton named Command1, four TextBoxes named Text1, Text2, Text3 and Text4 and a ListBox to Form1.
Add a Module from the Projects menu and insert the following:   Declare Function FindFirstFile Lib "kernel32" Alias _
   "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData _
   As WIN32_FIND_DATA) As Long   Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
   (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long   Declare Function GetFileAttributes Lib "kernel32" Alias _
   "GetFileAttributesA" (ByVal lpFileName As String) As Long   Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) _
   As Long   Declare Function FileTimeToLocalFileTime Lib "kernel32" _
   (lpFileTime As FILETIME, lpLocalFileTime As FILETIME) As Long

   Declare Function FileTimeToSystemTime Lib "kernel32" _
   (lpFileTime As FILETIME, lpSystemTime As SYSTEMTIME) As Long   Public Const MAX_PATH = 260
   Public Const MAXDWORD = &HFFFF
   Public Const INVALID_HANDLE_VALUE = -1
   Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
   Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
   Public Const FILE_ATTRIBUTE_HIDDEN = &H2
   Public Const FILE_ATTRIBUTE_NORMAL = &H80
   Public Const FILE_ATTRIBUTE_READONLY = &H1
   Public Const FILE_ATTRIBUTE_SYSTEM = &H4
   Public Const FILE_ATTRIBUTE_TEMPORARY = &H100   Type FILETIME
     dwLowDateTime As Long
     dwHighDateTime As Long
   End Type   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   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   Public 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

Copy the following code into Form1's module:   Option Explicit   Function FindFilesAPI(path As String, SearchStr As String, _
    FileCount As Integer, DirCount As Integer)
   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
   Dim FT As FILETIME
   Dim ST As SYSTEMTIME
   Dim DateCStr As String, DateMStr As String

   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)
               ' Uncomment the next line to list directories
               'List1.AddItem path & FileName
            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 <> "..") And _
              ((GetFileAttributes(path & FileName) And _
               FILE_ATTRIBUTE_DIRECTORY) <> FILE_ATTRIBUTE_DIRECTORY) Then
            FindFilesAPI = FindFilesAPI + (WFD.nFileSizeHigh * _
             MAXDWORD) + WFD.nFileSizeLow
            FileCount = FileCount + 1
            ' To list files w/o dates, uncomment the next line
            ' and remove or Comment the lines down to End If
            'List1.AddItem path & FileName

           ' Include Creation date...
           FileTimeToLocalFileTime WFD.ftCreationTime, FT
           FileTimeToSystemTime FT, ST
           DateCStr = ST.wMonth & "/" & ST.wDay & "/" & ST.wYear & _
              " " & ST.wHour & ":" & ST.wMinute & ":" & ST.wSecond
           ' and Last Modified Date
           FileTimeToLocalFileTime WFD.ftLastWriteTime, FT
           FileTimeToSystemTime FT, ST
           DateMStr = ST.wMonth & "/" & ST.wDay & "/" & ST.wYear & _
              " " & ST.wHour & ":" & ST.wMinute & ":" & ST.wSecond
           List1.AddItem path & FileName & vbTab & _
              Format(DateCStr, "mm/dd/yyyy hh:nn:ss") _
              & vbTab & Format(DateMStr, "mm/dd/yyyy hh:nn:ss")
          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   Private 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

Run the Project. Enter a starting path into Text1, a search string in Text2 (like *.* or *.txt) and then click Command1.
You will see a list of the files found display in the ListBox with the create date and the last modified date, the actual number of files found displays in Text3, and the total size of the files found under the starting directory appears in Text4.
Method 2: Using Built-In Visual Basic Functions
These instructions build on the sample described prior, but can also be used in a new Project.
Open the Project by using the steps described in Method1
Add another CommandButton named Command2, two more TextBoxes named Text5 and Text6 and another ListBox, List2, to Form1.
Copy the following code into Form1's module:   Function FindFiles(path As String, SearchStr As String, _
       FileCount As Integer, DirCount As Integer)
      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.      On Error GoTo sysFileERR
      If Right(path, 1) <> "\" Then path = path & "\"
      ' Search for subdirectories.
      nDir = 0
      ReDim dirNames(nDir)
      DirName = Dir(path, vbDirectory Or vbHidden Or vbArchive Or vbReadOnly _
Or vbSystem)  ' Even if hidden, and so on.
      Do While Len(DirName) > 0
         ' Ignore the current and encompassing directories.
         If (DirName <> ".") And (DirName <> "..") Then
            ' Check for directory with bitwise comparison.
            If GetAttr(path & DirName) And vbDirectory Then
               dirNames(nDir) = DirName
               DirCount = DirCount + 1
               nDir = nDir + 1
               ReDim Preserve dirNames(nDir)
               'List2.AddItem path & DirName ' Uncomment to list
            End If                           ' directories.
   sysFileERRCont:
         End If
         DirName = Dir()  ' Get next subdirectory.
      Loop      ' Search through this directory and sum file sizes.
      FileName = Dir(path & SearchStr, vbNormal Or vbHidden Or vbSystem _
      Or vbReadOnly Or vbArchive)
      While Len(FileName) <> 0
         FindFiles = FindFiles + FileLen(path & FileName)
         FileCount = FileCount + 1
         ' Load List box
         List2.AddItem path & FileName & vbTab & _
            FileDateTime(path & FileName)   ' Include Modified Date
         FileName = Dir()  ' Get next file.
      Wend      ' If there are sub-directories..
      If nDir > 0 Then
         ' Recursively walk into them
         For i = 0 To nDir - 1
           FindFiles = FindFiles + FindFiles(path & dirNames(i) & "\", _
            SearchStr, FileCount, DirCount)
         Next i
      End If   AbortFunction:
      Exit Function
   sysFileERR:
      If Right(DirName, 4) = ".sys" Then
        Resume sysFileERRCont ' Known issue with pagefile.sys
      Else
        MsgBox "Error: " & Err.Number & " - " & Err.Description, , _
         "Unexpected Error"
        Resume AbortFunction
      End If
      End Function      Private Sub Command2_Click()
      Dim SearchPath As String, FindStr As String
      Dim FileSize As Long
      Dim NumFiles As Integer, NumDirs As Integer      Screen.MousePointer = vbHourglass
      List2.Clear
      SearchPath = Text1.Text
      FindStr = Text2.Text
      FileSize = FindFiles(SearchPath, FindStr, NumFiles, NumDirs)
      Text5.Text = NumFiles & " Files found in " & NumDirs + 1 & _
       " Directories"
      Text6.Text = "Size of files found under " & SearchPath & " = " & _
      Format(FileSize, "#,###,###,##0") & " Bytes"
      Screen.MousePointer = vbDefault
      End Sub   Private Sub Form_Load()
      Command1.Caption = "Use API code"
      Command2.Caption = "Use VB code"
      ' start with some reasonable defaults
      Text1.Text = "C:\My Documents\"
      Text2.Text = "*.*"
   End Sub

Run the Project. Enter a starting path into Text1, a search string in Text2 (like *.* or Myfile?.txt, and so forth) and then click Command2.
You see a list of the files found appear in List2 with the last modified date, the number of files found in Text5, and the total size of the files found under the starting directory in Text6. By combining these two methods on one form you can verify that both methods return matching information.
Method 3: Use the FileSystem Object with Visual Basic

'刚做了个删除文件的函数，方法都差不多，自己看吧，注意先要加filesystem的引用
'0 删除目录
'1删除该目录下的文件
'2,删除指定类型文件
Public Sub DelAppointFiles(ByVal folder As String, ByVal tp As Integer, Optional ByVal force As Boolean, Optional ByVal extend As String)
On Error GoTo ERR
    Dim Cfso As FileSystemObject '´´Á¢ÎÄ¼þ¶ÔÏó
    Dim CFolder As folder
    Dim CSubFolder As folder
    Dim Cfile As file
    Dim strOut() As String

    Set Cfso = CreateObject("scripting.filesystemobject")    If Cfso.FolderExists(folder) = False Then GoTo ERR
    Set CFolder = Cfso.GetFolder(folder)
    If CFolder Is Nothing Then GoTo ERR

    If tp = 0 Then 'É¾³ýÎÄ¼þ¼Ð
        CFolder.Delete force
    ElseIf tp = 1 Then 'É¾³ýÄ¿Â¼ÏÂËùÓÐÎÄ¼þ

        'ÏÈ´¦ÀíÎÄ¼þ
        For Each Cfile In CFolder.Files
            If Cfile Is Nothing Then Exit For
            Cfile.Delete force
        Next
        'ÔÙ´¦Àí×ÓÎÄ¼þ¼Ð
        For Each CSubFolder In CFolder.SubFolders
            If CSubFolder Is Nothing Then Exit For
            DelAppointFiles CSubFolder.Path, tp, force
        Next
    ElseIf tp = 2 Then 'É¾³ýÖ¸¶¨À©Õ¹ÃûµÄÎÄ¼þ
        'ÏÈ´¦ÀíÎÄ¼þ
        For Each Cfile In CFolder.Files
            If Cfile Is Nothing Then Exit For
            If extend <> "" Then 'ÓÐÑ¡ÔñÉ¾³ý
                AnalyzeStringEx Cfile.Name, ".", strOut
                If UBound(strOut) > 1 Then
                    If UCase(strOut(UBound(strOut))) = UCase(extend) Then
                        Cfile.Delete force
                    End If
                End If
            Else 'Ã»ÓÐºó×ºµÄ
                AnalyzeStringEx Cfile.Name, ".", strOut
                If UBound(strOut) = 1 Then
                    Cfile.Delete force
                End If
            End If
        Next
        'ÔÙ´¦Àí×ÓÎÄ¼þ¼Ð
        For Each CSubFolder In CFolder.SubFolders
            If CSubFolder Is Nothing Then Exit For
            DelAppointFiles CSubFolder.Path, tp, force, extend
        Next
    End If
ERR:
    Erase strOut
    Set Cfile = Nothing
    Set CFolder = Nothing
    Set Cfso = Nothing
End Sub

Public Function GetDirFile(strPath As String, _
astrDir() As String, _
astrFile() As String, _
Optional blnSaveDirTo0 As Boolean = False)
'Purpose : Read all subfolders and subfiles in given path.
On Error GoTo PROC_ERR
Dim lngDirCount As Long
Dim lngFileCount As Long
ReDim astrDir(0)
ReDim astrFile(0)
If blnSaveDirTo0 Then
lngDirCount = 1
lngFileCount = 1
End If
Dim strDir As String
Dim strPathName As String
strPathName = strPath
MakePath strPathName

strDir = Dir(strPathName, 31)
Do While strDir <> ""

      If strDir <> "." Or strDir <> ".." Then
                    If IsDirName(strPathName & strDir) Then
                        ReDim Preserve astrDir(lngDirCount)
                        astrDir(lngDirCount) = strDir
                        lngDirCount = lngDirCount + 1

                    Else
                        ReDim Preserve astrFile(lngFileCount)
                        astrFile(lngFileCount) = strDir
                        lngFileCount = lngFileCount + 1
                    End If

           End If

       strDir = Dir

LoopDebug.Print strPathName
If blnSaveDirTo0 Then
astrDir(0) = strPath
astrFile(0) = strPath
End IfPROC_EXIT:
Exit Function
PROC_ERR:
GetDirFile = Err.NumberEnd Function
'***********************************************************
Public Function IsDirName(strPath As String) As Boolean
'Purpose : Judge If the given string is a available directory.
On Error GoTo PROC_ERR
       Dim blnCheck As Boolean
       blnCheck = GetAttr(strPath) And vbDirectory
       IsDirName = blnCheck

PROC_EXIT:
Exit Function
PROC_ERR:
IsDirName = False
End Function我希望这两个过程能够解决你的问题。广告：我的第一个Visual Basic 6.0作品，欢迎大家试用,注册用户得到全部源代码。一、EasyDialog能够做什么？
(为了增强Windows通用打开/保存对话框，能够快速的打开经常访问的文件夹或者文件）
一、快速地在通用打开/保存对话框中打开你经常访问的文件夹/文件。
二、快速地在Windows Explorer中打开经常访问的文件夹/文件。
三、快速地在IE浏览器打开你经常访问的网站。
四、快速地给你的朋友发Email
五、能够使您方便地按照逻辑分类来组织和管理您的文件夹/文件，您经常访问的网址，您的Email地址。'********************************************
'*下载EasyDialog:
http://www.softboyzhou.com/download/EasyDialog.asp
'***************
'*购买EasyDialog:
http://www.softreg.com.cn/shareware_view.asp?id=/7148D197-1C1D-4E84-B92A-EE2CC07D27C0/
'***************
'*给我写信：有什么问题请来信。
[email protected]
'********************************************
*为什么我要对注册用户提供源代码呢？
当我把我的第一个软件作品发布之后。给我的一些朋友发了一封信。信的大致内容是：我刚用Visual Basic 6.0搞了一个软件
，希望你们能够下载试用。你们觉得会有人来买这个软件吗？你们觉得我的定价是不是合适呢？
于是朋友们反馈回来的信息是：
有的朋友说：软件不错，不过可能市场前景不好，因为市场上有许多同类软件。
有的朋友说：定价也不是很高。如果你想让很多的人来购买，你必须要找到合适的买主。也就是那些需要你的软件的人。
有的朋友开玩笑说：我也想学Visual Basic 6.0。不如这样吧！我去注册一份，你把源代码给我吧！
我有些激动：源代码！你知道这些源代码有多少Module,Class.
我些是我的全部心血，如果我都给你，我还凭什么混饭吃。
这个朋友半认真的说：老兄不要激动，我只是和你开玩笑的。我知道你的那些源代码的价值。不过有一句话"人生最美丽的补偿之一，就是人们真诚地帮助别人之后，同时也帮助了自己"。道理很简单：如果你的软件不能够解决别人的问题，别人怎么会来购买呢？。我也知道你现在需要一些资金来运转,你的网站太简陋，我看得请了美术设计帮你弄一弄，你的产品也该做做广告。不如把源代码提供给那些真真需要它的人吧，你帮助了别人，同时也帮助了自己。你的源代码不管是对于初学者，还是那些想提高的朋友都是非常有价值的。我也发现你很有灵感和创意。例如你的网站就是一简单的例子，你刚学了ASP，就搞了一个"无代码解决方案"。那天你写信告诉我，说你的网站开通了，让我去看看,觉得怪怪的。后来你说，你觉得网站更新很麻烦，你的"无代码解决方案"（三个ASP文件 Default.asp,Dir.asp,Content.asp)就是自动根据网站的目录结构来建立动态的页面，这样就使一个网站很像一个Windows的资源管理器。如果你能够让你的灵感和创意来帮助其他的人来解决他们的问题，那些热心善良的人也会来帮助你的。
听了朋友的话，我久久地不能平静："人生最美丽的补偿之一，就是人们真诚地帮助别人之后，同时也帮助了自己"
'********************************************'*我的决定
面对下一个问题，做一个决定，做任何决定都好，任何决定总比没有决定好。
于是我决定：对于购买了EasyDialog的朋友，开放它的源代码。并且提供长期的Email技术支持。
如果有很多人怎么办？一天100封信，你受得了吗？
我的决定：我会将代码注解写得更详细，然后把新的版本发给用户。另外我会将常见的问题汇编到一起，定期的发给用户。
如果没有人要我的源代码怎么办？
我的决定：我会有更多的时间，继续开发下一个项目。用我的源代码再写几个程序，决不放弃。'********************************************
'*我的源代码中有什么？
*解决方案：怎样实现程序的多语言(我的一个解决方案）
*解决方案：怎样实现动态帮助（当鼠标指针移动到一个控件上方是，动态显示相关的帮助）
*解决方案：怎样来用一个文件来保存设置（我的INI文件解决方案，没有文件尺寸的限制，设置串没有长度限制，设置串能够包括回车）
*解决方案：注册码生成算法和验证算法。（我的一个解决方案）
.........
*大量的实用模块
Module=mdlEnumWindow; EnumWindows.bas
Module=mdlWindow; mdlWindow.bas
Module=ApiConst; ApiConst.bas
Module=mdlMath; mdlMath.bas
Class=clsEasyDialog; clsEasyDialog.cls
Class=clsEasyKey; clsEasyKey.cls
Class=oWindow; oWindow.cls
Form=frmWindowUnderMouse.frm
Module=mdlList; mdlList.bas
Class=clsEditMode; clsEditMode.cls
Module=mdlShell; mdlShell.bas
Module=basMisc; basMisc.bas
Form=frmCommonDialog.frm
Class=clsHelp; clsHelp.cls
Class=clsPosition; clsPosition.cls
Form=frmAbout.frm
Form=frmDriverE.frm
Module=mdlUtilities; ..\Utilities\mdlUtilities.bas
Form=frmEasyDialogD.frm
Class=clsEncrypt; clsEncrypt.cls
Form=frmRegisterD.frm
Module=mdlRegister; mdlRegister.bas
Module=mdlAbout; mdlAbout.bas
Module=mdlEasyDialog; mdlEasyDialog.bas
Module=mdlTextBox; ..\Utilities\mdlTextBox.bas
Module=mdlSpecialFolder; ..\Utilities\mdlSpecialFolder.bas'********************************************
'*下载EasyDialog:
http://www.softboyzhou.com/download/EasyDialog.asp
'***************
'*购买EasyDialog:
http://www.softreg.com.cn/shareware_view.asp?id=/7148D197-1C1D-4E84-B92A-EE2CC07D27C0/
'********************************************
'*给我写信：有什么问题请来信。
[email protected]

调试易

如何将某个目录下的某一类文件全部查询出来?

解决方案 »