论坛 › Fortran语法讨论 › 遍历文件夹下某种类型所有文件

cqflhl 发表于 4 天前

遍历文件夹下某种类型所有文件

发现用cmd的 dir 命令 不能完全找到 某文件夹及其子文件夹下 某种扩展名的所有文件,
想用fortran 递归实现, 不知道有没有高手做过

楚香饭 发表于 4 天前

dir /b /s *.dat

cqflhl 发表于 4 天前

楚香饭 发表于 2024-11-18 11:09
dir /b /s *.dat
不想用Windows 命令行, 读网盘文件有丢失
想另辟蹊径

楚香饭 发表于 4 天前

本帖最后由 楚香饭 于 2024-11-18 15:49 编辑

找到一个很久以前写的代码，但只能适用于 Visual Fortran For windows 编译器
Module DoWithWildcardMod
implicit none
Interface
    Subroutine IF_CallBack( cFile , iLoop )
      Character( Len = * ) , Intent( IN ) :: cFile
      Integer , Intent( IN ) :: iLoop
    End Subroutine IF_CallBack
End Interface

contains

Recursive Integer Function DoWithWildcard(cWildcard,level,CallBack,iTotal) result(nCurr)
    Use IFPort !// 如果是 Compaq 或 Digital，需改为 Use DFLib
    Character( Len = * ) , Intent( IN ) :: cWildcard
    Integer , Intent( IN ):: level!//搜索等级，-1表示无限搜索子目录。0表示不搜索子目录。1表示搜索一级子目录
    Integer , Intent( OUT ) :: iTotal
    Procedure(IF_CallBack) :: CallBack
    Type (FILE$INFO) :: stInfo
    Integer(Kind=INT_PTR_KIND()) :: iWildhandle
    Integer :: k , j , t
    j = max(0,index( cWildcard , '\' , .true. ))
    nCurr = 0
    Do t = 1 , 2 !// File / Dir
      iWildhandle = FILE$FIRST
      Do
      if(t==1) then
          k = GetFileInfoQQ( cWildCard , stInfo , iWildhandle )
      else
          k = GetFileInfoQQ( cWildCard(:j)//'*', stInfo , iWildhandle )
      end if
      If ( iWildhandle == FILE$LAST ) exit
      If ( iWildhandle == FILE$ERROR ) then
          k = GetLastErrorQQ()
          nCurr = merge( -1 , 0 , k==ERR$NOENT .or. k==ERR$NOMEM)
          return
      End If
      If ( t == 1 .and. iand(stInfo%permit,FILE$DIR)==0 ) then
          iTotal = iTotal + 1
          nCurr= nCurr+ 1
          call CallBack( trim(cWildcard(:j)//stInfo%Name) , iTotal )
      Else If ( t == 2 .and. iand(stInfo%permit,FILE$DIR)==FILE$DIR ) then
          if( level == 0 ) exit
          if( stInfo%Name(1:1)=='.' ) cycle
          k = DoWithWildcard( cWildcard(:j)//trim(stInfo%Name)//'\'//cWildcard(j+1:) , level-1 , CallBack , iTotal )
          if( k < 0 ) return
      End If
      End Do
    End Do   
End Function DoWithWildcard

End Module DoWithWildcardMod

Program www_fcode_cn
use DoWithWildcardMod
Implicit None
integer :: n , j
n = 0 !//必须先初始化为0
j = DoWithWildcard( "D:\ssd\*.txt" , -1 , ToDoOneFile , n )
write(*,*) '共',n,'个文件'

contains

Subroutine ToDoOneFile( cFile , iLoop )
    Character( Len = * ) , Intent( IN ) :: cFile
    Integer , Intent( IN ) :: iLoop
    Write( * , * ) '第',iLoop,'个文件：',cFile
End Subroutine ToDoOneFile

End Program www_fcode_cn

cqflhl 发表于 昨天 12:16

楚香饭 发表于 2024-11-18 15:16
找到一个很久以前写的代码，但只能适用于 Visual Fortran For windows 编译器
M ...

先谢了, 里面可能有些bug

查看完整版本: 遍历文件夹下某种类型所有文件