VB 分别用DIR和API遍历驱动器实例

原创 2007年10月03日 12:27:00
相信大家都用过DIR函数吧,用没有用过DIR遍历某个文件夹,甚至一个驱动器乃至整个硬盘呢?有没有想过究竟是DIR使用方便还是API方便呢?有没有想过使用DIR快些还是API快些呢?好了一切都可以在我提供的源码实例中得到肯定回答.

以下是关键部分源码:
Option Explicit
'**********************************************************************************************************************
'搜索API函数、常量、类型等声明
Private Const INVALID_HANDLE_VALUE = -1
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
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private WFD As WIN32_FIND_DATA
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private Const MaxLFNPath = 260
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 * MaxLFNPath
    cShortFileName As String * 14
End Type
'**********************************************************************************************************************
'使LISTBOX滚动条自动下拉等函数及常量声明
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const WM_VSCROLL = &H115
Private Const SB_BOTTOM = 7
'**********************************************************************************************************************
'发送模拟按键消息
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Public Const BM_CLICK = 245
Public Declare Function MessageBox Lib "user32" Alias "MessageBoxA" (ByVal hWnd As Long, ByVal lpText As String, ByVal lpCaption As String, ByVal wType As Long) As Long
'**********************************************************************************************************************
'isPause标识是不是处于暂停中,isSearch标识是不是处于文件搜索中,isStop是否处于停止状态
Public isPause As Boolean, isSearch As Boolean, isStop As Boolean
'搜索指定路径并且包括子路径
Public Sub SearcherUseApi(ByVal strCurPath As String, Optional ByVal isCheckSub As Boolean = True)
    Static sum As Long
    If Right(strCurPath, 1) <> "/" Then strCurPath = strCurPath & "/"
    Dim dirs As Long, dirbuf() As String, i As Integer, hItem As Long, k As Long, strTmp As String
    hItem = FindFirstFile(strCurPath & "*.*", WFD)
    If hItem <> INVALID_HANDLE_VALUE Then
        Do
            sum = sum + 1
            If sum Mod 20 = 0 Then DoEvents
            '检查是不是目录
            If (WFD.dwFileAttributes And vbDirectory) Then
                ' 检查是不是  "." or ".."
                If Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
 <> "." And Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
<>".." Then
                    ReDim Preserve dirbuf(0 To dirs)
                    dirbuf(dirs) = Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
                    dirs = dirs + 1
                    strTmp = strCurPath & Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
                    frmMain.lstFolders.AddItem strTmp
                    SendMessage frmMain.lstFolders.hWnd, WM_VSCROLL, SB_BOTTOM, 0&
                End If
            Else
                strTmp = strCurPath & Left(WFD.cFileName, InStr(WFD.cFileName, vbNullChar) - 1)
                frmMain.lstFiles.AddItem strTmp
                SendMessage frmMain.lstFiles.hWnd, WM_VSCROLL, SB_BOTTOM, 0&
            End If
        Loop While FindNextFile(hItem, WFD)
        Call FindClose(hItem)
    End If
    If Not isCheckSub Then Exit Sub
    For i = 0 To dirs - 1
        If isStop Then isSearch = False: Exit For
        SearcherUseApi strCurPath & dirbuf(i) & "/"
    Next i
End Sub
Public Sub SeacherUseDir(ByVal strPath As String, Optional ByVal isCheckSub As Boolean = True)
    Static sum As Long
    Dim strFolders() As String, dirs As Integer, i As Integer
    If Right(strPath, 1) <> "/" Then strPath = strPath & "/"
    Dim strTmp As String
    On Error Resume Next
    strTmp = Dir(strPath & "*.*", 1 Or 2 Or 4 Or vbDirectory)
    Do While strTmp <> ""
        sum = sum + 1
        If sum Mod 20 = 0 Then DoEvents
        If GetAttr(strPath & strTmp) And vbDirectory Then
            If Left(strTmp, 1) <> "." Then
                frmMain.lstFolders.AddItem strPath & strTmp
                SendMessage frmMain.lstFolders.hWnd, WM_VSCROLL, SB_BOTTOM, 0&
                ReDim Preserve strFolders(0 To dirs)
                strFolders(dirs) = strPath & strTmp & "/"
                dirs = dirs + 1
            End If
        Else
            frmMain.lstFiles.AddItem strPath & strTmp
            SendMessage frmMain.lstFiles.hWnd, WM_VSCROLL, SB_BOTTOM, 0&
        End If
        strTmp = Dir
    Loop
    If Not isCheckSub Then Exit Sub
    For i = 0 To dirs - 1
        If isStop Then isSearch = False: Exit For
        SeacherUseDir strFolders(i), isCheckSub
    Next
