Imports System.Text
Imports System.Security.Cryptography
 
'http://code-bude.net/2015/03/30/grundlagen-sicheres-passwort-hashing-mit-salts
'www.visual-basic-tutorials.com/hasing-password-with-salt-in-visual-basic.htm
 
Public Class PasswordClass
 
    Public Sub New()
    End Sub
 
 
    ''' <summary>Userbez. Passwort speichern</summary>
    Public Sub New(ByVal password As String)
        Create(password)
    End Sub
 
 
    ''' <summary>Userbez. Passwort überprüfen</summary>
    Public Function Check(ByVal Password As String) As Boolean
        If Not IO.File.Exists(GetFilePath) Then Return False
        Dim id() As String = IO.File.ReadAllLines(GetFilePath)
        If Not id.Length = 2 Then Return False
        Return sc(Hash512(Password, id(0)), id(1))
    End Function
 
 
    ''' <summary>Passwort ändern</summary>
    Public Sub Change(OldPW As String, NewPW As String)
        If Not Check(OldPW) Then
            Throw New ArgumentException("Passwortprüfung scheitert")
        End If
        'Besser: File zunächst nur umbenennen 
        IO.File.Delete(GetFilePath)
        Create(NewPW)
        'Das umbenannte File jetzt löschen 
    End Sub
 
 
    Private Sub Create(password As String)
 
        If IO.File.Exists(GetFilePath) Then
            Throw New ArgumentException_
              ("Ein Passwort ist bereits gespeichert")
        End If
 
        If String.IsNullOrWhiteSpace(password) OrElse _
            password.Length < 6 Then
            Throw New ArgumentException("Ungültige Passwort-Zeichenfolge")
        End If
 
        Dim cl As New List(Of String), nm, lt As Boolean
        For i As Integer = 0 To password.Length - 1
            Dim c As Char = password(i)
            If Not cl.Contains(c) Then cl.Add(c)
            If Char.IsDigit(c) Then nm = True
            If Char.IsLetter(c) Then lt = True
        Next i
        If cl.Count < 4 Then
            Throw New ArgumentException("Zu wenige unterscheidbare Zeichen")
        End If
        If Not lt Or Not nm Then
            Throw New ArgumentException _
               ("Mind. 1 Ziffer und 1 Buchstabe erforderlich")
        End If
 
        cl.Clear()
        Dim salt As String = CreateRandomSalt()
        cl.Add(salt)
        cl.Add(Hash512(password, salt))
        IO.File.WriteAllLines(GetFilePath, cl.ToArray)
 
    End Sub
 
 
    Private Function GetFilePath() As String
        Return IO.Path.Combine _
        (My.Computer.FileSystem.SpecialDirectories.CurrentUserApplicationData, _
         "UserIdent.txt")
    End Function
 
 
    Private Function sc(s1 As String, s2 As String) As Boolean
        'sicherer String-Vergleich
        If s1 Is Nothing Or s2 Is Nothing Then Return False
        If Not s1.Length = s2.Length Then Return False
        Dim ok As Boolean = True
        For i As Integer = 0 To s1.Length - 1
            If Not s1(i) = s2(i) Then ok = False
        Next i
        Return ok
    End Function
 
 
    Private Function CreateRandomSalt() As String
 
        Dim mix As String = _
        "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789!@#$%^&*(" & _
        ")_+=][}{<>"
 
        Dim salt As New StringBuilder, rndm As New Random
        For i As Integer = 1 To 100
            salt.Append(mix(rndm.Next(0, mix.Length)))
        Next i
        Return salt.ToString
    End Function
 
 
    Private Function Hash512(password As String, salt As String) As String
 
        Dim convertedToBytes As Byte() = _
              Encoding.UTF8.GetBytes(password & salt)
 
        Dim hashType As HashAlgorithm = New SHA512Managed()
        Dim hashBytes As Byte() = hashType.ComputeHash(convertedToBytes)
        Dim hashedResult As String = Convert.ToBase64String(hashBytes)
        Return hashedResult
 
    End Function
 
End Class

'Erstmaliges Erstellen .... (tbo = Textbox mit eingegebenem Passwort)
Dim pass As New PasswordClass(tbo.Text)
 
 
'Passwort ändern ....
Try
    Dim pass As New PasswordClass
    pass.Change(tbo.Text, tboNew.Text)
Catch ex As Exception
    MsgBox(ex.Message)
End Try
 
 
'Passwort prüfen
Dim pass As New PasswordClass
MsgBox(pass.Check(tbo.Text).ToString)