フォルダ・ファイル数の取得          <TOP>


FindFirstFile 指定したファイル名に一致するファイルやディレクトリを検索
FindNextFile FindFirstFile()関数で検出したファイルの次を検出
FindClose ファイル検索ハンドルをクローズ
GetFileAttributes 指定されたファイルまたはディレクトリの属性を取得
lstrlenW (Null文字で終了する)UNICODE文字列の文字数を返す

 

'================================================================
'= フォルダ・ファイル数の取得
'=    (DirFileCount.bas)
'================================================================
#include "Windows.bi"

#define FILE_ATTRIBUTE_ARCHIVE &H20     'アーカイブ属性
#define FILE_ATTRIBUTE_COMPRETSED &H800 '圧縮属性
#define FILE_ATTRIBUTE_DIRECTORY &H10   'ディレクトリ属性
#define FILE_ATTRIBUTE_HIDDEN &H2       '隠しファイル属性
#define FILE_ATTRIBUTE_NORMAL &H80      'ファイル属性を持たない
#define FILE_ATTRIBUTE_READONLY &H1     '読み込み専用属性
#define FILE_ATTRIBUTE_SYSTEM &H4       'システムファイル属性
#define FILE_ATTRIBUTE_TEMPORARY &H100  '一時ファイル属性
#define INVALID_HANDLE_VALUE -1         '見つからない場合
#define MAX_PATH 260
#define vbDot 46

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&)

' 指定されたファイルまたはディレクトリの属性を取得
Declare Function Api_GetFileAttributes& Lib "Kernel32" Alias "GetFileAttributesA" (ByVal lpFileName$)

' (Null文字で終了する)UNICODE文字列の文字数を返す
Declare Function Api_lstrlenW& Lib "Kernel32" Alias "lstrlenW" (lpString As Any)

Var Shared List1 As Object
Var Shared Text1 As Object
Var Shared Edit(1) As Object
Var Shared Button(2) As Object

List1.Attach GetDlgItem("List1") : List1.SetFontSize 14
List1.SetWindowSize 258, 132
Text1.Attach GetDlgItem("Text1") : Text1.SetFontSize 14
For i = 0 To 2
    If i < 2 then
        Edit(i).Attach GetDlgItem("Edit" & Trim$(Str$(i + 1)))
        Edit(i).SetFontSize 14
    End If
    Button(i).Attach GetDlgItem("Button" & Trim$(Str$(i + 1)))
    Button(i).SetFontSize 12
Next

'================================================================
'= フォルダ・ファイル
'================================================================
Declare Function FilesCountAll(sSource As String, sFileType As String) As Long
Function FilesCountAll(sSource As String, sFileType As String) As Long
    Var wfd As WIN32_FIND_DATA
    Var hFile As Long
    Var Cnt As Long
    Var fCount As Long

    hFile = Api_FindFirstFile(sSource & sFileType, wfd)

    If hFile <> INVALID_HANDLE_VALUE Then
        Do
            If (Asc(wfd.cFileName) <> vbDot) Then
                Cnt = Cnt + 1
                List1.AddString Format$(Cnt, "#####:") & wfd.cFileName
                FilesCountAll = Cnt
            End If   
        Loop Until Api_FindNextFile(hFile, wfd) = 0
    End If

    Ret = Api_FindClose(hFile)
End Function

'================================================================
'= 
'================================================================
Declare Function FilesCountByAttribute(sSource As String, sFileType As String, dwAttributes As Long) As Long
Function FilesCountByAttribute(sSource As String, sFileType As String, dwAttributes As Long) As Long
    Var wfd As WIN32_FIND_DATA
    Var hFile As Long
    Var Cnt As Long
    Var Ret As Long

    hFile = Api_FindFirstFile(sSource & sFileType, wfd)

    If (hFile <> INVALID_HANDLE_VALUE) Then
        Do
            If (dwAttributes And Api_GetFileAttributes(sSource & wfd.cFileName)) And (Asc(wfd.cFileName) <> vbDot) Then
                Cnt = Cnt + 1
                List1.AddString Format$(Cnt, "#####:") & wfd.cFileName
                FilesCountByAttribute = Cnt
            End If
        Loop Until Api_FindNextFile(hFile, wfd) = 0
    End If

    Ret = Api_FindClose(hFile)
End Function

