Di seguito un meccanismo da me scritto semplice (sicuramente ottimizzabile), per il calcolo della complessità di una password digitata, il meccanismo di calcolo è semplicemente basato sulle disposizioni con ripetizione di N elementi presi a K a K, mentre la scala è basata su decibel :) . Viene dato un peso notevolmente basso alle password contenenti un solo carattere ripetuto, password banalissima da individuare e caso limite da escludere dalle disposizioni con ripetizione.


Procedure CheckPassword(Const aMaxChars : Integer;
Const aPassword: String;
Var aMinDecibelValue,
aCurrentDecibelValue : Real );
Const
cRipetitionValue = 100;

Type
cChars = (ccLowCaseChars,ccUpCaseChars,ccNumbers,ccSymbols1,ccSymbols2,ccSymbols3,ccSymbols4);
cSet = Set Of cChars;

Var
lFirstChar : Char;
lSameChars : Boolean;
lKElements,
I : Integer;
lNElements,
lExtinguishingIndex,
lCurrentValue,
lMaxValue : Real;
lSet : cSet;
begin
lKElements:=Length(aPassword);
lMaxValue:=Power((255-32),aMaxChars);
aMinDecibelValue:=Log10((1/cRipetitionValue) / lMaxValue);
lSet:=[];
If lKElements>0 Then
Begin
lSameChars:=True;
lFirstChar:=aPassword[1];
For I:=1 To lKElements Do
Begin
If lSameChars Then
If aPassword[I]<>lFirstChar Then lSameChars:=False;
// Ricerca dei gruppi di caratteri presenti nella password
Case Ord(aPassword[I]) Of
32..47 : If Not (ccSymbols1 In lSet) Then lSet:=lSet+[ccSymbols1];
48..57 : If Not (ccNumbers In lSet) Then lSet:=lSet+[ccNumbers];
58..64 : If Not (ccSymbols2 In lSet) Then lSet:=lSet+[ccSymbols2];
65..90 : If Not (ccUpCaseChars In lSet) Then lSet:=lSet+[ccUpCaseChars];
91..96 : If Not (ccSymbols3 In lSet) Then lSet:=lSet+[ccSymbols3];
97..122 : If Not (ccLowCaseChars In lSet) Then lSet:=lSet+[ccLowCaseChars];
123..254 : If Not (ccSymbols4 In lSet) Then lSet:=lSet+[ccSymbols4];
End;
End;
lNElements:=0;
If (ccNumbers In lSet) Then lNElements:=lNElements+10;
If (ccUpCaseChars In lSet) Then lNElements:=lNElements+26;
If (ccLowCaseChars In lSet) Then lNElements:=lNElements+26;
If (ccSymbols1 In lSet) Then lNElements:=lNElements+16;
If (ccSymbols2 In lSet) Then lNElements:=lNElements+7;
If (ccSymbols3 In lSet) Then lNElements:=lNElements+6;
If (ccSymbols4 In lSet) Then lNElements:=lNElements+132;
lExtinguishingIndex:=1;
If lSameChars Then
// Disposizioni con ripetizione di N elementi a 1 a 1
lCurrentValue:=lNElements*2
Else
// Disposizioni con ripetizione di N elementi a k a k
lCurrentValue:=Power(lNElements,lKElements)*lExtinguishingIndex;
// Calcolo su scala logaritmica
aCurrentDecibelValue:=Log10(lCurrentValue/lMaxValue);
If aCurrentDecibelValue
Else If aCurrentDecibelValue>0 Then aCurrentDecibelValue:=0;
End
Else
aCurrentDecibelValue:=aMinDecibelValue;
// Inversione scala logaritmica
aCurrentDecibelValue:=(-1*aMinDecibelValue)+aCurrentDecibelValue;
End;