#include "windows.bi" #ifndef FALSE #define FALSE 0 #define TRUE Not FALSE #endif Dim kakuchoushi As String Dim myFolder As String Declare Function CountFiles ( rootdir As String, extension As String) As Integer Function CountFiles ( rootdir As String, extension As String) As Integer 'Local Variable Definitions Dim iCount As Integer Dim As String strFilePath, strPattern, strExtension Dim As HANDLE hFile Dim As WIN32_FIND_DATA FileInformation Dim As Integer iStr extension = LCase(extension) strPattern = rootdir + "\\*.*" hFile = FindFirstFile(strPattern, @FileInformation) If hFile <> INVALID_HANDLE_VALUE Then Do If FileInformation.cFileName <> "." Then strFilePath = rootdir + "\\" + FileInformation.cFileName If FileInformation.dwFileAttributes <> FILE_ATTRIBUTE_DIRECTORY Then strExtension = LCase(Right(FileInformation.cFileName,Len(FileInformation.cFileName)-InStrRev(FileInformation.cFileName,"."))) If Chr(strExtension[0]) = "." Then strExtension = Right(FileInformation.cFileName,2) If extension = "*" Or strExtension = extension Then iCount += 1 Print FileInformation.cFileName EndIf End If End If Loop While FindNextFile(hFile, @FileInformation) = TRUE Print End If FindClose(hFile) Return iCount End Function '************ FileSelectFolder ******************* #Include Once "crt.bi" #Include Once "windows.bi" #Include Once "win/commdlg.bi" #include Once "win/shlobj.bi" #Ifndef _FILE_HELPERS_WIN32 #Define _FILE_HELPERS_WIN32 Declare Function FileSelectFolder (Byref title As String = "Choose A Folder",ByVal nCSIDL As Integer, ulFlags As ULong =BIF_NEWDIALOGSTYLE, ByRef sz_InitialDir As String) As String Type FOLDER_PROPS Dim lpszTitle As ZString Ptr Dim lpszInitialFolder As ZString Ptr Dim As UInteger ulFlags End Type Function FileSelectFolder (Byref title As String = "Choose A Folder", ByVal nCSIDL As Integer, iFlags As ULong = BIF_EDITBOX, ByRef sz_InitialDir As String) As String Dim bi As BROWSEINFO Dim pidl As LPITEMIDLIST Dim ret As HRESULT Dim physpath As Zstring * MAX_PATH Dim dispname As Zstring * MAX_PATH Dim fp As FOLDER_PROPS bi.hwndOwner = HWND_DESKTOP If nCSIDL Then ret = SHGetSpecialFolderLocation(HWND_DESKTOP, nCSIDL, @bi.pidlRoot) 'ret = SHGetFolderLocation(HWND_DESKTOP, nCSIDL, NULL, NULL, @bi.pidlRoot) Else 'ret = SHGetSpecialFolderLocation(HWND_DESKTOP, CSIDL_DESKTOP, @bi.pidlRoot) ret = SHGetFolderLocation(HWND_DESKTOP, CSIDL_DESKTOP , NULL, NULL, @bi.pidlRoot) EndIf fp.lpszTitle = StrPtr(Title) fp.lpszInitialFolder = StrPtr(sz_InitialDir) fp.ulFlags = iFlags bi.pszDisplayName = @dispname bi.lpszTitle = Strptr(title) bi.ulFlags = iFlags 'bi.lpfn = @FileSelectFolder_callback bi.lParam = Cast(LPARAM,VarPtr(fp)) bi.iImage = 0 pidl = SHBrowseForFolder(@bi) If pidl <> 0 Then If SHGetPathFromIDList(pidl, physpath) = 0 Then Function = "" Else Function = physpath End If CoTaskMemFree pidl Else Function = "" End If CoTaskMemFree bi.pidlRoot End Function #EndIf '********************* Usage: ***************************** Dim buff As ZString*260 Dim ofnFlags As Integer 'Select Folder ofnFlags = BIF_NEWDIALOGSTYLE Or BIF_RETURNONLYFSDIRS buff = FileSelectFolder("Select Folder",0,ofnFlags,"C:\Program Files") myFolder = buff Input "拡張子(.を含まない) ",kakuchoushi Print Print "フォルダ " & myFolder & " の拡張子 " & kakuchoushi & " のファイル数は、" & CountFiles(myFolder,kakuchoushi) Sleep