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