Uncode e Decode

[alissong 1]

Pessoal,

 

Achei esses dois códigos na net, um codifica e o outro decodifica, mas não estou entendo nada desse código: Veja exemplo:

São módulos:

' DECODE PASSWORD.

Function Decode_Pass(p_str As String) As String

For I = 1 To Len(p_str) Step 1

strs = strs + Chr(Asc(Mid(p_str, I, 1)) * 2)

Next I

Decode_Pass = strs

End Function

 

' UNCODE PASSWORD.

Function UnCode_Pass(p_str As String) As String

For I = 1 To Len(p_str) Step 1

strs = strs + Chr(Asc(Mid(p_str, I, 1)) / 2)

Next I

UnCode_Pass = strs

End Function

Veja o código no formulário login, mas não está funcionando:

Private Sub cmdLocalizar_Click()

On Error GoTo cmdLocalizar ' Erro ao localizar usuarios

 

Dim LoginOK As Boolean

Dim rsUsu As ADODB.Recordset

LoginOK = False

If txtusuario.Text = "" Then

MsgBox "Digite o Nome do Usuário !", vbExclamation + vbCritical, " Campo Obrigatório"

txtusuario.SetFocus

Exit Sub

End If

If txtsenha.Text = "" Then

MsgBox "Digite a Senha do Usuário !", vbExclamation + vbCritical, " Campo Obrigatório"

txtsenha.SetFocus

Exit Sub

End If

'abrir uma consulta com o usuário informado

sql = "SELECT * FROM usuario WHERE nome_usuario ='" & txtusuario.Text & "'"

Set rsUsu = accesscon.Execute(sql)

 

'verificar se encontrou o usuário

If rsUsu.EOF = True Then

MsgBox "Usuário não encontrado !", vbExclamation + vbCritical, "O Usuário não confere"

txtusuario.SetFocus

Else

'se encontrou, verificar a senha

If rsUsu.Fields("senha") = Decode_Pass(txtsenha.Text) Then

LoginOK = True 'definir que o usuário foi encontrado e a senha está OK

Else

 

ctr = ctr + 1

If ctr = 4 Then

End

Else

xText = "Você tem mais" + Str(4 - ctr) + " chances"

If ctr = 3 Then

xText = "Esta é sua última chance !!"

End If

MsgBox "Senha incorreta !" & vbCrLf & _

xText, vbExclamation + vbCritical, "Senha não confere"

txtsenha.Text = ""

txtsenha.SetFocus

SendKeys "{Home}+{End}"

End If

End If

End If

rsUsu.Close

Set rsUsu = Nothing

If LoginOK = True Then

'exibir a mensagem de OK

'VBCrlf = quebra de linha

MsgBox "Usuário encontrado com sucesso!" & vbCrLf & "Clique em OK para continuar.", vbInformation, "Autenticação OK!"

login.Hide

MDIForm1.Show

End If

cmdlocalizar_exit:

Exit Sub

cmdLocalizar:

MsgBox Err.Description, vbInformation, "Erro ao [cmdLocalizar]"

 

End Sub

Veja o código no botão gravar:

Private Sub gravar_usu_Click()

Dim controle As Control

For Each controle In frmusuario

If TypeOf controle Is TextBox Then

controle.Text = LimpaTexto(controle.Text)

End If

Next

 

On Error GoTo cmdGravar ' Erro ao gravar registro

 

If nome_usuario.Text = Empty Then

MsgBox "Digite o nome do usuário", vbExclamation, "Campo Obrigatório"

nome_usuario.SetFocus

Exit Sub

End If

If cpf.Text = Empty Then

MsgBox "Digite o CPF do Usuário", vbExclamation, "Campo Obrigatório"

cpf.SetFocus

Exit Sub

End If

If senha.Text = Empty Then

MsgBox "Digite a senha do usuário", vbExclamation, "Campo Obrigatório"

senha.SetFocus

Exit Sub

End If

If tipo_usuario.Text = Empty Then

MsgBox "Selecione o tipo de usuário", vbExclamation, "Campo Obrigatório"

tipo_usuario.SetFocus

Exit Sub

End If

 

Screen.MousePointer = vbHourglass

 

AdoUsuarios("nome_usuario") = "" & nome_usuario.Text

AdoUsuarios("cpf") = "" & cpf.Text

AdoUsuarios("senha") = "" & UnCode_Pass(senha.Text)

AdoUsuarios("tipo_usuario") = "" & tipo_usuario.Text

AdoUsuarios("data_cadastro") = "" & data_cadastro.Text

 

AdoUsuarios.Update

AdoUsuarios.Requery

 

mostradados

registro_usuarios

 

'Desabilita o botão cancelar

cancelar_usu.Enabled = False

'Desabilita o botão gravar

gravar_usu.Enabled = False

'Desabilita o botão excluir

excluir_usu.Enabled = False

'Habilita o botão incluir

incluir_usu.Enabled = True

 

nome_usuario.Locked = True

cpf.Locked = True

senha.Locked = True

tipo_usuario.Locked = True

 

MsgBox "Operação realizada com sucesso !", vbInformation, "Salvar Inclusão / Alteração"

 

Screen.MousePointer = vbDefault

frmusuario.Refresh

 

cmdgravar_exit:

Exit Sub

 

cmdGravar:

 

MsgBox Err.Description, vbInformation, "Erro em [cmdgravar]"

cancelar_usu_Click

 

End Sub

Alguem pode me explicar por que não está funcionando.

 

 

Um abraço.

 

 

Alissong

[scorpio 7]

O que que não funciona? As funções Decode e Uncode ? Testei aqui e as duas funcionaram.

Da erro ?

 

Flw