指定した拡張子のファイルを検索          <TOP>


指定した拡張子のファイルを、フォルダおよびサブフォルダから検索表示します。

FindClose ファイル検索ハンドルをクローズ

FindFirstFile 指定したファイル名に一致するファイルやディレクトリを検索

FindNextFile FindFirstFileで検出したファイルの次を検出

GetTickCount システムが起動してからの経過時間を取得

PathMatchSpec パスが検索文字列に一致するかどうかの判断

lstrlen 指定された文字列のバイトまたは文字の長さを返す

 

複数の拡張子を検索する場合は、「;」で接続します。

 

'================================================================
'= 指定した拡張子のファイルを検索
'=    (PathMatchSpec.bas)
'================================================================
#include "Windows.bi"

#define MAX_PATH 260
#define INVALID_HANDLE_VALUE -1         '見つからない場合
#define vbDot 46                        '「.」
#define vbDirectory 16                  'フォルダ
#define vbBackslash "\"
#define ALL_FILES "*.*"

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

' ファイル検索ハンドルをクローズ
Declare Function Api_FindClose& Lib "Kernel32" Alias "FindClose" (ByVal hFindFile&)

' 指定したファイル名に一致するファイルやディレクトリを検索
Declare Function Api_FindFirstFile& Lib "Kernel32" Alias "FindFirstFileA" (ByVal lpFileName$, lpFindFileData As WIN32_FIND_DATA)

' FindFirstFile()関数で検出したファイルの次を検出
Declare Function Api_FindNextFile& Lib "Kernel32" Alias "FindNextFileA" (ByVal hFindFile&, lpFindFileData As WIN32_FIND_DATA)

' システムが起動してからの経過時間を取得
Declare Function Api_GetTickCount& Lib "Kernel32" Alias "GetTickCount" ()

' パスが検索文字列に一致するかどうか判定
Declare Function Api_PathMatchSpec& Lib "shlwapi" Alias "PathMatchSpecA" (ByVal pszFile$, ByVal pszSpec$)

' 指定された文字列のバイトまたは文字の長さを返す
Declare Function Api_lstrlen& Lib "Kernel32" Alias "lstrlenA" (ByVal lpString$)

Var Shared bRecurse As Integer
Var Shared nCount As Long
Var Shared nSearched As Long
Var Shared sFileNameExt As String
Var Shared sFileRoot As String

Var Shared Edit(4) As Object
Var Shared Text(2) As Object
Var Shared List1 As Object
Var Shared Check1 As Object
Var Shared Button1 As Object

For i = 0 To 4
    If i < 3 Then
        Text(i).Attach GetDlgItem("Text" & Trim$(Str$(i + 1)))
        Text(i).SetFontSize 14
    End If    
    Edit(i).Attach GetDlgItem("Edit" & Trim$(Str$(i + 1)))
    Edit(i).SetFontSize 14
Next
List1.Attach GetDlgItem("List1") : List1.SetFontSize 14
Check1.Attach GetDlgItem("Check1") : Check1.SetFontSize 14
Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14

'================================================================
'= 
'================================================================
Declare Function TrimNull(sFileName As String) As String
Function TrimNull(sFileName As String) As String
    TrimNull = Left$(sFileName, Api_lstrlen(sFileName))
End Function

'================================================================
'= 検索部
'================================================================
Declare Sub SearchForFiles(sRoot As String)
Sub SearchForFiles(sRoot As String)
    Var wfd As WIN32_FIND_DATA
    Var hFile As Long
  
    hFile = Api_FindFirstFile(sRoot & ALL_FILES, wfd)

    If hFile <> INVALID_HANDLE_VALUE Then
        Do
            If (wfd.dwFileAttributes And vbDirectory) Then
                If Asc(wfd.cFileName) <> vbDot Then
                    If bRecurse = 1 Then
                        SearchForFiles sRoot & TrimNull(wfd.cFileName) & vbBackslash
                    End If
                End If
            Else
                If Api_PathMatchSpec(wfd.cFileName, sFileNameExt) <> 0 Then
                    nCount = nCount + 1
                    List1.AddString sRoot & TrimNull(wfd.cFileName)
                End If
            End If
            nSearched = nSearched + 1
        Loop While Api_FindNextFile(hFile, wfd)
    End If
    Ret = Api_FindClose(hFile)
End Sub

'================================================================
'= 「\」が無い場合付加
'================================================================
Declare Function QualifyPath(sPath As String) As String
Function QualifyPath(sPath As String) As String
    If Right$(sPath, 1) <> vbBackslash Then
        QualifyPath = sPath & vbBackslash
    Else
        QualifyPath = sPath
    End If
End Function

'================================================================
'=
'================================================================
Declare Sub MainForm_Start edecl ()
Sub MainForm_Start()
   Edit(0).SetWindowText "D:\_FB_API_E\"
   Edit(1).SetWindowtext "*.mak; *.rc; *.bas"
End Sub

'================================================================
'=
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var tmStart As Single
    Var tmEnd As Single
    Var Ret As Long


    For i% = 2 To 4 : Edit(i%).SetWindowText "" : Next   
    List1.Resetcontent
   
    sFileRoot = QualifyPath(Edit(0).GetWindowText)
    sFileNameExt = Edit(1).GetWindowText
    bRecurse = Check1.GetCheck
    nCount = 0
    nSearched = 0

    tmStart = Api_GetTickCount()
    SearchForFiles sFileRoot
    tmEnd = Api_GetTickCount()
   
    Edit(2).SetWindowText Format$(nSearched, "##,###,###")
    Edit(3).SetWindowText Format$(nCount, "##,###,###")
    Edit(4).SetWindowText Str$((tmEnd - tmStart) / 1000) & "秒"
End Sub

'================================================================
'=
'================================================================
While 1
    WaitEvent
Wend
Stop
End