Снова о паролях

Джон Торренс (John Torrance)

Программа принимает пароль и сравнивает его с тем паролем, который был передан в качестве параметра. В зависимости от правильности ввода возвращает .T. или .F.. Необязательные параметры контролируют число неудачных попыток и время ожидания ввода пароля. Если верный пароль не передан в качестве параметра, процедура возвращает .T..

_PassWord - пароль, с которым сравнивается ввод пользователя. Не различает строчных и прописных букв.

_NumTries - число попыток ввода пароля. По умолчанию принимается 1.

_TimeOut - время ожидания ввода пароля. Если пользователь не нажмет клавишу в течение указанного промежутка времени (хотя бы он находился в середине ввода пароля), то что введено на данный момент рассматривается как введенный пароль. По умолчанию программа ожидает неограниченное время. Параметр необязательный.

PROCEDURE password
PARAMETER _password, _numtries, _timeout
PRIVATE m.password, m.retval, I
m.retval = .T.
m.talkstat = SET("TALK")
SET TALK OFF
IF !EMPTY( _password )   
*
* устанавливаем значения умолчания 
* для числа попыток (1) и времени ожидания (0)
   IF EMPTY( _numtries )
      _numtries = 1
   ENDIF
   IF EMPTY( _timeout )
      _timeout = 0
   ENDIF   
*
*  Определяем и активизируем окно
   DEFINE WINDOW lw_pass  AT 0,0  SIZE 4.5,100;
         FONT "MS Sans Serif", 8 ;
         NOFLOAT NOCLOSE NOMINIMIZE ;
         SYSTEM  COLOR RGB(,,,192,192,192)
   MOVE WINDOW lw_pass CENTER
   ACTIVATE WINDOW lw_pass   
*
* Инициализируем счетчик попыток 
* и устанавливаем величину возврата как .F.
   i = 0
   m.retval = .F.   
*
* Крутим цикл до тех пор, пока 
* пользователь не введет верный пароль
* или пока не будет исчерпано число попыток
   DO WHILE !m.retval .AND. i < _numtries      
*
* Выводим приглашение и получаем 
* введенное слово
      @ 1.385,4.4 SAY "Please enter password:";
          FONT "MS Sans Serif", 12  STYLE "BT"
      m.password = passenter( _timeout )      
*
*  Проверяем пароль на правильность
      DO CASE
         CASE TRIM(m.password) == TRIM;
          (UPPER(LEFT(_password+SPACE(32),32)))
            m.retval = .T.
         *-- Это позволяет пользователю выйти
         * (с возвратом .F.), если он
         * нажал ВВОД при пустом пароле
         CASE EMPTY( m.password )
            i = _numtries - 1
         OTHERWISE
            SET BELL TO 220,18
            WAIT WINDOW ;
              NOWAIT " Invalid Password "
            ?? CHR(7)
            SET BELL TO
      ENDCASE
      i = i + 1
   ENDDO
   RELEASE WINDOW lw_pass
ENDIF
SET TALK &talkstat
SET BELL TO
WAIT CLEAR
RETURN m.retval

* Процедура принимает пароль 
* от пользователя без отображения 
* вводимых символов на экране
PROCEDURE passenter
PARAMETER _timeout
PRIVATE _x, _retvalcurset = SET("CURSOR")

SET CURSOR OFF
_x = 0_retval = ''
_falsepass = SPACE(32)
@ 1.8,43.5 GET _falsepass  SIZE 1,32.5 ;
   DEFAULT " " ;
   FONT "FoxFont", 9  ;
   COLOR ,RGB(,,,255,255,255)
CLEAR GETS
DO WHILE _x <> 13
   _x = INKEY( _timeout )
   DO CASE
      CASE _x = 127 .OR. _x = 19
             && Backspace или стрелка влево
         IF LEN( _retval ) > 0
            _retval = LEFT;
              ( _retval, LEN( _retval ) - 1 )
         ELSE
            SET BELL TO 440,2
            ?? CHR(7)
            SET BELL TO
         ENDIF
      CASE _x = 0
         _x = 13
      CASE _x = 13
      OTHERWISE
         _retval = _retval + CHR( _x )
   ENDCASE
   _falsepass = LEFT(REPLICATE('', LEN;
    (TRIM(_retval)))+SPACE(32), 32)
   @ 1.8,43.5 GET _falsepass  ;
     SIZE 1,32.5 DEFAULT " " ;
     FONT "FoxFont", 9  ;
     COLOR ,RGB(,,,255,255,255)
   CLEAR GETS
ENDDO
SET CURSOR &curset
RETURN UPPER(TRIM(_retval))