unit UPasswordCheckFunktion;
interface
function GetPasswordStrength(Password:
String; ForceEntropy : Boolean = false): Extended;
implementation
uses
SysUtils, math;
function RemoveRepetitions(
const AString :
string):
String;
var
i : Integer;
begin
Result := AString;
i := 2;
while i <= Length(Result)
do
begin
if Result[i] = Result[i-1]
then
Delete(Result, i, 1)
else
inc(i);
end;
end;
function RemoveDateSeparator(
const AString :
string):
String;
var
i : Integer;
dt : TDateTime;
begin
i := Length(AString);
if (i > 0)
and (AString[i] = DateSeparator)
then
Result := Copy(AString, 1, i-1)
else
Result := AString;
if TryStrToDate(Result, dt)
then
Result := StringReplace(AString, DateSeparator, '
', [rfReplaceAll]);
end;
function GetPasswordStrength(Password:
String; ForceEntropy : Boolean = false): Extended;
var
FLowerMultiplicator : Extended;
FUpperMultiplicator : Extended;
FNumericMultiplicator : Extended;
FSignMultiplicator : Extended;
FDiffCharsMaxMulti : Extended;
FLengthMultiplicator : Extended;
FMinPasswordLength : Integer;
FMaxPasswordLength : Integer;
procedure InitPasswordCheck(ForceEntropie : Boolean);
begin
FLowerMultiplicator := 19;
FUpperMultiplicator := 21;
FNumericMultiplicator := 15;
FSignMultiplicator := 25;
FDiffCharsMaxMulti := 100;
FLengthMultiplicator := 20;
FMinPasswordLength := 4;
FMaxPasswordLength := 32;
if ForceEntropie
then
FDiffCharsMaxMulti := FDiffCharsMaxMulti * 10;
end;
function LengthMul(
const CurrentLength, MaxLength : Integer): Extended;
begin
if CurrentLength > MaxLength
then
Result := Math.Log2(MaxLength) * Math.Log2(MaxLength)
else
Result := Math.Log2(CurrentLength) * Math.Log2(CurrentLength);
Result := Result * FLengthMultiplicator;
end;
function CalculateEntropie(CleanPWLength, DiffCharsCount : Integer;
LowerMul, UpperMul, NumericMul, SignMul: Extended):Extended;
begin
Result := (DiffCharsCount * FDiffCharsMaxMulti) / CleanPWLength;
if (NumericMul + SignMul) = 0
then
Result := Result + ((LowerMul + UpperMul) / 2)
else
Result := Result + LowerMul + UpperMul + NumericMul + SignMul;
end;
function GetBestResult: Extended;
begin
Result := CalculateEntropie(1, 1, FLowerMultiplicator, FUpperMultiplicator,
FNumericMultiplicator, FSignMultiplicator);
Result := Result * LengthMul(FMaxPasswordLength, FMaxPasswordLength);
end;
var
i, CleanPWLength : Integer;
CleanPassword,
DiffChars :
String;
EntropieMul,
LowerMul, UpperMul,
NumericMul, SignMul : Extended;
begin
Result := 0;
LowerMul := 0;
UpperMul := 0;
NumericMul := 0;
SignMul := 0;
InitPasswordCheck(ForceEntropy);
CleanPassword := Trim(Password);
CleanPassword := RemoveDateSeparator(CleanPassword);
CleanPassword := RemoveRepetitions(CleanPassword);
CleanPWLength := Length(CleanPassword);
if (CleanPWLength >= FMinPasswordLength)
then
begin
for i := 1
to Length(CleanPassword)
do
begin
case CleanPassword[i]
of
'
a'..'
z', '
' : LowerMul := FLowerMultiplicator;
'
A'..'
Z' : UpperMul := FUpperMultiplicator;
'
0'..'
9' : NumericMul := FNumericMultiplicator;
else
SignMul := FSignMultiplicator;
end;
if Pos(CleanPassword[i], DiffChars) < 1
then
DiffChars := DiffChars + CleanPassword[i];
end;
EntropieMul := CalculateEntropie(CleanPWLength, Length(DiffChars),
LowerMul, UpperMul, NumericMul, SignMul);
Result := EntropieMul * LengthMul(CleanPWLength, FMaxPasswordlength);
Result := Result / GetBestResult;
end;
end;
end.