Fortran Coder

查看: 197|回复: 9
打印 上一主题 下一主题

[求助] 遍历文件夹下某种类型所有文件

[复制链接]

57

帖子

15

主题

0

精华

熟手

F 币
249 元
贡献
118 点
跳转到指定楼层
楼主
发表于 2024-11-18 10:05:23 | 只看该作者 回帖奖励 |倒序浏览 |阅读模式
发现用cmd  的 dir 命令 不能完全找到 某文件夹及其子文件夹下 某种扩展名的所有文件,
想用fortran 递归实现, 不知道有没有高手做过
分享到:  微信微信
收藏收藏 点赞点赞 点踩点踩

736

帖子

4

主题

0

精华

大师

农村外出务工人员

F 币
700 元
贡献
359 点

新人勋章爱心勋章水王勋章元老勋章热心勋章

沙发
发表于 2024-11-18 11:09:41 | 只看该作者
dir /b /s *.dat

57

帖子

15

主题

0

精华

熟手

F 币
249 元
贡献
118 点
板凳
 楼主| 发表于 2024-11-18 11:41:34 | 只看该作者

不想用  Windows 命令行, 读网盘文件有丢失
想另辟蹊径

736

帖子

4

主题

0

精华

大师

农村外出务工人员

F 币
700 元
贡献
359 点

新人勋章爱心勋章水王勋章元老勋章热心勋章

地板
发表于 2024-11-18 15:16:58 | 只看该作者
本帖最后由 楚香饭 于 2024-11-22 21:20 编辑

找到一个很久以前写的代码,但只能适用于 Visual Fortran For windows 编译器
[Fortran] 纯文本查看 复制代码
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()
          if(k==ERR$NOMEM) then
            nCurr = -1
            return
          end if
          nCurr = 0
          exit
        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



57

帖子

15

主题

0

精华

熟手

F 币
249 元
贡献
118 点
5#
 楼主| 发表于 2024-11-21 12:16:31 | 只看该作者
楚香饭 发表于 2024-11-18 15:16
找到一个很久以前写的代码,但只能适用于 Visual Fortran For windows 编译器
[mw_shl_code=fortran,true]M ...

先谢了, 里面可能有些bug

736

帖子

4

主题

0

精华

大师

农村外出务工人员

F 币
700 元
贡献
359 点

新人勋章爱心勋章水王勋章元老勋章热心勋章

6#
发表于 2024-11-22 08:16:23 | 只看该作者
cqflhl 发表于 2024-11-21 12:16
先谢了, 里面可能有些bug

是吗?详细说说bug

57

帖子

15

主题

0

精华

熟手

F 币
249 元
贡献
118 点
7#
 楼主| 发表于 2024-11-22 09:40:17 | 只看该作者
楚香饭 发表于 2024-11-22 08:16
是吗?详细说说bug

45行不需要, 不然如果当前路径没有找到, 就不会找下层子目录
43行, 有文件夹名是.开头的就会漏掉

736

帖子

4

主题

0

精华

大师

农村外出务工人员

F 币
700 元
贡献
359 点

新人勋章爱心勋章水王勋章元老勋章热心勋章

8#
发表于 2024-11-22 21:22:53 | 只看该作者
cqflhl 发表于 2024-11-22 09:40
45行不需要, 不然如果当前路径没有找到, 就不会找下层子目录
43行, 有文件夹名是.开头的就会漏掉 ...

谢谢,45行的问题改了一下。现在应该OK了。
43行判断那个 '.' 开头的原因是因为一些操作系统是会有 '.' 目录表示当前目录,'..' 表示上一层目录,不管的话就死循环了。
而linux的习惯,正常的 . 开头的是隐藏文件。大概率也不是需要循环的,跳过是比较正常的选择。

57

帖子

15

主题

0

精华

熟手

F 币
249 元
贡献
118 点
9#
 楼主| 发表于 2024-11-22 21:55:21 | 只看该作者
楚香饭 发表于 2024-11-22 21:22
谢谢,45行的问题改了一下。现在应该OK了。
43行判断那个 '.' 开头的原因是因为一些操作系统是会有 '.'  ...

..有方法规避
只要判断不是全点就可以
文件夹前面可以N个...., 但不能全点

736

帖子

4

主题

0

精华

大师

农村外出务工人员

F 币
700 元
贡献
359 点

新人勋章爱心勋章水王勋章元老勋章热心勋章

10#
发表于 2024-11-23 09:15:52 | 只看该作者
cqflhl 发表于 2024-11-22 21:55
..有方法规避
只要判断不是全点就可以
文件夹前面可以N个...., 但不能全点 ...

这个容易,看使用者的需求,按照自己的想法稍作改动就行。
本来这个代码也只是为了满足很多年前自己的一个需求而已。
您需要登录后才可以回帖 登录 | 极速注册

本版积分规则

捐赠本站|Archiver|关于我们 About Us|小黑屋|Fcode ( 京ICP备18005632-2号 )

GMT+8, 2024-12-22 10:42

Powered by Tencent X3.4

© 2013-2024 Tencent

快速回复 返回顶部 返回列表