Fortran Coder

查看: 16308|回复: 7
打印 上一主题 下一主题

[子程序] 求助 GetFileInfoQQ() 函数使用

[复制链接]

7

帖子

1

主题

0

精华

入门

F 币
45 元
贡献
28 点
跳转到指定楼层
楼主
发表于 2017-10-7 18:48:48 | 只看该作者 |只看大图 回帖奖励 |倒序浏览 |阅读模式
Win7, Compaq Visual Fortran 6.6.0。 想在主程序运行过程中删除一些废弃的文件和文件夹,需要编写一个删除文件夹的子程序,调用时指定文件夹路径,用到 GetFileInfoQQ 函数获取文件夹内文件信息,但调用时输出显示,获取的是文件夹名,而不是文件夹内的文件名,请指点:
[Fortran] 纯文本查看 复制代码
        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
分享到:  微信微信
收藏收藏 点赞点赞 点踩点踩

1962

帖子

12

主题

5

精华

论坛跑堂

臭石头雪球

F 币
1353 元
贡献
572 点

美女勋章热心勋章星光勋章新人勋章贡献勋章管理勋章帅哥勋章爱心勋章规矩勋章元老勋章水王勋章

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

7

帖子

1

主题

0

精华

入门

F 币
45 元
贡献
28 点
板凳
 楼主| 发表于 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

7

帖子

1

主题

0

精华

入门

F 币
45 元
贡献
28 点
地板
 楼主| 发表于 2017-10-8 11:19:49 | 只看该作者
本帖最后由 storm_surge 于 2017-10-8 11:22 编辑

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

tmp.png (74.7 KB, 下载次数: 286)

tmp.png

1962

帖子

12

主题

5

精华

论坛跑堂

臭石头雪球

F 币
1353 元
贡献
572 点

美女勋章热心勋章星光勋章新人勋章贡献勋章管理勋章帅哥勋章爱心勋章规矩勋章元老勋章水王勋章

5#
发表于 2017-10-9 09:52:21 | 只看该作者
根据你的需求选择

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

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

7

帖子

1

主题

0

精华

入门

F 币
45 元
贡献
28 点
6#
 楼主| 发表于 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

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

系统命令删除不成功界面与代码.png (36.11 KB, 下载次数: 298)

系统命令删除不成功界面与代码.png

1962

帖子

12

主题

5

精华

论坛跑堂

臭石头雪球

F 币
1353 元
贡献
572 点

美女勋章热心勋章星光勋章新人勋章贡献勋章管理勋章帅哥勋章爱心勋章规矩勋章元老勋章水王勋章

7#
发表于 2017-10-9 17:05:12 | 只看该作者
c80_temp_2 = "rd /s /q " // trim(c80_temp_2)
注意加 /q ,不加 \*.*

7

帖子

1

主题

0

精华

入门

F 币
45 元
贡献
28 点
8#
 楼主| 发表于 2017-10-9 17:44:10 | 只看该作者
fcode 发表于 2017-10-9 17:05
c80_temp_2 = "rd /s /q " // trim(c80_temp_2)
注意加 /q ,不加 \*.*

已经解决,非常感谢!
您需要登录后才可以回帖 登录 | 极速注册

本版积分规则

捐赠本站|Archiver|关于我们 About Us|小黑屋|Fcode ( 京ICP备18005632-2号 )

GMT+8, 2024-4-26 00:42

Powered by Tencent X3.4

© 2013-2024 Tencent

快速回复 返回顶部 返回列表