[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