フォルダ・ファイルのチェック <TOP>
フォルダやファイルの存在をチェックします。
FindFirstFile 指定したファイル名に一致するファイルやディレクトリを検索 FindNextFile FindFirstFile()関数で検出したファイルの次を検出 FindClose ファイル検索ハンドルをクローズ
'================================================================ '= フォルダ・ファイルのチェック '= (FindFirstFile.bas) '================================================================ #include "Windows.bi" #include "File.bi" #define MAX_PATH 260 #define INVALID_HANDLE_VALUE -1 '見つからない場合 #define vbDirectory 16 'フォルダ 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_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_FindClose& Lib "kernel32" Alias "FindClose" (ByVal hFindFile&) Var Shared Edit1 As Object Var Shared Text1 As Object Var Shared Text2 As Object Var Shared Button1 As Object Edit1.Attach GetDlgItem("Edit1") : Edit1.SetFontSize 14 Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14 Text2.Attach GetDlgItem("Text2") : Text2.SetFontSize 14 Button1.Attach GetDlgItem("Button1") : Button1.SetFontSize 14 '================================================================ '= '================================================================ Declare Function FolderContainsSubfolders(sRoot As String) As Integer Function FolderContainsSubfolders(sRoot As String) As Integer Var wfd As WIN32_FIND_DATA Var hFile As Long Var Ret As Long hFile = Api_FindFirstFile(sRoot & "*.*", wfd) If hFile <> INVALID_HANDLE_VALUE Then Do If (wfd.dwFileAttributes And vbDirectory) Then If (Left$(wfd.cFileName, 1) <> ".") And (Left$(wfd.cFileName, 2) <> "..") Then FolderContainsSubfolders = True Exit Do End If End If Loop While Api_FindNextFile(hFile, wfd) End If Ret = Api_FindClose(hFile) End Function '================================================================ '= '================================================================ Declare Function FolderContainsFiles(sRoot As String) As Integer Function FolderContainsFiles(sRoot As String) As Integer Var wfd As WIN32_FIND_DATA Var hFile As Long Var Ret As Long hFile = Api_FindFirstFile(sRoot & "*.*", wfd) If hFile <> INVALID_HANDLE_VALUE Then Do If (Not(wfd.dwFileAttributes And vbDirectory) = vbDirectory) Then FolderContainsFiles = True Exit Do End If Loop While Api_FindNextFile(hFile, wfd) End If Ret = Api_FindClose(hFile) End Function '================================================================ '= '================================================================ Declare Sub MainForm_Start edecl () Sub MainForm_Start() Edit1.SetWindowText "C:\Windows" Button1.SetWindowText "フォルダ/ファイルチェック" End Sub '================================================================ '= パスの後尾に「\」が無ければ付加 '================================================================ Declare Function qPath(sPath As String) As String Function qPath(sPath As String) As String If Len(sPath) > 0 Then If Right$(sPath, 1) <> "\" Then qPath = sPath & "\" Else qPath = sPath End If Else qPath = "" End If End Function '================================================================ '= '================================================================ Declare Sub Button1_on edecl () Sub Button1_on() Var sRootPath As String Var RetVal1 As Integer Var RetVal2 As Integer sRootPath = qPath(Edit1.GetWindowText) Edit1.SetWindowText sRootPath RetVal1 = FolderContainsSubfolders(sRootPath) RetVal2 = FolderContainsFiles(sRootPath) Select Case RetVal1 Case True Text1.SetWindowText sRootPath & " はサブフォルダを含んでいます。" Case Else Text1.SetWindowText sRootPath & " 配下にサブフォルダはありません。" End Select Select Case RetVal2 Case True Text2.SetWindowText sRootPath & " にファイルがあります。" Case Else Text2.SetWindowText sRootPath & " にファイルはありません。" End Select End Sub '================================================================ '= '================================================================ While 1 WaitEvent Wend Stop End