请问怎么获得包括子文件夹的所有文件名

shrine

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

重名就后面-1 -2 -3

中文可以略去

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

chiangtp

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

你是想获得短路径吧？

不妨试试 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

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

不妨试试 windows 提供的 GetShortFileName

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

文件很多，还有子文件夹

kyra

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

shrine

kyra 发表于 2017-9-13 18:21
但是 GetShortFileName 可以实现这个目的。

我试了，把你贴的子程序用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

你的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

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

[mw_shl_code=fortran,true]

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

我的ivf是2017

kyra

截图或拍照

shrine

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

[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