CRIPTOGRAFAR SENHA NO LISTVIEW

MILTONSILVA94 21/07/2015 19:13:00
#449099
Estou com um formulário que ao clicar em pesquisar ele me traz os dados no Listview. Neste Listview tem um campo [ô]senha[ô] que é exibido. Sendo assim, preciso que a [ô]senha[ô] mostre criptografada ao eu clicar para exibir os dados neste listview. Abaixo segue minha rotina do pesquisar.
Qual rotina deveria usar para fazer esta mudança...

Private Sub RotinaPesquisar()
Dim lsql As String
Dim lTBUsuarios As Recordset
Dim lItem As ListItem

If cboIdPerfil.Text = [Ô]Todos[Ô] Then
cboIdPerfil.ListIndex = -1
End If

lsql = [Ô]SELECT * FROM Usuarios [Ô]

[ô]Para o cursor ir depois de trazer os resultados da pesquisa ao campo
lvwLista.SetFocus

[ô]If para fazer a consulta pelos parâmetros informados na consulta
If Trim(txtNome.Text) <> [Ô][Ô] & Trim(cboIdPerfil.Text) <> [Ô][Ô] Then
lsql = lsql & [Ô] WHERE nome_usuario like [ô][Ô] & Trim(txtNome.Text & [Ô]*[ô][Ô])
lsql = lsql & [Ô] AND id_perfil like [ô][Ô] & Trim(cboIdPerfil.Text & [Ô]*[ô][Ô])
lsql = lsql & [Ô] ORDER BY id_usuario ASC[Ô]
End If

[ô]Depois de retornar os resultados do comando pesquisar, o cursor retorna para o campo nome
txtNome.SetFocus

Set lTBUsuarios = gBDSalao.OpenRecordset(lsql, dbOpenSnapshot)

If lTBUsuarios.EOF Then
[ô]MsgBox [Ô]Nenhum cadastro foi encontrado com os parâmetros informados![Ô], vbCritical
frmMensagemDeErroAoPesquisar.Show vbModal

txtNome.Text = [Ô][Ô]
cboIdPerfil.ListIndex = -1

[ô]Limpar o campo do ListView
lvwLista.ListItems.Clear

[ô]Para o cursor retornar para o último campo que foi acessado
txtNome.SetFocus

Exit Sub
End If

lvwLista.ListItems.Clear

Do While lTBUsuarios.EOF = False

Set lItem = lvwLista.ListItems.Add

lItem.Text = lTBUsuarios.Fields([Ô]id_usuario[Ô]).Value
lItem.SubItems(1) = lTBUsuarios.Fields([Ô]data_sistema[Ô]).Value
lItem.SubItems(2) = lTBUsuarios.Fields([Ô]nome_usuario[Ô]).Value
lItem.SubItems(3) = lTBUsuarios.Fields([Ô]cpf[Ô]).Value
lItem.SubItems(4) = lTBUsuarios.Fields([Ô]rg[Ô]).Value
lItem.SubItems(5) = lTBUsuarios.Fields([Ô]login[Ô]).Value
lItem.SubItems(6) = lTBUsuarios.Fields([Ô]senha_usuario[Ô]).Value
lItem.SubItems(7) = lTBUsuarios.Fields([Ô]id_perfil[Ô]).Value
lItem.SubItems(8) = lTBUsuarios.Fields([Ô]descricao_perfil[Ô]).Value
[ô]Linha abaixo precisa ficar comentada, pois se o usuário foi cadastrado recentemente e não entrou no sistema ainda, o campo fica em branco, e se algum usuário fizer a pesquisa de todos os usuários, o sistema apresentará erro, devido a este campo estar em branco
[ô]lItem.SubItems(9) = lTBUsuarios.Fields([Ô]ultimo_acesso_usuario[Ô]).Value
lItem.SubItems(10) = lTBUsuarios.Fields([Ô]atualizado_por[Ô]).Value
lItem.SubItems(11) = lTBUsuarios.Fields([Ô]ultima_atualizacao[Ô]).Value

[ô]Para que os campos digitados para a pesquisa possam ficar em branco se os resultados forem positivos
txtNome.Text = [Ô][Ô]
cboIdPerfil.ListIndex = -1

lTBUsuarios.MoveNext
Loop

End Sub
POCE1DON 22/07/2015 01:41:18
#449107
MILTONSILVA94,

Existe diversas formas e funções já prontas para criptografar e descriptografar [Ô]textos[Ô], como esta:

  Private Function Encrypt(StringToEncrypt As String, Optional AlphaEncoding As Boolean = False) As String
    On Error GoTo ErrorHandler
    Dim Char As String
    Encrypt = [Ô][Ô]
    
    Dim I As Integer

    For I = 1 To Len(StringToEncrypt)
        Char = Asc(Mid(StringToEncrypt, I, 1))
        Encrypt = Encrypt & Len(Char) & Char
    Next I
    


    If AlphaEncoding Then
        
        StringToEncrypt = Encrypt
        Encrypt = [Ô][Ô]


        For I = 1 To Len(StringToEncrypt)
            Encrypt = Encrypt & Chr(Mid(StringToEncrypt, I, 1) + 147)
        Next I
    End If
    Exit Function
