Aplikacja konsolowa - jak pobrać hasło

Czasami przy pisaniu aplikacji konsolowej zachodzi potrzeba pobrania od użytkownika hasła. Jak wiadomo procedura ReadLn pokazuje na ekranie wpisywane znaki więc nie nadaje się do tego celu. Poniższy kod pokazuje jak w prosty sposób wykonać to zadanie.

program PasswordTest;

{$APPTYPE CONSOLE}

uses Windows;

function ReadChar: Char;
var
  InptHnd: THandle;
  NumRead: Cardinal;
  InptRec: TInputRecord;
begin
  InptHnd := GetStdHandle(STD_INPUT_HANDLE);
  repeat
    ReadConsoleInput(InptHnd, InptRec, 1, NumRead);
    Result := InptRec.Event.KeyEvent.AsciiChar;
    if (InptRec.EventType and KEY_EVENT <> 0) and (Result <> #0)
      and InptRec.Event.KeyEvent.bKeyDown then Break;
  until False;
end;

procedure BackSpace;
var
  OtptHnd: THandle;
  Csbi: TConsoleScreenBufferInfo;
  Crd: TCoord;
  I: Integer;
  Noaw: Cardinal;
begin
  OtptHnd := GetStdHandle(STD_OUTPUT_HANDLE);
  GetConsoleScreenBufferInfo(OtptHnd, Csbi);
  Crd := Csbi.dwCursorPosition;
  I := Pred(Crd.X + (Csbi.dwMaximumWindowSize.X * Crd.Y));
  Crd.X := I mod Csbi.dwMaximumWindowSize.X;
  Crd.Y := I div Csbi.dwMaximumWindowSize.X;
  FillConsoleOutputCharacter(OtptHnd, #32, 1, Crd, Noaw);
  SetConsoleCursorPosition(OtptHnd, Crd);
end;

function ReadPasswd(PasswdChar: Char = '*'): string;
var
  Ch: Char;
  I: Integer;
begin
  Result := '';
  repeat
    Ch := ReadChar;
    case Ch of
      #08:
        begin
          I := Length(Result);
          if I > 0 then
          begin
            Delete(Result, I, 1);
            BackSpace;
          end;
        end;
      #13:
        Break;
    else
      Result := Result + Ch;
      Write(PasswdChar);
    end;
  until False;
  WriteLn;
end;

var
  Pass: string;
begin
  Write('Enter password: ');
  Pass := ReadPasswd;
  Write('Your password is "', Pass, '".');
  ReadLn;
end.