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