ErrorHandler:
    Encrypt = [Ô]Erro ao criptografar texto.[Ô]
End Function


Private Function Decrypt(StringToDecrypt As String, Optional AlphaDecoding As Boolean = False) As String
    On Error GoTo ErrorHandler
    Dim CharCode As String
    Dim CharPos As Integer
    Dim Char As String
    Dim I As Integer


    If AlphaDecoding Then
        
        Decrypt = StringToDecrypt
        StringToDecrypt = [Ô][Ô]


        For I = 1 To Len(Decrypt)
            StringToDecrypt = StringToDecrypt & (Asc(Mid(Decrypt, I, 1)) - 147)
        Next I
    End If
    
    Decrypt = [Ô][Ô]
    


    Do
        
        CharPos = Left(StringToDecrypt, 1)
        StringToDecrypt = Mid(StringToDecrypt, 2)
        CharCode = Left(StringToDecrypt, CharPos)
        StringToDecrypt = Mid(StringToDecrypt, Len(CharCode) + 1)
        Decrypt = Decrypt & Chr(CharCode)
    Loop Until StringToDecrypt = [Ô][Ô]
    Exit Function
ErrorHandler:
    Decrypt = [Ô]Erro ao descriptografar texto.[Ô]
End Function


Para usar, basta colar esse código em seu formulário e no seu caso, usar da seguinte forma:

lItem.SubItems(6) = Encrypt(lTBUsuarios.Fields([Ô]senha_usuario[Ô]).Value)

é isso que gostaria?
OMAR2011 22/07/2015 09:12:40
#449115
Este modo seria o correto.
lItem.SubItems(6) = Encrypt(lTBUsuarios.Fields([Ô]senha_usuario[Ô]).Value)

Este é o seu.
lItem.SubItems(6) = Encrypt(lTBUsuarios.Fields([Ô]senha_usuario[Ô]).Value
OCELOT 22/07/2015 09:45:31
#449117
Não tem porque complicar, simplesmente não mostre a senha, em vez de mostrar ela mostre vários asteriscos se é só pra dizer que uma senha existe
MILTONSILVA94 22/07/2015 10:06:41
#449120
Ops OMAR, acabei anexando o arquivo errado. Estou mandando o correto agora...
Precisa adicionar função?
Pois ocorreu erro da imagem...
OMAR2011 22/07/2015 10:44:48
#449121 Resposta escolhida
Este foi o teste que fiz do Macoratti e POCE1DON

Private Sub Command8_Click()
Set con = New ADODB.Connection
Set Conexao = New ADODB.Connection
Set rst = New ADODB.Recordset
con.Open [Ô]Provider=Microsoft.Jet.OLEDB.4.0;Data Source=[Ô] & App.Path & [Ô]    abelas2.mdb;Persist Security Info=False[Ô]


Dim Sql As String

Dim item As ListItem

Lvped.ListItems.Clear


rst.Open [Ô]Select * From produtos[Ô], con

Do Until rst.EOF
Set item = Lvped.ListItems.Add(, , rst(0))

item.SubItems(1) = [Ô][Ô] & rst([Ô]Codigo[Ô]).Value
item.SubItems(2) = [Ô][Ô] & rst([Ô]descricao[Ô])
item.SubItems(3) = Format(rst([Ô]preco[Ô]), [Ô]Currency[Ô])
item.SubItems(4) = Format(rst([Ô]icme[Ô]), [Ô]Currency[Ô])
item.SubItems(5) = Format(rst([Ô]icms[Ô]), [Ô]Currency[Ô])
item.SubItems(6) = Crypt(rst.Fields([Ô]Senha[Ô]).Value)
[ô] item.SubItems(6) = Encrypt(rst.Fields([Ô]Senha[Ô]).Value)
Set item = Nothing
rst.MoveNext
Loop
rst.Close
End Sub
Public Function Crypt(Text As String) As String

Dim strTempChar As String

For I = 1 To Len(Text)

If Asc(Mid$(Text, I, 1)) < 128 Then
strTempChar = Asc(Mid$(Text, I, 1)) + 128
ElseIf Asc(Mid$(Text, I, 1)) > 128 Then
strTempChar = Asc(Mid$(Text, I, 1)) - 128
End If

Mid$(Text, I, 1) = Chr(strTempChar)

Next I

Crypt = Text

End Function
POCE1DON 22/07/2015 13:47:31
#449123
Citação:

:
Ops OMAR, acabei anexando o arquivo errado. Estou mandando o correto agora...
Precisa adicionar função?
Pois ocorreu erro da imagem...



vc primeiro colocou as funções em seu formulário como eu mostrei lá em cima?


Observe que as funções que coloquei pra vc, estão como [Ô]Private[Ô], então só vão funcionar
no formulário onde vc for utilizá-las.
Tópico encerrado , respostas não são mais permitidas
Voltar