フォルダ・ファイルのチェック          <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