The Bereznikers

#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