callBack 是接口,ToDoOneFile 是它的真实实现。
[Fortran] 纯文本查看 复制代码 Program www_fcode_cn
Implicit None
integer :: n = 0
External ToDoOneFile
call DoWithWildcard( "C:\dosh\*" , ToDoOneFile , n )
write(*,*) '共',n,'个文件'
End Program www_fcode_cn
Subroutine ToDoOneFile( cFile , iLoop )
Character( Len = * ) , Intent( IN ) :: cFile
Integer , Intent( IN ) :: iLoop
Write( * , * ) '第',iLoop,'个文件:',cFile
!Open( 12 , File = cFile )
!Read( 12 )
!Close( 12 )
End Subroutine ToDoOneFile
Recursive Subroutine DoWithWildcard(cWildcard,CallBack,iTotal)
!// 下一句代码,如果是 Compaq 或 Digital,需改为 Use DFLib
Use IFPort , only : GetFileInfoQQ , GetLastErrorQQ , FILE$INFO , FILE$LAST , FILE$ERROR , FILE$FIRST , ERR$NOMEM , ERR$NOENT , FILE$DIR
Implicit None
Interface
Subroutine CallBack( cFile , iLoop )
Character( Len = * ) , Intent( IN ) :: cFile
Integer , Intent( IN ) :: iLoop
End Subroutine CallBack
End Interface
Character( Len = * ) , Intent( IN ) :: cWildcard
Integer , Intent( OUT ) :: iTotal
Type (FILE$INFO) :: stInfo
Integer(4) :: iWildhandle , iLength , iRet
iWildhandle = FILE$FIRST
Do While (.TRUE.)
iLength = GetFileInfoQQ( cWildCard , stInfo , iWildhandle )
If (( iWildhandle == FILE$LAST) .OR.( iWildhandle == FILE$ERROR )) then
Select Case (GetLastErrorQQ())
Case (ERR$NOMEM) !//内存不足
iTotal = - 1
return
Case (ERR$NOENT) !//碰到通配符序列尾
return
Case Default
iTotal = 0
return
End Select
End If
iLength = index( cWildcard , "\" , .true. )
If ( ( stInfo%permit.AND.FILE$DIR ) == 0 ) then
call CallBack( cWildcard(:iLength)//trim(stInfo%Name) , iTotal + 1 )
iTotal = iTotal + 1
Else
if(stInfo%Name(1:1) /= "." ) then
call DoWithWildcard( cWildcard(:iLength)//trim(stInfo%Name)//"\"//cWildcard(iLength+1:) , CallBack , iTotal )
end if
End If
End Do
End Subroutine DoWithWildcard |