Imports System.Windows.Forms
Public Class TextBoxPW
    Inherits TextBox
 
    Private Const MaskChar As Char = "*"c   'maskierendes Zeichen 
    Private Const MaxChars As Integer = 10  'maximal zulässige Zeichenzahl
    Private Const EmptyChar As Char = "_"c  'Zeichen zur Anzeige verfügbarer 
    ' Länge
 
    Private Const InvalidChars As String = _
          " (){}[]=?^°€@" & EmptyChar & MaskChar 'unzulässige Zeichen
 
    'Anzeigedauer für das zuletzt eingegebene Zeichen
    Private Const DisplayMilliSeconds As Integer = 1000
 
    Private _lastpresstime As Date 'Zeitpunkt der letzten Zeichen-Eingabe
    Private _input As New System.Text.StringBuilder 'eingegebene Zeichenfolge
 
    Private WithEvents timKeyMask As New Timer With _
        {.Interval = 500, .Enabled = True}
    Private _ismasked As Boolean = False 'Kennung für Art der Anzeige
 
    'Benachrichtigung bei return
    Public Event Done(sender As Object, e As EventArgs)
 
 
    Protected Overrides Sub OnKeyPress(e As _
      System.Windows.Forms.KeyPressEventArgs)
 
        If Not Char.IsControl(e.KeyChar) And _input.Length < MaxChars Then
            MyBase.OnKeyPress(e)
            MaskInput(e.KeyChar, True)
        End If
        e.Handled = True
    End Sub
 
 
    Protected Overrides Sub OnKeyDown(e As System.Windows.Forms.KeyEventArgs)
        MyBase.OnKeyDown(e)
 
        'Zeichen immer hinten anhängen
        Me.SelectionStart = _input.Length
 
        If e.KeyCode = Keys.Back AndAlso _input.Length > 0 Then
            'Letztes Zeichen löschen
            _input.Length -= 1
            MaskInput(Nothing, False)
        ElseIf e.KeyCode = Keys.Return Then
            'Beendigung der Eingabe melden
            RaiseEvent Done(Me, EventArgs.Empty)
        End If
        e.Handled = True
    End Sub
 
 
    Private Sub timKeyMask_Tick(sender As Object, e As System.EventArgs) _
      Handles timKeyMask.Tick
        Dim period As Long = Now.Ticks - _lastpresstime.Ticks
 
        If period > TimeSpan.TicksPerMillisecond * DisplayMilliSeconds And _
            Not _ismasked Then MaskInput(Nothing, False)
    End Sub
 
 
    Private Sub MaskInput(ByVal newchar As Char, ByVal shownewchar As Boolean)
 
        If InvalidChars.Contains(newchar) Then Exit Sub 'unzulässiges Zeichen
 
        MyBase.Text = New String(MaskChar, _input.Length) 'Maske: vorhandene 
        ' Zeichen
        If Not newchar = Nothing Then
            _input.Append(newchar)
            If shownewchar Then
                MyBase.AppendText(newchar)
                _lastpresstime = Now
            Else
                MyBase.AppendText(MaskChar)
            End If
        End If
 
        If _input.Length < MaxChars Then
            'Maske: noch verfügbare Zeichen
            MyBase.AppendText(New String(EmptyChar, MaxChars - _input.Length))
        End If
        MyBase.SelectionStart = _input.Length
        _ismasked = Not shownewchar
    End Sub
 
 
    ''' <summary>Abfrage der eingegebenen Zeichenfolge</summary>
    Public Shadows ReadOnly Property Text As String
        Get
            Return _input.ToString
        End Get
    End Property
End Class

Public Shadows ReadOnly Property Text As String

Protected Overrides Sub OnLostFocus(e As System.EventArgs)
        MyBase.OnLostFocus(e)
        MyBase.Text = New String(MaskChar, MaxChars)
End Sub
 
Protected Overrides Sub OnGotFocus(e As System.EventArgs)
        MyBase.OnGotFocus(e)
        MaskInput(Nothing, False)
End Sub

Public Sub SetPassword(ByVal pw_test As String)
   For i As Integer = 0 To pw_test.Length - 1
       MaskInput(pw_test(i), True)
       Threading.Thread.Sleep(500)
   Next i
   RaiseEvent Done(Me, EventArgs.Empty)
End Sub

Public Class frmPasswort
 
    Dim lblPass As New Label With _
          {.Parent = Me, .Text = "Passwort: ", .Top = 40, .Width = 100}
    Dim WithEvents txtPass As New TextBoxPW With _
          {.Parent = Me, .Top = 40, .Width = 200, .Left = 105}
    Dim lblInfo As New Label With _
          {.Parent = Me, .Top = 80, .Width = 300}
 
 
    Private Sub frmPasswort_Load(sender As System.Object, _
        e As System.EventArgs) Handles MyBase.Load
        Me.Size = New Size(320, 300)
        Me.FormBorderStyle = Windows.Forms.FormBorderStyle.FixedDialog
    End Sub
 
 
 
    Private Sub txtPass_Done(sender As Object, e As System.EventArgs) Handles _
      txtPass.Done
 
        Static counter As Integer = 0
 
        Dim userinput As String = txtPass.Text
 
        Dim password As String = ""
 
        Using sr As New IO.StreamReader("Pfad der PasswortDatei")
            password = sr.ReadLine()
        End Using
 
        'Passwort entschlüsseln
        Dim password_encrypted As String = password '???
 
        If password_encrypted = userinput Then
            Me.DialogResult = Windows.Forms.DialogResult.OK
            Me.Close()
        ElseIf counter < 3 Then
            counter += 1
            lblInfo.Text = "Das Passwort ist falsch"
        Else
            Me.DialogResult = Windows.Forms.DialogResult.Cancel
            Me.Close()
        End If
    End Sub
End Class

''' <summary>Löschen der Eingabe</summary>
Public Shadows Sub Clear()
   MyBase.Text = String.Empty 'Anzeige löschen
   _input.Clear()             'gespeicherte Zeichenfolge löschen
   MaskInput(Nothing, False)  'Anzeige einrichten
End Sub