! 照片文件时间重置为照片记录的拍摄时间
! 照片文件按照拍摄时间值重新命名，以使不同相机的照片能按时间序排列
! 施正伟
! 2010-05-20 编写
! 2010-12-31 修改：文件名中首个空格右侧开始的文字作为照片注释在新文件名中保留
! 2019-05-06 修改：解决了部分手机数码日期和原始日期的相对偏移不固定造成的识别问题
! 启动for命令回调程序，搜索所在目录及子目录，对JPG文件重设定时间、重新命名
! //fcode.cn
! 2019-06-06 修改：取消对msflib库的依赖，改为标准语法。取消对文件日期的修改
! 编译选项：缺省值
Program Main
Implicit None
Integer , parameter :: NC = 10000
Character,parameter :: c = ':'
character(len=nc) :: h ! 字符串长度
character(len=512) :: fn,self,cCmd ! fn-文件名；self-本程序名
character(len=19) :: dt ! 读取的时间字符串
character(len=8) :: ft ! 以时间值表示的文件名(开始8个字符)
integer :: fn_len,n,n1 ! fn的长度，去除路径的文件名起始位置，文件名注释部分起始位置
integer :: result , IO,J,I
integer :: y,m,d,hh,mm,ss
integer :: timedate,timedate_save! 文件时间值及临时保存值(用于比对是否重复)
if( command_argument_count() == 0 ) then ! 若不带参数直接调用，启动for命令搜索并回调
call get_command_argument( 0 , self , n )
write(*,*) '按拍摄时间对JPG照片文件重新命名的小程序'
write(*,*) 'szw_sh@163.com 2019-05-04'
write(*,*) '请注意！'
write(*,*) '本程序所在目录及其子目录内含有exif数据的照片文件将被重命名；'
write(*,*) '文件名中首个空格右侧开始的文字作为照片注释在新文件名中保留。'
write(*,*) '按Enter键继续，按其它键退出程序 ...'
read(*,'(a)') cCmd(1:1)
if( cCmd(1:1)==' ') then
cCmd = 'for /r %1 in (*.JPG) do @"'//self(1:n)//'" "'//'%1"'
call execute_command_line(cCmd,wait=.true.,exitstat=result)
if(result==0) then
write(*,*) '照片文件名修改完毕'
else
write(*,*) '程序出错，按任意键结束'
read(*,*)
end if ! 使用双引号，使得路径和文件名有空格时也能正确执行
else
write(*,*) '未作修改，程序结束'
end if
else ! 带参数的回调过程
call get_command_argument(1,fn,fn_len) ! 读取和检验照片文件名、文件大小
open(12,file=fn(1:fn_len),access='stream',status='old',action='read',iostat=io)
if(io/=0) stop 'JPG file not found.'
read(12,iostat=io) h
if(io/=0) stop 'JPG file too small.'
close(12)
do n=1,nc-40 ! 读取照片拍摄日期、时间（使用特征搜索）
if(h(n+ 4:n+ 4)/=c) cycle
if(h(n+ 7:n+ 7)/=c) cycle
if(h(n+13:n+13)/=c) cycle
if(h(n+16:n+16)/=c) cycle
exit
end do
do n=n+17,nc-40
if(h(n+ 4:n+ 4)/=c) cycle
if(h(n+ 7:n+ 7)/=c) cycle
if(h(n+13:n+13)/=c) cycle
if(h(n+16:n+16)/=c) cycle
exit
end do
if( n > nc-40 ) stop 'Exif data not found.'
dt=h(n:n+18) ! 提取记录时间的字符串，读取数值
read(dt( 1: 4),'(i4)') y
read(dt( 6: 7),'(i2)') m
read(dt( 9:10),'(i2)') d
read(dt(12:13),'(i2)') hh
read(dt(15:16),'(i2)') mm
read(dt(18:19),'(i2)') ss
call Date2UnixTime(y,m,d,hh,mm,ss,timedate)
timedate_save=timedate
n=index(fn,'\',.true.) ! 修改文件名
n1=index(fn(n+1:fn_len),' ')+n ! 搜寻去除路径的文件名中的第一个空格
if(n1>n) then ! 搜寻注释部分的第一个非空格字符位置
do n1=n1,fn_len
if(fn(n1:n1)/=' ') exit
end do
end if
do j=1,120
timedate=timedate_save
do i=8,1,-1
ft(i:i)=char(65+mod(timedate,26))
timedate=timedate/26
end do
if(n1>n) then ! 按有无注释内容修改文件名
cCmd = 'ren "'//fn(1:fn_len)//'" "'//ft//' '//fn(n1:fn_len-4)//'.JPG"'
else
cCmd = 'ren "'//fn(1:fn_len)//'" "'//ft//'.JPG"'
end if
call execute_command_line(cCmd,wait=.true.,exitstat=result)
if(result==0) then
exit
else
timedate_save=timedate_save+1 ! 若遇重名，时间值向后递增1秒，限120秒
end if
end do
end if
contains
Subroutine Date2UnixTime( year , mon , day , hour , min , sec , iUnixTime )
!// Convert Date and time to UnixTime ( Seconds since 1970 )
!// Range From 1970 to January 19, 2038 03:14:07
!// write by gao@fcode.cn @@ www.fcode.cn
Implicit None
Integer , Intent(IN) :: year , mon , day , hour , min , sec
Integer , Intent(OUT) :: iUnixTime
integer :: iy , im
integer :: a
real :: jd
if ( mon > 2 ) then
iy = year
im = mon
else
iy = year - 1
im = mon + 12
end if
a = INT(iy / 100)
a = 2 - a + INT(a/4)
JD = INT(365.25*(iy + 4716)) + INT(30.60001*(im + 1)) + day + a -1524.5
iUnixTime = Int( (JD-2440587.5)*86400) + hour*3600 + min*60 + sec
End Subroutine Date2UnixTime
End Program main
大图
