Fortran Coder
标题: 请问怎么获得包括子文件夹的所有文件名 [打印本页]
作者: shrine 时间: 2017-9-12 07:29
标题: 请问怎么获得包括子文件夹的所有文件名
求问？？？？？？？？？？？？
作者: vvt 时间: 2017-9-12 07:58
ivf编译器的话，可以参考
http://doinfolder.w.fcode.cn/
这个代码，然后递归。
作者: shrine 时间: 2017-9-12 14:13
本帖最后由 shrine 于 2017-9-12 21:28 编辑
如何判断是文件夹，然后进入到文件夹，遍历后再回到上一层目录，继续下一个文件夹？
作者: kyra 时间: 2017-9-13 07:24
[Fortran] 纯文本查看 复制代码
If ( ( stInfo%permit.AND.FILE$DIR ) == 0 ) then
call CallBack( Trim(stInfo%Name) , iTotal + 1 )
iTotal = iTotal + 1
Else
call DoWithWildcard( ... ) !!!文件夹，递归
End If
作者: shrine 时间: 2017-9-13 08:07
本帖最后由 shrine 于 2017-9-13 08:46 编辑
kyra 发表于 2017-9-13 07:24
[Fortran] 纯文本查看 复制代码
If ( ( stInfo%permit.AND.FILE$DIR ) == 0 ) then
call CallBack( Trim(stIn ...
是这样吗？不行啊
[Fortran] 纯文本查看 复制代码
Program www_fcode_cn
Implicit None
integer :: n
External ToDoOneFile
call DoWithWildcard( "j:\*.*" , 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
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
iTotal = 0
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
If ( ( stInfo%permit.AND.FILE$DIR ) == 0 ) then
call CallBack( Trim(stInfo%Name) , iTotal + 1 )
iTotal = iTotal + 1
Else
call DoWithWildcard( cWildcard , CallBack , iTotal ) !!!文件夹，递归
End If
End Do
End Subroutine DoWithWildcard
另外问一下，CallBack和ToDoOneFile什么关系？没有用过interface
作者: kyra 时间: 2017-9-13 10:36
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
作者: pasuka 时间: 2017-9-13 11:12
Windows平台的话，调用dir命令并写入指定文件
dir /S/B > a.txt
具体参考下面的链接：
http://blog.csdn.net/wubai250/article/details/7732822
作者: shrine 时间: 2017-9-13 11:17
获得文件名后我还想进一步操作，所以编程比较方便
作者: shrine 时间: 2017-9-13 11:52
感谢！！！
好人帮到底吧，想把每个文件重命名为前10个字符，低于十个字符文件名不变，后缀名不变该怎么弄
作者: kyra 时间: 2017-9-13 12:23
这中间涉及到很多问题，比如重名怎么办？
比如
有2个文件，分别叫
1234567890123.txt
1234567890124.txt
还有中文字符怎么办？比如
我是1个中文文件名.txt
等等。
如果你只是重命名，我觉得批处理比较适合你。
作者: shrine 时间: 2017-9-13 13:06
重名就后面-1 -2 -3
中文可以略去
批处理怎么实现只取前十个字符，并且保留后缀？我网上搜了，包括使用楼上说的命令dir导出后然后做bat文件，觉得还是写个程序比较好，但是Fortran文件处理功能原来确实没有接触过
作者: chiangtp 时间: 2017-9-13 14:20
CALL SYSTEM('DIR/S/D D:\ABC\DEF > filelist.txt')
OPEN(UNIT=11, FILE=filelist.txt')
...
CLOSE(UNIT=11, STATUS='DELETE')
to rename file: CALL SYSTEM('REN abcdef.dat abc.txt')
作者: kyra 时间: 2017-9-13 16:19
你是想获得短路径吧？
不妨试试 windows 提供的 GetShortFileName
[Fortran] 纯文本查看 复制代码
Subroutine ToDoOneFile( cFile , iLoop )
use Kernel32 , only : GetShortPathName
use , intrinsic :: ISO_C_Binding
Character( Len = * ) , Intent( IN ) :: cFile
Integer , Intent( IN ) :: iLoop
integer :: k
character(len=512) :: sFile
k = GetShortPathName( trim(cFile)//c_null_char , sFile , len(sFile) )
Write( * , * ) '第',iLoop,'个文件：', sFile(:k)
End Subroutine ToDoOneFile
作者: shrine 时间: 2017-9-13 18:09
本帖最后由 shrine 于 2017-9-13 18:11 编辑
不是，不是，
我是想把文件名改短一点，太长了拷贝到加密盘里不成功
文件很多，还有子文件夹
作者: kyra 时间: 2017-9-13 18:21
但是 GetShortFileName 可以实现这个目的。
作者: shrine 时间: 2017-9-13 18:22
本帖最后由 shrine 于 2017-9-13 18:34 编辑
我试了，把你贴的子程序用GetShortFileName代替
[Fortran] 纯文本查看 复制代码
Subroutine ToDoOneFile( cFile , iLoop )
use Kernel32 , only : GetShortFileName
use , intrinsic :: ISO_C_Binding
Character( Len = * ) , Intent( IN ) :: cFile
Integer , Intent( IN ) :: iLoop
integer :: k
!k=10
character(len=512) :: sFile
k = GetShortFileName ( trim(cFile)//c_null_char , sFile , len(sFile) )
Write( * , * ) '第',iLoop,'个文件：', sFile(:k)
End Subroutine ToDoOneFile
错误 error #6580: Name in only-list does not exist. [GETSHORTFILENAME]
作者: kyra 时间: 2017-9-13 18:43
你的IVF可能版本比较早，没有导入这个函数。你需要手动导入。
[Fortran] 纯文本查看 复制代码
Subroutine ToDoOneFile( cFile , iLoop )
use , intrinsic :: ISO_C_Binding
INTERFACE
FUNCTION GetShortPathName(lpszLongPath,lpszShortPath,cchBuffer)
import
integer :: GetShortPathName ! DWORD
!DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'GetShortPathNameA' :: GetShortPathName
!DEC$ ATTRIBUTES REFERENCE, ALLOW_NULL :: lpszLongPath
character*(*) lpszLongPath ! LPCSTR lpszLongPath
!DEC$ ATTRIBUTES REFERENCE, ALLOW_NULL :: lpszShortPath
character*(*) lpszShortPath ! LPSTR lpszShortPath
integer cchBuffer ! DWORD cchBuffer
END FUNCTION
END INTERFACE
Character( Len = * ) , Intent( IN ) :: cFile
Integer , Intent( IN ) :: iLoop
integer :: k
character(len=512) :: sFile
k = GetShortPathName( trim(cFile)//c_null_char , sFile , len(sFile) )
Write( * , * ) '第',iLoop,'个文件：', sFile(:k)
End Subroutine ToDoOneFile
作者: shrine 时间: 2017-9-13 19:36
本帖最后由 shrine 于 2017-9-13 19:38 编辑
不行，输出的还是整个文件名
我的ivf是2017
作者: kyra 时间: 2017-9-13 19:57
截图或拍照
作者: shrine 时间: 2017-9-13 20:19
[Fortran] 纯文本查看 复制代码
Program www_fcode_cn
Implicit None
integer :: n
External ToDoOneFile
call DoWithWildcard( "j:\123\*" , 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
!End Subroutine ToDoOneFile
Subroutine ToDoOneFile( cFile , iLoop )
use , intrinsic :: ISO_C_Binding
INTERFACE
FUNCTION GetShortPathName(lpszLongPath,lpszShortPath,cchBuffer)
import
integer :: GetShortPathName ! DWORD
!DEC$ ATTRIBUTES DEFAULT, STDCALL, DECORATE, ALIAS:'GetShortPathNameA' :: GetShortPathName
!DEC$ ATTRIBUTES REFERENCE, ALLOW_NULL :: lpszLongPath
character*(*) lpszLongPath ! LPCSTR lpszLongPath
!DEC$ ATTRIBUTES REFERENCE, ALLOW_NULL :: lpszShortPath
character*(*) lpszShortPath ! LPSTR lpszShortPath
integer cchBuffer ! DWORD cchBuffer
END FUNCTION
END INTERFACE
Character( Len = * ) , Intent( IN ) :: cFile
Integer , Intent( IN ) :: iLoop
integer :: k
character(len=512) :: sFile
k = GetShortPathName( trim(cFile)//c_null_char , sFile , len(sFile) )
Write( * , * ) '第',iLoop,'个文件：', sFile(:k)
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
!character(len=256) a
integer::zl
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
iTotal = 0
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
!zl=len(stInfo.Name)
!write(*,*)stInfo.Name
!write(*,*)zl
Else
if(stInfo%Name(1:1) /= "." ) then
call DoWithWildcard( cWildcard(:iLength)//trim(stInfo%Name)//"\"//cWildcard(iLength+1:) , CallBack , iTotal ) !!!文件夹，递归
endif
End If
End Do
End Subroutine DoWithWildcard
作者: kyra 时间: 2017-9-13 20:42
那就不知道为啥了。反正我这里是OK的。
你试试自己操作字符串改名吧。
作者: shrine 时间: 2017-9-13 21:36
本帖最后由 shrine 于 2017-9-13 21:53 编辑
RENAMEFILEQQ( 'a.txt', 'b.txt' )
在这个程序中，是不是RENAMEFILEQQ( stInfo.Name, 'b.txt' )？
作者: kyra 时间: 2017-9-14 07:47
你需要在 ToDoOneFile 函数中完成重命名，因为它收到的文件名是绝对路径的。而 stInfo.Name 是相对路径。
作者: shrine 时间: 2017-9-14 14:03
本帖最后由 shrine 于 2017-9-14 14:07 编辑
好的
作者: shrine 时间: 2017-9-14 20:11
本帖最后由 shrine 于 2017-9-14 21:29 编辑
终于搞定了，谢谢
| 欢迎光临 Fortran Coder (http://bbs.fcode.cn/) |
Powered by Discuz! X3.2 |