- Fortran中文网 (http://fortran.cn/bbs/index.asp)
-- Fortran语言开发经验交流 (http://fortran.cn/bbs/list.asp?boardid=3)
---- [原创]将所在目录内JPG文件改名，以按随机次序重新排列 (http://fortran.cn/bbs/dispbbs.asp?boardid=3&id=2684)
-- 发布时间：2012/2/28 9:55:30
-- [原创]将所在目录内JPG文件改名，以按随机次序重新排列
点击浏览该文件本程序将所在目录内JPG文件改名 ，以按随机次序重新排列。
可用于对不具随机播放功能数码相框中的照片文件作乱序排列。
文件名改为4个字母组成，AAAA-ZZZZ，最多26^4=456976个。
作者：fortranboy
-- 发布时间：2012/2/28 9:56:46
--
$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