请问怎么获得包括子文件夹的所有文件名-编程工具交流-专业Fortran论坛

shrine 发表于 2017-9-13 13:06:55

kyra 发表于 2017-9-13 12:23
这中间涉及到很多问题，比如重名怎么办？
比如

重名就后面-1 -2 -3

中文可以略去

批处理怎么实现只取前十个字符，并且保留后缀？我网上搜了，包括使用楼上说的命令dir导出后然后做bat文件，觉得还是写个程序比较好，但是Fortran文件处理功能原来确实没有接触过

chiangtp 发表于 2017-9-13 14:20:08

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:58

你是想获得短路径吧？

不妨试试 windows 提供的 GetShortFileName

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:12

本帖最后由 shrine 于 2017-9-13 18:11 编辑

kyra 发表于 2017-9-13 16:19
你是想获得短路径吧？

不妨试试 windows 提供的 GetShortFileName

不是，不是，
我是想把文件名改短一点，太长了拷贝到加密盘里不成功

文件很多，还有子文件夹

kyra 发表于 2017-9-13 18:21:08

但是 GetShortFileName 可以实现这个目的。

shrine 发表于 2017-9-13 18:22:13

本帖最后由 shrine 于 2017-9-13 18:34 编辑

kyra 发表于 2017-9-13 18:21
但是 GetShortFileName 可以实现这个目的。
我试了，把你贴的子程序用GetShortFileName代替
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.

kyra 发表于 2017-9-13 18:43:02

你的IVF可能版本比较早，没有导入这个函数。你需要手动导入。

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:44

本帖最后由 shrine 于 2017-9-13 19:38 编辑

kyra 发表于 2017-9-13 18:43
你的IVF可能版本比较早，没有导入这个函数。你需要手动导入。

不行，输出的还是整个文件名

我的ivf是2017

kyra 发表于 2017-9-13 19:57:04

截图或拍照

shrine 发表于 2017-9-13 20:19:04

kyra 发表于 2017-9-13 19:57
截图或拍照

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

页: 1 [2] 3

Fortran Coder's Archiver