End Sub
Public Sub RestorePublic()
    isStop = False
    isPause = False
    isSearch = False
End Sub

 

VB 使用 Dir 函数遍历文件夹

语法: Dir[(pathname[, attributes])] Dir 函数的语法具有以下几个部分: 以 vbDirectory 属性来调用 Dir 不能连续地返回子目录。!!! 以下是V...
  • lbuskeep
  • lbuskeep
  • 2012年05月31日 15:19
  • 10983

vb中dir函数用法

vb中提供的成员函数dir返回一个满足指定类型或指定文件属性的文件名,目录名或卷标名,dir函数的语法结构为:Member Function Dir[(Pathname[,attributes]...
  • xm16648310
  • xm16648310
  • 2010年07月22日 11:14
  • 1236

VB DirBrowse获取路径值

  • 2012年12月19日 16:56
  • 3KB
  • 下载

VB 分别用DIR和API遍历驱动器实例

相信大家都用过DIR函数吧,用没有用过DIR遍历某个文件夹,甚至一个驱动器乃至整个硬盘呢?有没有想过究竟是DIR使用方便还是API方便呢?有没有想过使用DIR快些还是API快些呢?好了一切都可以在我提...
  • chenhui530
  • chenhui530
  • 2007年10月03日 12:27
  • 3562

VB遍历某目录下的某类型文件(Dir)

List = ""tmp = Dir("c:*.txt")List = tmp + vbCrLfDo While tmp  ""    tmp = Dir    List = List + tmp +...
  • jyh_jack
  • jyh_jack
  • 2008年02月20日 13:10
  • 1395

VB用API函数遍历指定驱动器、目录的文件

以下代码演示了如何用Windows API函数遍历指定驱动器、目录的所有文件。其思路是:调出浏览文件夹窗口让用户指定所要搜索的起始路径,然后用查找文件的API函数遍历该目录下及其包含的子目录下的所有文...
  • johnny_83
  • johnny_83
  • 2007年07月22日 09:05
  • 2023

vb资源下载 长期有效

东西太多了 自己懒得改文件列表 大家看着下吧 呵呵只整理到了一半 地址www.84ren.com驱动器 F 中的卷是 ZCM_BACK卷的序列号是 08BC-0AE4F:/VBCN/编程模块及工具20...
  • zcm123
  • zcm123
  • 2006年03月24日 16:40
  • 9052

vb6自动更新和恢复文件的一种方法

vb6自动更新和恢复文件的一种方法Attribute VB_Name = "mdlPublic"Option Explicit//***********************************...
  • YFY
  • YFY
  • 2008年04月11日 15:14
  • 737

dir函数:遍历文件名

dir(“地址\”)返回该地址下的第一个文件的文件名 Sub t() Dim sr As String sr = Dir("G:\社团、活动\JMR\*.xlsx")这里使用了通配符,并...
  • ainizhongguoaa
  • ainizhongguoaa
  • 2016年08月14日 16:44
  • 222

vb.net 使用 DIR 遍历文件目录

原文地址 Dir 函数示例 本示例使用 Dir 函数来检查某些文件或目录是否存在。在 Macintosh 计算机上,默认驱动器名称是 “HD” ,并且路径部分由冒号取代反斜线隔开。而且 Micro...
  • zhyh1435589631
  • zhyh1435589631
  • 2016年05月10日 15:47
  • 1875
内容举报
返回顶部
收藏助手
不良信息举报
您举报文章:VB 分别用DIR和API遍历驱动器实例
举报原因:
原因补充:

(最多只允许输入30个字)