Password Quality Estimation Function
Simple password quality estimation function. Based on the code from KeePass Password Safe
.
$SAMPLECODE$
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 #define CHARSPACE_ESCAPE 60 #define CHARSPACE_ALPHA 26 #define CHARSPACE_NUMBER 10 #define CHARSPACE_SIMPSPECIAL 16 #define CHARSPACE_EXTSPECIAL 17 #define CHARSPACE_HIGH 112 LPARAMETERS tcPassword LOCAL i, lcChar, lnBits, lnCharSpace LOCAL llEscape, llLower, llUpper, llNumber, llSimpSpecial, llExtSpecial, llHigh, lnCharPrev, lnChar LOCAL loDiff AS Collection, lnDiffItem, lnDiff, lnDiffFactor, lnEffectiveLength, lnCharItem, lnBitsPerChar IF EMPTY(tcPassword) RETURN 0 ENDIF STORE .F. TO llEscape, llLower, llUpper, llNumber, llSimpSpecial, llExtSpecial, llHigh lnBitsPerChar = 0.0 lnEffectiveLength = 0.0 loDiffCounts = CREATEOBJECT("colCounts") loCharCounts = CREATEOBJECT("colCounts") lnBits = 0 lnCharPrev = 0 FOR i=1 TO LEN(tcPassword) lcChar = SUBSTR(tcPassword, i) lnCharSpace = 0 DO CASE CASE BETWEEN(lcChar, "A", "Z") llUpper = .T. CASE BETWEEN(lcChar, "a", "z") llLower = .T. CASE ISDIGIT(lcChar) llNumber = .T. CASE BETWEEN(lcChar, SPACE(1), "/") llSimpSpecial = .T. CASE BETWEEN(lcChar, ":", "@") llExtSpecial = .T. CASE BETWEEN(lcChar, "[", "`") llExtSpecial = .T. CASE BETWEEN(lcChar, "{", "~") llExtSpecial = .T. CASE lcChar > "~" llHigh = .T. OTHERWISE * None printable characters < 0x20 (Space) llEscape = .T. ENDCASE lnDiffFactor = 1.0 lnChar = ASC(lcChar) IF i > 1 lnDiff = lnChar - lnCharPrev lcDiffKey = TRANSFORM(lnDiff) lnDiffItem = loDiffCounts.GetKey(lcDiffKey) IF lnDiffItem = 0 loDiffCounts.Add(1, lcDiffKey) ELSE loDiffCounts.IncCount(lcDiffKey) lnDiffFactor = lnDiffFactor / loDiffCounts.Item(lnDiffItem).nCount ENDIF ENDIF lnCharItem = loCharCounts.GetKey(lcChar) IF lnCharItem = 0 loCharCounts.Add(1, lcChar) lnEffectiveLength = lnEffectiveLength + lnDiffFactor ELSE loCharCounts.IncCount(lcChar) lnEffectiveLength = lnEffectiveLength + ; lnDiffFactor * (1.0 / loCharCounts.Item(lnCharItem).nCount) ENDIF lnCharPrev = lnChar ENDFOR IF llEscape lnCharSpace = lnCharSpace + CHARSPACE_ESCAPE ENDIF IF llUpper lnCharSpace = lnCharSpace + CHARSPACE_ALPHA ENDIF IF llLOwer lnCharSpace = lnCharSpace + CHARSPACE_ALPHA ENDIF IF llNumber lnCharSpace = lnCharSpace + CHARSPACE_NUMBER ENDIF IF llSimpSpecial lnCharSpace = lnCharSpace + CHARSPACE_SIMPSPECIAL ENDIF IF llExtSpecial lnCharSpace = lnCharSpace + CHARSPACE_EXTSPECIAL ENDIF IF llHigh lnCharSpace = lnCharSpace + CHARSPACE_HIGH ENDIF IF lnCharSpace = 0 RETURN 0 ENDIF lnBitsPerChar = LOG(lnCharSpace) / LOG(2.0) lnBits = CEILING(lnBitsPerChar * lnEffectiveLength ) RETURN lnBits *---------------------------------------------------- DEFINE CLASS colCounts AS Collection PROCEDURE Add(teItem , tcKey) LOCAL loItem loItem = CREATEOBJECT("Empty") ADDPROPERTY(loItem, "nCount", 1) DODEFAULT(loItem, tcKey) NODEFAULT ENDPROC PROCEDURE IncCount(tnItem) LOCAL loItem loItem = This.Item(tnItem) loItem.nCount = loItem.nCount + 1 ENDPROC ENDDEFINE
Comments