关闭

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

3459人阅读 评论(3) 收藏 举报
相信大家都用过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

 

0
0

查看评论
* 以上用户言论只代表其个人观点,不代表CSDN网站的观点或立场
    个人资料
    • 访问:324544次
    • 积分:4445
    • 等级:
    • 排名:第6945名
    • 原创:81篇
    • 转载:0篇
    • 译文:2篇
    • 评论:431条
    文章分类
    最新评论
    chenhui530新浪博客