VCF文件UTF-8加密码转换为明码

! 将 VCF 文件 UTF-8 加密码转换为明码的小程序
! szw_sh@163.com
! 2015.03.01
Program www_fcode_cn
  Implicit None
  Character(Len=1024) :: h
  Character(Len=11)   :: t
  Character(Len=*) , parameter :: d = ';ENCODING=QUOTED-PRINTABLE'  ! 特征字符串
  Character(Len=*) , parameter :: mark = char(#ef)//char(#bb)//char(#bf) ! utf-8文件头
  Integer(Kind=2) , parameter :: len_d = len(d)
  Integer , parameter :: rec_max = huge(i) - 1 ! 最大记录行数
  Integer(Kind=2) :: len_h, n
  Integer(Kind=4) :: i , io , io1 , io2 , k
  Write (*, *)
  Write (*, *) '将 VCF 文件 UTF-8 加密码转换为明码的小程序'
  Write (*, *) 'szw_sh@163.com                  2015.03.01'
  Open (1, File='source.vcf', Status='old', Iostat=io) ! 已存在的源vcf
  If (io/=0) Call stop_prg('请将源文件复制或重命名为 SOURCE.VCF !')
  Open (2, File='target.vcf') ! 目标vcf
  Read (1, '(a)', Iostat=io) h ! 判断和添加utf-8文件头
  Backspace (1, Iostat=io)
  If (h(1:3)/=mark) Write (2, '(a,\)', Iostat=io2) mark
  Write (*, *)
  Do i = 1, rec_max
    Read (1, '(a)', Iostat=io1) h
    If (io1/=0) Exit
    If (mod(i,321)==0) Then ! 行计数，显示
      Write (t, '(i11)') i
      n = index(t, ' ', .True.)
      Write (*, '(3a,\)') char(13), '已转换行数 = ', t(n+1:11)
    End If
    n = index(h, d) ! 特征字符串起始位置，h的有效长度
    len_h = len_trim(h)
    If (n>2) Then !!! 需要转换的行
      Write (2, '(a,\)', Iostat=io2) h(1:n-1) ! 按utf-8明码的vcf格式，删除d字符串，补写':'
      Write (2, '(a,\)', Iostat=io2) ':'
      n = n + len_d + 1
      Do While (n<=len_h)
        If (h(n:n)=='=') Then ! 将'=xx'表达的16进制码转为1字节ascii字符
          Read (h(n+1:n+2), '(Z2)', Iostat=io) k
          If (io/=0) Call stop_prg('SOURCE.VCF 中含有不规范的 UTF-8 加密码格式!')
          Write (2, '(a,\)', Iostat=io2) char(k)
          n = n + 3
        Else ! 遇到非'=xx'格式字串，直接写入目标vcf
          Write (2, '(a,\)', Iostat=io2) h(n:n)
          n = n + 1
        End If
      End Do
      Write (2, '()', Iostat=io2) ! 空写动作，完成本条记录
    Else !!! 不需要转换的行
      Write (2, '(a)', Iostat=io2) h(1:len_h)
    End If
    If (io2/=0) Call stop_prg('磁盘写保护、磁盘空间不足或 TARGET.VCF 为只读属性 !')
  End Do
  Write (t, '(i11)') i - 1 ! 显示总行数和结果
  n = index(t, ' ', .True.)
  Write (*, '(3a)') char(13), '总转换行数 = ', t(n+1:11)
  Write (*, *) '转换结果已输出到 TARGET.VCF !'
  If (i>rec_max) Then
    Call stop_prg('SOURCE.VCF 行数过多，超出部分未作转换 !')
  Else
    Call stop_prg(' ')
  End If
End Program www_fcode_cn

Subroutine stop_prg(h) ! 子程序：提示信息并中止
  Use msflib
  Implicit None
  Character(Len=*)   :: h
  Character(Len=512) :: fn
  Character :: key
  Integer(Kind=2) :: n, n_exit
  If (h/=' ') Then ! 显示非空信息
    Write (*, *)
    Write (*, *) h
  End If
  Call getarg(0_2, fn, n)
  n_exit = index(fn(1:n), '\') ! 标记，若从资源管理器中双击调用，结束时停留
  If (n_exit>0) Then
    Write (*, *)
    Write (*, *) '按任意键结束程序'
    key = getcharqq()
  End If
  Stop ' '
End Subroutine stop_prg