[Resolvido] criar e testar senhas

[xanburzum 169]

O PwdForte expõe propriedades e métodos para criar e testar senhas

Para garantir que elas respeitem normas ou exceder senha forte.

 

como usar

 

<%
Dim oPwd, sPwd

Set oPwd = New PwdForte 

'cria o password
sPwd = oPwd.CreateEx

'testa o password criado
if not oPwd.Check("usr name", sPwd) then

'if returns = false, password ruim.
Response.Write("Password não seguro!: " & oPwd.FailurePoint)

end if

Set oPwd = Nothing
%>

código

<%
Class PwdForte 
Private AllChars, sFailure

Private Sub Class_Initialize()
 Dim s

 s = ""
 s = s & "A>=a{Bn0@Cb;D[o1<Ecp~F2qG}rH/d%3(st^IJ]eu"
 s = s & "$4K:Lf5&M*v-gN`6?OhP+|7w)iQ""\R8jS.xT9_kUy'VW,lXm!#YzZ"
 AllChars = s
End Sub

Public Function Create()
 Dim hPwdLen, i, sOut, sNewOut, hBeg, hEnd

 hBeg = 0
 hEnd = 0
 hPwdLen = 0
 i = 0
 sOut = ""
 sNewOut = ""

 Randomize
 hPwdLen = int((rnd * 10) + 7)
 for i = 1 to hPwdLen
  Randomize
  sOut = sOut & mid(AllChars, int(rnd * len(AllChars)) + 1, 1)
 next
 hEnd = len(sOut) - 1
 do until (hBeg = hEnd) or (hEnd - 1 = hBeg)
  sNewOut = sNewOut & mid(sOut, hBeg + 1, 1) & mid(sOut, hEnd + 1, 1)
  if hBeg = hEnd or hEnd - 1 = hBeg then exit do
  hEnd = abs(hEnd - 1)
  hBeg = abs(hBeg + 1)
 loop
 if hPwdLen mod 2 = 0 then
  sNewOut = sNewOut & mid(sOut, hBeg + 1, 1) & mid(sOut, hEnd + 1, 1)
 else
  sNewOut = sNewOut & mid(sOut, hBeg + 1, 1)
 end if
 Create = strReverse(sNewOut)
End Function

Public Function CreateEx()
 dim sPwd

 sPwd = create
 do until check("anonymous", sPwd)
  sPwd = create
 loop
 CreateEx = sPwd
End Function

Public Property Get FailurePoint
 FailurePoint = sFailure
End Property

Public Function Check(ByVal sUsrName, ByVal sPassword)
 'http://support.microsoft.com/support/kb/articles/q161/9/90.asp
 Dim re, passCt

 sFailure = ""
 Check = false
 passCt = 0

 'Passwords must be at least six (6) characters long
 if len(sPassword) < 6 then 
  sFailure = "comprimento mínimo requisito não satisfeito"
  Exit Function
 end if

 'Passwords may not contain your user name 
 if instr(lcase(sPassword), lcase(sUsrName)) <> 0 then 
  sFailure = "senha contém o nome do usuário"
  Exit Function
 end if


 set re = new regexp
 With re
  .ignorecase = false
  .global = true
  .multiline = false
  .pattern = "[A-Z_]"
  if .test(sPassword) then 
   passCt = passCt + 1
  else
   sFailure = "Faltando caracter classe: " & _
	"Inglês letras maiúsculas" & vbcrlf
  end if
  .pattern = "[a-z_]"
  if .test(sPassword) then 
   passCt = passCt + 1
  else
   sFailure = sFailure & "Faltando caracter classe: " & _
	"Inglês letras minúsculas" & vbcrlf
  end if
  .pattern = "[0-9]"
  if .test(sPassword) then 
   passCt = passCt + 1
  else
   sFailure = sFailure & "Faltando caracter classe: " & _
	"números Arabic ocidentalizadas " & vbcrlf
  end if
  .pattern = "[\W]"
  if .test(sPassword) then 
   passCt = passCt + 1
  else
   sFailure = sFailure & "Faltando caracter classe: " & _
	"Não-alfanuméricos ( "" caracteres especiais "")" & vbcrlf
  end if
 End With
 set re = nothing
 if passCt < 3 then Exit Function
 sFailure = ""
 Check = True
End Function
End Class
%>