storm_surge 发表于 2017-10-7 18:48:48

求助 GetFileInfoQQ() 函数使用

Win7, Compaq Visual Fortran 6.6.0。 想在主程序运行过程中删除一些废弃的文件和文件夹，需要编写一个删除文件夹的子程序，调用时指定文件夹路径，用到 GetFileInfoQQ 函数获取文件夹内文件信息，但调用时输出显示，获取的是文件夹名，而不是文件夹内的文件名，请指点：

      subroutine ClearFilesInDir(cFileDir,iFile)
                use DFLib, only: GetFileInfoQQ,GetLastErrorQQ,FILE$INFO,FILE$LAST,FILE$ERROR,FILE$FIRST,ERR$NOMEM, &
                                 ERR$NOENT,FILE$DIR,DeldirQQ,DELFILESQQ,systemQQ
                Implicit None
                logical DirDeleted
                Character(255) cFileName
                Character*(*),Intent(IN)::cFileDir!,Dirtmp
                !character*(*),intent(IN)::output
                integer,Intent(Out)::iFile ! 找到文件的信息
                Type(FILE$INFO)::info
                Integer(4)::Wildhandle,length,iresult

                Wildhandle=FILE$FIRST
                iFile=0
                        dirdeleted=systemQQ('dir '//trim(cFileDir));pause
                Do WHILE (.TRUE.)
                        iresult=GetFileInfoQQ(trim(cFileDir),info,Wildhandle)!//'\' 不可以加在路径名后
                        print*,'creation=',info.creation
                        print*,'lastwrite=',info.lastwrite
                        print*,'lastaccess=',info.lastaccess
                        print*,'length=',info.length
                        print*,'permit=',info.permit
                        print*,'name=',trim(info.name)
                        print*,'handle=',Wildhandle
                        print*, 'iresult=', iresult
                        if( (Wildhandle.eq.FILE$LAST).or.(Wildhandle.eq.FILE$ERROR) )then
                              select case(GetLastErrorQQ())
                              case(ERR$NOMEM)! 内存不足
                                        iFile=-1
                              case(ERR$NOENT) ! 碰到通配符序列尾，正常退出
                                        return
                              case default
                                        iFile=0
                                        Return
                              endselect
                        endif
                        iFile=iFile+1
                        cFileName=trim(info.Name)
                        print*,trim(info.Name)
                        print*,trim(cFileDir)
                        print*,' iFile=',iFile
                        DirDeleted=DELFILESQQ(trim(cFileDir)//'\'//trim(info.Name))
                !      call WriteFileName(Trim(info.Name),output,iFile)! WriteFileName 函数没有定义
                ENDDO
                DirDeleted=DeldirQQ(cFileDir)
      end subroutine ClearFilesInDir

fcode 发表于 2017-10-8 10:06:17

详解 http://cvfwin7.w.fcode.cn
为何不考虑 call system("rd /s /q cFileDir\*.*")

storm_surge 发表于 2017-10-8 11:17:31

fcode 发表于 2017-10-8 10:06
详解 http://cvfwin7.w.fcode.cn
为何不考虑 call system("rd /s /q cFileDir\*.*")

谢谢！我试了一下你给的建议，但遇到下面问题
第二张是去掉了/q ；第三张是改全英文目录试的
D:\selft\tmp.png

storm_surge 发表于 2017-10-8 11:19:49

本帖最后由 storm_surge 于 2017-10-8 11:22 编辑

调试结果图没有显示啊，我改附件传上来。三种都是出现语法不正确，不知道是怎么回事。

fcode 发表于 2017-10-9 09:52:21

根据你的需求选择

rd /s /q E:\delft_grid\tmp
% 删除 tmp 整个文件夹

rd /s /q E:\delft_grid\tmp\20160831
% 删除 20160831 整个文件夹

storm_surge 发表于 2017-10-9 16:39:41

本帖最后由 storm_surge 于 2017-10-9 16:43 编辑

fcode 发表于 2017-10-9 09:52
根据你的需求选择

rd /s /q E:\delft_grid\tmp

删除还是不成功，不知道是什么原因。

fcode 发表于 2017-10-9 17:05:12

c80_temp_2 = "rd /s /q " // trim(c80_temp_2)
注意加 /q ，不加 \*.*

storm_surge 发表于 2017-10-9 17:44:10

fcode 发表于 2017-10-9 17:05
c80_temp_2 = "rd /s /q " // trim(c80_temp_2)
注意加 /q ，不加 \*.*

已经解决，非常感谢！
页: [1]
查看完整版本: 求助 GetFileInfoQQ() 函数使用