文件批量随机次序重命名

本代码仅能在 VF 系列编译器上使用。演示了一些非标准的文件管理函数使用方法。对有特殊需求的朋友可能会有启示。

Program www_fcode_cn
  Use msflib ! 调用模块
  Character(len=255) :: fn
  Character(len=4)   :: fn1 ! 修改文件名4字母组成，共26^4=456976种
  Character(len=6)   :: h ! 用于显示JPG文件个数的字符变量
  Character k
  Integer m, n, num, mark
  Integer , Parameter :: mx = 26**4
  Logical s
  Type (file$info) :: info
  Write (*, '(1x,a)') 'shizhengwei@yahoo.com.cn                  2012-2-26'
  Write (*, '(1x,a)') '本程序将所在目录内JPG文件改名，以按随机次序重新排列'
  Write (*, '(1x,a)') '文件名改为4个字母组成，AAAA-ZZZZ，最多26^4=456976个'
  Write (*, '(1x,a,\)') '按Enter键继续，按其它键退出程序 ...'
  k = getcharqq()
  If (k/=char(13)) Stop ' '
  Write (*, *)
  Write (*, *)
  Open (1, Status='scratch', Iostat=io)
  If (io/=0) Then
    Write (*, '(1x,a,\)') '无法建立列表用的临时文件，按任意键结束'
    k = getcharqq()
    Stop ' '
  End If
  Call random_seed() ! 由系统置随机数种子
  mark = file$first ! 设置搜寻文件的起始标志
  Do num = 1, mx ! 列表写入临时文件，避免重复查找已改文件
    n = getfileinfoqq('*.JPG', info, mark)
    If (mark==file$last .Or. mark==file$error) Exit
    fn = info .name
    Write (1, '(a)') fn(1:n)
  End Do
  num = num - 1
  If (num==mx) Then
    Write (*, '(1x,a,\)') 'JPG文件太多，无法处理。按任意键结束'
  Else If (num==0) Then
    Write (*, '(1x,a,\)') '没有找到JPG文件。按任意键结束'
  Else
    Write (h, '(i6)') num
    Write (*, '(1x,3a)') '共找到', h(6-int(log10(num*1.0)):6), '个JPG文件'
    Rewind (1) ! 根据num数值大小调整显示字符的长度
    Do While (.True.) ! 文件改名
      Read (1, '(a)', Iostat=io) fn
      If (io/=0) Exit
      Do While (.True.)
        Call random_number(x)
        m = mx*x
        Do i = 4, 1, -1 ! 10进制转26进制，形成新文件名
          fn1(i:i) = char(65+mod(m,26))
          m = m/26
        End Do
        s = renamefileqq(trim(fn), fn1//'.JPG')
        If (s) Exit ! 改名失败再循环，针对重名等小概率情况
      End Do
    End Do
    Write (*, '(1x,a,\)') 'JPG文件改名完毕，按任意键结束'
  End If
  Close (1) ! 先关临时文件，防止直接关窗口造成文件残留
  k = getcharqq()
End Program www_fcode_cn