Then I do not suggest you try my alternative source as that could give you a heartattack.Polarwolf wrote:Wow. I reach an interesting score with my board password.
Perfect (131)
Who can beat that without cheating? O.o

Code: Select all
;PASSWORD STRENGTH TESTER
;MODIFIED ON 8/10/08 BY chris319
;SHOWS PASSWORD STRENGTH LEVELS
;ADDED SetActiveGadget() TO PUT FOCUS ON PASSWORD ENTRY FIELD
;MODIFIED PASSWORD STRENGTH ENGINE TO AWARD POINTS FOR
;NON-CONSECUTIVE AND NON-REPETITIVE CHARACTERS
;ADDED CODE TO REFRESH TEXT ON WINDOW REPAINT
;ADDED COPY BUTTON TO COPY PASSWORD TO CLIPBOARD
#W_PassWord = 0
;Gadget
Enumeration
#G_Password_Pass
#G_Password_Toggle
#G_Password_Check
#G_Password_Pass_Txt
#G_Password_Ok
#G_Password_Cancel
#G_Password_Copy
EndEnumeration
Global Key.s
;********************
;Function
;********************
Procedure.l GetPasswordStrength(password$)
Protected *char.character,endpos.l
Protected result.l=0,len.l,lc.l=0,uc.l=0,nm.l=0,sp.l=0,sc.l=0,un.l=0,nc = 0
*char=@password$
len=Len(password$)
If len>0
endpos=(@password$+(len*SizeOf(character)))-SizeOf(character)
Repeat
Select *char\c
Case 'a' To 'z' ;lowercase
lc+1
Case 'A' To 'Z' ;uppercase
uc+1
Case '0' To '9' ;numeric
nm+1
Case ' ' ;space
sp+1
Case ',','.','-','"',Asc("'"),'*','!','@',',#',',$',',%',',^',',&',',?','_','~','[',']','(',')','<','>',';',':','£','¤','/','\','{','}','=','+','`','´','¨','|','§' ;special
sc+1
Default ;unknown or unicode characters
un+1
EndSelect
*char=*char+SizeOf(character)
Until *char>endpos
;AWARD POINTS FOR NON-CONSECUTIVE CHARACTERS
For ct = 1 To Len(password$) Step 2
a.c = Asc(Mid(password$, ct, 1))
If ct > 1: b.c = Asc(Mid(password$, ct-1, 1)) - 1: Else: b = a: EndIf
If ct < Len(password$): c.c = Asc(Mid(password$, ct+1, 1)) - 1: Else: c = a: EndIf
If ct > 1: d.c = Asc(Mid(password$, ct-1, 1)) + 1: Else: d = a: EndIf
If ct < Len(password$): e.c = Asc(Mid(password$, ct+1, 1)) + 1: Else: e = a: EndIf
If ct > 1: f.c = Asc(Mid(password$, ct-1, 1)): Else: f = a: EndIf
If ct < Len(password$): g.c = Asc(Mid(password$, ct+1, 1)): Else: g = a: EndIf
If a <> b And a <> c And a <> d And a <> e And a <> f And a <> g
nc + 1
EndIf
Next
; result=1*(lc+1)*(uc+1)*(nm+1)*(sp+1)*(sc+1)*(un+1)
result = (lc+1)*(uc+1)*(nm+1)*(sp+1)*(sc+1)*(un+1)*(nc+1)
result - 1 ;A ONE-CHARACTER PASSWORD WILL HAVE A SCORE OF 1
EndIf
ProcedureReturn result
EndProcedure
Procedure.l TestPassword(gadget.l,password$)
Protected text$,strength.l,bgcolor.l
strength=GetPasswordStrength(password$)
If strength<0 : strength=$7FFFFFFF : EndIf
If strength=0
text$="Fail"
fgcolor=$FFFFFF
bgcolor=$0000AA
ElseIf strength<10
text$="Very weak"
fgcolor=$FFFFFF
bgcolor=$3333AA
ElseIf strength<25
text$="Weak"
fgcolor=$FFFFFF
bgcolor=$6666AA
ElseIf strength<50
text$="OK"
fgcolor=$FFFFFF
bgcolor=$AA6633
ElseIf strength<100
text$="Good"
fgcolor=$FFFFFF
bgcolor=$AA6666
ElseIf strength<500
text$="Great"
fgcolor=$FFFFFF
bgcolor=$66AA66
ElseIf strength<1000
text$="Strong"
fgcolor=$FFFFFF
bgcolor=$33AA33
Else
text$="Very strong"
fgcolor=$FFFFFF
bgcolor=$00AA00
EndIf
SetGadgetText(gadget, text$+" ("+Str(strength)+")")
SetGadgetColor(gadget,#PB_Gadget_BackColor,bgcolor)
SetGadgetColor(gadget,#PB_Gadget_FrontColor,fgcolor)
EndProcedure
;Gdt=Gadget who display password / GdtToggle= gadget who sitch password display / GdtCont= If Gdt is in a container gadget
Procedure TogglePassword(Gdt.l, GdtToggle.l, GdtCont.l = -1)
Protected tmppass.s, tmpx.l, tmpy.l, tmpw.l, tmph.l
tmppass.s = GetGadgetText(Gdt)
tmpx = GadgetX(Gdt)
tmpy = GadgetY(Gdt)
tmpw = GadgetWidth(Gdt)
tmph = GadgetHeight(Gdt)
FreeGadget(Gdt)
If GdtCont>-1
OpenGadgetList(GdtCont)
EndIf
If GetGadgetState(GdtToggle) = 0
StringGadget(Gdt, tmpx, tmpy, tmpw, tmph, "", #PB_String_Password)
SetGadgetText(GdtToggle, "abc")
Else
StringGadget(Gdt, tmpx, tmpy, tmpw, tmph, "")
SetGadgetText(GdtToggle, "***")
EndIf
If GdtCont>-1
CloseGadgetList()
EndIf
SetGadgetText(Gdt, tmppass)
EndProcedure
;********************
;Windows
;********************
Procedure OpenWindowPassword()
OpenWindow(#W_PassWord, 0, 0, 400, 250, "Password Strength", #PB_Window_ScreenCentered | #PB_Window_SystemMenu)
CreateGadgetList(WindowID(#W_PassWord))
Global centerline = WindowWidth(#W_PassWord) / 2
TextGadget(#G_Password_Pass_Txt, 10, 15, WindowWidth(#W_PassWord)-20, 20, "Your Master Password")
StringGadget(#G_Password_Pass, 10, 40, WindowWidth(#W_PassWord)-60, 20, "", #PB_String_Password)
TextGadget(#G_Password_Check, 10, 70, WindowWidth(#W_PassWord)-60, 20, "", #PB_Text_Center | #PB_Text_Border)
;SetGadgetAttribute(#G_Password_Pass, #PB_String_Password , 0) //ça n'existe pas pour l'instant dommage
ButtonGadget(#G_Password_Toggle, WindowWidth(#W_PassWord)-40, 40, 40, 20, "abc", #PB_Button_Toggle)
ButtonGadget(#G_Password_Ok, 10, WindowHeight(#W_PassWord)-30, 60, 20, "Ok")
ButtonGadget(#G_Password_Cancel, WindowWidth(#W_PassWord)-70, WindowHeight(#W_PassWord)-30, 60, 20, "Exit")
ButtonGadget(#G_Password_Copy, centerline - 30, WindowHeight(#W_PassWord)-30, 60, 20, "Copy")
SetActiveGadget(#G_Password_Pass)
StartDrawing(WindowOutput(0))
DrawingMode(#PB_2DDrawing_Transparent)
DrawText(10, 130, "0 = Fail", 0)
DrawText(10, 150, "1 to 9 = Very weak", 0)
DrawText(10, 170, "10 to 24 = Weak", 0)
DrawText(10, 190, "25 to 49 = OK", 0)
DrawText(centerline, 130, "50 to 99 = Good", 0)
DrawText(centerline, 150, "100 to 499 = Great", 0)
DrawText(centerline, 170, "500 to 999 = Strong", 0)
DrawText(centerline, 190, "1000 and above = Very strong", 0)
EndProcedure
Procedure CloseWindowPassword(W_Parent)
DisableWindow(W_Parent, 0)
EndProcedure
Procedure WindowPasswordLoop()
Protected EventID.l, Quit.b, ret.l
OpenWindowPassword()
Repeat
EventID = WaitWindowEvent()
Select(EventID)
Case #PB_Event_Repaint
DrawText(10, 130, "0 = Fail", 0)
DrawText(10, 150, "1 to 9 = Very weak", 0)
DrawText(10, 170, "10 to 24 = Weak", 0)
DrawText(10, 190, "25 to 49 = OK", 0)
DrawText(centerline, 130, "50 to 99 = Good", 0)
DrawText(centerline, 150, "100 to 499 = Great", 0)
DrawText(centerline, 170, "500 to 999 = Strong", 0)
DrawText(centerline, 190, "1000 and above = Very strong", 0)
password$ = GetGadgetText(#G_Password_Pass)
Box(10, 100, 340, 16, $FFFFFF)
If Len(password$) = 1: ch$ = " character": Else: ch$ = " characters": EndIf
DrawText(10, 100, "Length: " + Str(Len(password$)) + ch$, 0)
;DrawWindowHead(#W_Icon)
;Case #PB_Event_Menu
Case #PB_Event_Gadget
Select EventGadget()
Case #G_Password_Toggle
TogglePassword(#G_Password_Pass, #G_Password_Toggle)
Case #G_Password_Pass
If EventType() = #PB_EventType_Change
TestPassword(#G_Password_Check, GetGadgetText(#G_Password_Pass))
password$ = GetGadgetText(#G_Password_Pass)
Box(10, 100, 340, 16, $FFFFFF)
If Len(password$) = 1: ch$ = " character": Else: ch$ = " characters": EndIf
DrawText(10, 100, "Length: " + Str(Len(password$)) + ch$, 0)
EndIf
Case #G_Password_Ok
Quit = 1 : ret.l = #True
Case #G_Password_Cancel
Quit = 1 : ret.l = #False
Case #G_Password_Copy
SetClipboardText(GetGadgetText(#G_Password_Pass))
EndSelect
Case #PB_Event_CloseWindow ;If the user has pressed the close button
Quit = 1 : ret.l = #False
EndSelect
Until Quit = 1
If ret = #True
Key = GetGadgetText(#G_Password_Pass)
EndIf
StopDrawing()
CloseWindow(#W_PassWord)
ProcedureReturn ret
EndProcedure
WindowPasswordLoop()
Very beautiful code !chris319 wrote:In this version, the output window has been snazzied up by adding the levels of password strength and a field showing the length of the password. Added SetActiveGadget to put Mr. Focus in the password entry field, and added code to repaint text. It is now possible to copy the text in the password field to the clipboard by clicking on the "Copy" gadget. Modified password strength engine to award points for non-consecutive or non-repetitive characters, for example:
"aaaaaa" or "abcdef" will receive a score of 6, whereas
"azazaz" will receive a score of 20 by having non-repetitive and non-consecutive characters.
"aaahbq" and "abchbq" each receive 13 points.
"Ard 147 #@!" receives a score of 1727 and is considered "very strong".
Code: Select all
Procedure GetColor(ColorA.l, ColorB.l, Min.l, Max.l, Cursor.l)
Protected R.l, G.l, B.l
Max = Max-Min
Cursor = Cursor-Min
R = Red(ColorB)-Red(ColorA)
R = Red(ColorA) + (R*Cursor/Max)
G = Green(ColorB)-Green(ColorA)
G = Green(ColorA) + (G*Cursor/Max)
B = Blue(ColorB)-Blue(ColorA)
B = Blue(ColorA) + (B*Cursor/Max)
ProcedureReturn RGB(R, G, B)
EndProcedure
Procedure.l TestPassword(gadget.l, password$)
;"0 = Fail"
;"1 to 9 = Very weak"
;"10 to 24 = Weak"
;"25 to 49 = OK"
;"50 to 99 = Good"
;"100 to 499 = Great"
;"500 to 999 = Strong"
;"1000 and above = Very strong"
Protected text$, strength.l, bgcolor.l, fgcolor.l
strength = GetPasswordStrength(password$)
If strength<0 : strength = $7FFFFFFF : EndIf
If strength = 0
text$ = "Fail"
fgcolor = $FFFFFF
bgcolor = $0000AA
ElseIf strength<10
text$ = "VeryWeak"
fgcolor = $FFFFFF
bgcolor = $3333AA
bgcolor = GetColor($0000AA, $3333AA, 0, 10, strength)
ElseIf strength<25
text$ = "Weak"
fgcolor = $FFFFFF
bgcolor = $6666AA
bgcolor = GetColor($3333AA, $6666AA, 10, 25, strength)
ElseIf strength<50
text$ = "OK"
fgcolor = $FFFFFF
bgcolor = $AA6633
bgcolor = GetColor($6666AA, $AA6633, 25, 50, strength)
ElseIf strength<100
text$ = "Good"
fgcolor = $FFFFFF
bgcolor = $AA6666
bgcolor = GetColor($AA6633, $AA6666, 50, 100, strength)
ElseIf strength<500
text$ = "Great"
fgcolor = $FFFFFF
bgcolor = $66AA66
bgcolor = GetColor($AA6666, $66AA66, 100, 500, strength)
ElseIf strength<1000
text$ = "Strong"
fgcolor = $FFFFFF
bgcolor = $33AA33
bgcolor = GetColor($66AA66, $33AA33, 500, 1000, strength)
Else
text$ = "VeryStrong"
fgcolor = $FFFFFF
bgcolor = $00AA00
EndIf
If IsGadget(gadget)
SetGadgetText(gadget, text$ + " (" + Str(strength) + ")")
SetGadgetColor(gadget, #PB_Gadget_BackColor, bgcolor)
SetGadgetColor(gadget, #PB_Gadget_FrontColor, fgcolor)
EndIf
ProcedureReturn strength
EndProcedure
Thank you.Very beautiful code !
Code: Select all
Procedure.l GetPasswordStrength(password$)
Protected *char.character,endpos.l
Protected result.f = 0,len.l,lc.l=0,uc.l=0,nm.l=0,sp.l=0,sc.l=0,un.l=0,nc = 0
*char=@password$
len=Len(password$)
If len > 0
endpos = (@password$+(len*SizeOf(character)))-SizeOf(character)
lc_str = 0
uc_str = 0
nu_str = 0
pu_str = 0
Repeat
Select *char\c
Case 'a' To 'z' ;lowercase
;lc+1
lc_str = 26 ;THERE ARE LOWERCASE CHARACTERS PRESENT
Case 'A' To 'Z' ;uppercase
;uc+1
uc_str = 26 ;THERE ARE UPPERCASE CHARACTERS PRESENT
Case '0' To '9' ;numeric
;nm+1
nu_str = 10 ;THERE ARE NUMERIC CHARACTERS PRESENT
;Case ' ' ;space
;sp+1
Case ',','.','-','"',Asc("'"),'*','!','@',',#',',$',',%',',^',',&',',?','_','~','[',']','(',')','<','>',';',':','£','¤','/','\','{','}','=','+','`','´','¨','|','§' ;special
;sc+1
pu = 33 ;THERE ARE PUNCTUATION SYMBOLS PRESENT
;Default ;unknown or unicode characters
;un+1
EndSelect
*char=*char+SizeOf(character)
Until *char>endpos
Goto skip ;SKIP OVER THE CODE BELOW
;AWARD POINTS FOR NON-CONSECUTIVE CHARACTERS
For ct = 1 To Len(password$) Step 2
a.c = Asc(Mid(password$, ct, 1))
If ct > 1: b.c = Asc(Mid(password$, ct-1, 1)) - 1: Else: b = a: EndIf
If ct < Len(password$): c.c = Asc(Mid(password$, ct+1, 1)) - 1: Else: c = a: EndIf
If ct > 1: d.c = Asc(Mid(password$, ct-1, 1)) + 1: Else: d = a: EndIf
If ct < Len(password$): e.c = Asc(Mid(password$, ct+1, 1)) + 1: Else: e = a: EndIf
If ct > 1: f.c = Asc(Mid(password$, ct-1, 1)): Else: f = a: EndIf
If ct < Len(password$): g.c = Asc(Mid(password$, ct+1, 1)): Else: g = a: EndIf
If a <> b And a <> c And a <> d And a <> e And a <> f And a <> g
nc + 1
EndIf
Next
; result=1*(lc+1)*(uc+1)*(nm+1)*(sp+1)*(sc+1)*(un+1)
result = (lc+1)*(uc+1)*(nm+1)*(sp+1)*(sc+1)*(un+1)*(nc+1)
result - 1 ;A ONE-CHARACTER PASSWORD WILL HAVE A SCORE OF 1
skip:
leng = Len(password$)
result = Pow(lc_str + uc_str + nu_str + pu_str, leng)
EndIf
;NIST uses the following scheme To estimate password entropy (ie, randomness)[4]:
;the entropy of the first character is four bits;
;the entropy of the next seven characters are two bits per character
;the ninth through the twentieth character has 1.5 bits of entropy per character;
;characters 21 And above have one bit of entropy per character;
If leng = 1
Global ent.f = 4
ElseIf leng >= 2 And leng <= 8
ent = 4 + ((leng - 1) * 2)
ElseIf leng >= 9 And leng <= 20
ent = 60 + ((leng - 8) * 1.5)
Else
ent = 78 + (leng - 20)
EndIf
;NIST BIT STRENGTH
Global bit_strength.f = leng * #ALLOWED_CHARS
ProcedureReturn result
EndProcedure