Dynamisches Passwort

.. das wohl mächtigste Werkzeug in Bill Gates' Büro-Sippe. Ob reine Formeln, PowerQuery oder VBA. Hier bleiben kaum Wünsche unerfüllt.
Benutzeravatar
d'r Bastler
Beiträge: 832
Registriert: 29. Aug 2022, 13:20
Hat sich bedankt: 224 Mal
Danksagung erhalten: 119 Mal

Dynamisches Passwort

#1

Beitrag von d'r Bastler »

Moin allerseits,
was macht ein Bastler, dem ein etwas komplexeres Projekt aber derartig in die Hose gegangen ist, dass sich XL gleich mehrfach dem Suizid hingibt? Er bastelt aus Frust eine Spielerei. Hier ist sie:

Eine kleine UserForm, die ein dynamisch generiertes Passwort abfragt. Das PW wird per Bildungsregel gebaut und benötigt ein weiteres Zeichen, das man aus einer Tabelle auslesen kann. Bei solch einem Passwort kann einem der Kollege noch so genau über die Schulter schauen und wird spätestens eine Stunde später beim Einloggen scheitern ... :P

Man nehme - eine Userform mit einer Textbox und einem CommandButton, die dann folgenden Code bekommt:

Code: Alles auswählen

Option Explicit

Sub UserForm_Activate()
    DynPW				'ruft den PW-Generator auf
    'MsgBox sPW, , iFails 	'zum Testen
    iFails = 0
    tbxPassWord.SetFocus
End Sub

Sub cmdSubmit_Click()

If tbxPassWord = sPW Then
        Me.Hide
        Application.StatusBar = False
        MsgBox "Du bist drin!"  'hier kommt statt der MB der aufzurufende Code hin
    Else
        iFails = iFails + 1
        MsgBox "Failed!", , iFails & "/3"
        With tbxPassWord
            .Text = ""
            .SetFocus
        End With
        If iFails >= 3 Then			'schmeisst den Eindringling nach drei Fehlversuchen raus
            Application.StatusBar = False
            usfPassWord.Hide
            'Application.Quit			'das wäre die ganz harte Version		
            Exit Sub
    End If
End If

End Sub
In einem Modul wird das PW generiert, hier auf Basis des Datum, der Uhrzeit und ASCII-Code. Und da bieten sich noch viele andere Möglichkeiten, die leicht konstrukturierbare PWs bauen lassen. Etwas versteckt gibt das Tool einen kleinen Hinweis auf das letzte Zeichen des PWs: In der StatusBar.

Code: Alles auswählen

Option Explicit
Public iFails As Byte, sPW As String

Sub DynPW()
Dim vDate As String
Dim i As Integer, iSum As Integer, vDigit

iFails = 0
sPW = ""
vDate = Date & Hour(Now)

For i = 1 To Len(vDate) + 2
    vDigit = Mid(vDate, i, 1)
    If IsNumeric(vDigit) = True And vDigit > 0 Then
        sPW = sPW & vDigit
        iSum = iSum + vDigit
    End If
Next i

sPW = sPW & Chr$(iSum + 63)

Application.StatusBar = iSum - 1
End Sub
Viel Spaß damit und liebe Grüße!

Nachtrag: Das Potential, das in diesem Tool steckt, ist nur durch die Anzahl üblicher Schriftzeichen beschränkt. Denn - ob man wie hier das aktuelle Datum verwendet, den chinesischen Mondkalender (abgelegt als Referenz-Array) oder einen online abzufragenden DAX-Wert, ist lediglich der Fantasie des Bastlers überlassen. Wobei man immer wissen sollte: XL ist ungefähr so gut abzusichern wie Fort Knox ohne Schlösser und Wachdienst...
Folgende Benutzer bedankten sich beim Autor d'r Bastler für den Beitrag:
thowe
d'r Bastler von den VBAsteleien.de
Win 10 + Office 2019 & Win11 + Office 2021 + Visio 2019 pro & macOS.X15 + Office2019pro & Android12 & XL365

Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 0 Gäste