ABADev blog

{returns an integer value (0 to 100) rating the key quality}
function PasswordQuality(const strPassword: string): Integer;
var
  i, j, intLen: Integer;
  QC: Double;
  boolUpper, boolLower: Boolean;
begin
  Result := 0;

  intLen := Length(strPassword);
  QC := 4*intLen;

  {at least 5 characters in password required}
  if (intLen > 4) then
  begin
    {check for repetitions (abcabc, aaaaa, 121212, etc}
    for i := 1 to (intLen div 2) do
    begin
      j := i+1;
      while (j <= intLen ) do
      begin
        if (Copy(strPassword, 1, i) = Copy(strPassword, j, i)) then exit;
        Inc(j, i);
      end
    end;

    {check the upper/lower cases}
    boolUpper := False;
    boolLower := False;
    for i := 1 to intLen do
    begin
      if (strPassword[i] in ['A'..'Z']) then
        boolUpper := True;
      if (strPassword[i] in ['a'..'z']) then
        boolLower := True;
    end;
    if boolUpper and boolLower then
      QC := 1.5*QC;

    {check the numbers}
    for i := 1 to intLen do
    begin
      if (strPassword[i] in ['0'..'9']) then
        if (boolUpper or boolLower) then
          QC := 1.5*QC;
    end;

    {check the signs}
    for i := 1 to intLen do
    begin
      if (strPassword[i] < ’0′) or (strPassword[i] > ‘z’) or
         ((strPassword[i] > ’9′) and (strPassword[i] < ‘A’)) then
        QC := 1.5*QC;
    end;

    if (QC > 100) then
      QC := 100;
    Result := Trunc(QC);
  end;
end;

Sample to use:
  i := PasswordQuality(edPassword.Text);
  lblPWQuality.Caption := IntToStr(i);
  if (i < 30) then
    lblPWQuality.Font.Color := clRed
  else
  if (i < 60) then
    lblPWQuality.Font.Color := clYellow
  else
    lblPWQuality.Font.Color := clWindowText;