点击浏览该文件
本程序将所在目录内JPG文件改名 ，以按随机次序重新排列。
可用于对不具随机播放功能数码相框中的照片文件作乱序排列。
文件名改为4个字母组成，AAAA-ZZZZ，最多26^4=456976个。
作者：fortranboy

 

$freeform              ! 将所在目录内JPG文件改名，以按随机次序重新排列
                             ! shizhengwei@yahoo.com.cn            2012-2-26
use msflib             ! 调用模块
character*255 fn
character*4 fn1       ! 修改文件名4字母组成，共26^4=456976种
character*6 h          ! 用于显示JPG文件个数的字符变量
character k
integer m,n,num,mark,mx
parameter (mx=456976)
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.ne.char(13)) stop ' '
write(*,*)
write(*,*)
open(1,status='scratch',iostat=io)
if(io.ne.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.eq.file$last.or.mark.eq.file$error) exit
   fn=info.name
   write(1,'(a)') fn(1:n)
end do
num=num-1
if(num.eq.mx) then
   write(*,'(1x,a,\)') 'JPG文件太多，无法处理。按任意键结束'
else if(num.eq.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.ne.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