Fortran Coder

查看: 136|回复: 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
回复

使用道具 举报

1148

帖子

12

主题

5

精华

论坛跑堂

Fcode跑堂

F 币
1128 元
贡献
892 点

新人勋章贡献勋章管理勋章帅哥勋章爱心勋章规矩勋章元老勋章水王勋章

发表于 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

1148

帖子

12

主题

5

精华

论坛跑堂

Fcode跑堂

F 币
1128 元
贡献
892 点

新人勋章贡献勋章管理勋章帅哥勋章爱心勋章规矩勋章元老勋章水王勋章

发表于 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 点
 楼主| 发表于 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

1148

帖子

12

主题

5

精华

论坛跑堂

Fcode跑堂

F 币
1128 元
贡献
892 点

新人勋章贡献勋章管理勋章帅哥勋章爱心勋章规矩勋章元老勋章水王勋章

发表于 2017-10-9 17:05:12 | 显示全部楼层
c80_temp_2 = "rd /s /q " // trim(c80_temp_2)
注意加 /q ,不加 \*.*

7

帖子

1

主题

0

精华

入门

F 币
45 元
贡献
28 点
 楼主| 发表于 2017-10-9 17:44:10 | 显示全部楼层
fcode 发表于 2017-10-9 17:05
c80_temp_2 = "rd /s /q " // trim(c80_temp_2)
注意加 /q ,不加 \*.*

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

本版积分规则

QQ|捐赠本站|Archiver|关于我们 About Us|QQ群|Fcode

GMT+8, 2017-12-18 15:03

Powered by Discuz! X3.2

© 2001-2017 Comsenz Inc.

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