'================================================================
'=
'================================================================
Declare Function FilesListByAttribute(Source As String, FileType As String, dwAttributes As Long) As Long
Function FilesListByAttribute(Source As String, FileType As String, dwAttributes As Long) As Long
    Var wfd As WIN32_FIND_DATA
    Var hFile As Long
    Var Cnt As Long
    Var Ret As Long

    hFile = Api_FindFirstFile(Source & FileType, wfd)

    If (hFile <> INVALID_HANDLE_VALUE) Then
        Do
            If (dwAttributes And Api_GetFileAttributes(Source & wfd.cFileName)) = dwAttributes And (Asc(wfd.cFileName) <> vbDot) Then
                Cnt = Cnt + 1
                List1.AddString Format$(Cnt, "#####:") & wfd.cFileName
                FilesListByAttribute = Cnt
            End If
        Loop Until Api_FindNextFile(hFile, wfd) = 0
    End If

    Ret = Api_FindClose(hFile)
End Function

'================================================================
'=
'================================================================
Declare Function GetAttributeString(Attr As Long) As String
Function GetAttributeString(Attr As Long) As String
    Var Tmp As String

    If Attr And FILE_ATTRIBUTE_ARCHIVE    Then Tmp = Tmp & "ARCHIVE "
    If Attr And FILE_ATTRIBUTE_NORMAL     Then Tmp = Tmp & "NORMAL "
    If Attr And FILE_ATTRIBUTE_HIDDEN     Then Tmp = Tmp & "HIDDEN "
    If Attr And FILE_ATTRIBUTE_READONLY   Then Tmp = Tmp & "READONLY "
    If Attr And FILE_ATTRIBUTE_SYSTEM     Then Tmp = Tmp & "SYSTEM "
    If Attr And FILE_ATTRIBUTE_TEMPORARY  Then Tmp = Tmp & "TEMPORARY "
    If Attr And FILE_ATTRIBUTE_COMPRESSED Then Tmp = Tmp & "COMPRESSED "
    If Attr And FILE_ATTRIBUTE_DIRECTORY  Then Tmp = Tmp & "DIRECTORY "

    GetAttributeString = Tmp
End Function

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

'================================================================
'= Folder・File All Count
'================================================================
Declare Sub Button1_on edecl ()
Sub Button1_on()
    Var Source As String
    Var FileType As String
    Var numFiles As Long

    Source = Edit(0).GetWindowText
    If Right$(Source, 1) <> "\" Then
        Source = Source & "\"
        Edit(0).SetWindowText Source
    End If

    FileType = Edit(1).GetWindowText

    List1.Resetcontent

    numFiles = FilesCountAll(Source, FileType)

    Text1.SetWindowText Str$(numFiles) & "個の フォルダ・ファイル"
End Sub

'================================================================
'= Archive Normal
'================================================================
Declare Sub Button2_on edecl ()
Sub Button2_on()
    Var Source As String
    Var FileType As String
    Var dwAttributes As Long
    Var numFiles As Long

    Source = Edit(0).GetWindowText
    If Right$(Source, 1) <> "\" Then
        Source = Source & "\"
        Edit(0).SetWindowText Source
    End If

    FileType = Edit(1).GetWindowText

    dwAttributes = FILE_ATTRIBUTE_NORMAL Or FILE_ATTRIBUTE_ARCHIVE

    List1.Resetcontent

    numFiles = FilesCountByAttribute(Source, FileType, dwAttributes)

    Text1.SetWindowText Str$(numFiles) & "個の " & GetAttributeString(dwAttributes)
End Sub

'================================================================
'= Archive
'================================================================
Declare Sub Button3_on edecl ()
Sub Button3_on()
    Var Source As String
    Var FileType As String
    Var dwAttributes As Long
    Var numFiles As Long

    Source = Edit(0).GetWindowText
    If Right$(Source, 1) <> "\" Then
        Source = Source & "\"
        Edit(0).SetWindowText Source
    End If

    FileType = Edit(1).GetWindowText

    dwAttributes = FILE_ATTRIBUTE_ARCHIVE

    List1.Resetcontent

    numFiles = FilesListByAttribute(Source, FileType, dwAttributes)

    Text1.SetWindowText Str$(numFiles) & "個の " & GetAttributeString(dwAttributes)
End Sub

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