用星号代替屏幕输入的密码
2014-03-13 10:04:50   来源：Fcode研讨团队   评论：0 点击：

program www_fcode_cn
  character(20) :: user, password 
  call input_key( user, password )
  write(*,'(a)') user
  write(*,'(a)') password
  pause
end program www_fcode_cn

!*******************************************
!    从屏幕获取用户名和密码
!    屏幕显示密码用*号代替
!    www.fcode.cn
!    Li-XingWang   2014/03/12
!*******************************************
subroutine input_key( user, password )
  Use ifcore, only : getcharqq
  Use, Intrinsic :: ISO_FORTRAN_ENV, only : OUTPUT_UNIT, INPUT_UNIT
  implicit none
  character(*) :: user, password 
  character(*),parameter :: cLine1 = '用户名:', cLine2 = '密  码:', cET = achar(13)
  integer :: pwLen, tLen, n
  character :: ch*1 = ''
  
  pwLen = len(password) !密码最大长度
  tLen = len(cLine2) + pwlen + 1
  user=''; password=''
  write( OUTPUT_UNIT , '(a)',advance='no' )  cLine1
  read(INPUT_UNIT,*) user
  write( OUTPUT_UNIT , '(a,\)' )  cLine2
  n = 0  !记录密码长度
  open(11,file='1.txt')
  do !循环读取
    ch = getcharqq()
    select case( iachar(ch) )
    case(33:126)!允许字符
      n = min(pwLen,n+1)
      password(n:n) = ch
    case(13) !enter键
      write(OUTPUT_UNIT,*)
      exit
    case(8) !BackSpace
      n = max(0,n-1)
    case(27) !退出键(Esc)
      stop
    case(224) !无效的功能键
      ch = getcharqq()
      cycle
    case default
      cycle      
    end select
    write(OUTPUT_UNIT,101) cET  !用空格替换本行原有字符
    101 format( a,<tLen>(' '),\)
    write(OUTPUT_UNIT,'(a,\)') cET // cLine2
    if(n > 0) write(OUTPUT_UNIT,100)
    100 format( <n>('*'),\)
  end do
  if(n < pwLen) password(n+1:) = ''
end subroutine input_key