指定した拡張子のファイルを検索 <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