Dificuldades de criptogafar chaves

Boa noite

Estou tentando criptografar alguns campos.
Uso a função CriptografarSHA256

Código:

Public Function CriptografarSHA256(texto As String) As String
   Dim sha As Object
   Dim bytes() As Byte
   Dim hash() As Byte
   Dim i As Integer
   Dim hashHex As String

   ' Crie um objeto de hash SHA-256
   Set sha = CreateObject("System.Security.Cryptography.SHA256Managed")

   ' Converta a string em bytes
   bytes = StrConv(texto, vbFromUnicode)

   ' Calcule o hash
   hash = sha.ComputeHash_2((bytes))

   ' Converta o hash em uma representação hexadecimal
   For i = LBound(hash) To UBound(hash)
       hashHex = hashHex & Right("0" & Hex(hash(i)), 2)
   Next i

   ' Libere o objeto SHA
   Set sha = Nothing

   ' Retorne o hash hexadecimal
   CriptografarSHA256 = hashHex
End Function

Uma outra função para gerar chaves

Public Function fncGerarChave() As String
   Dim blnUsuario As Boolean
   Dim blnMaquina As Boolean
   Dim varChave As Variant
   Dim objSHA As Object
   Dim objBytes() As Byte
   Dim objEncodedBytes() As Byte
   Dim i As Integer
   
   Dim chaveCriptografada As String
chaveCriptografada = CriptografarSHA256("varChave")
   Dim usuarioCriptografado As String
   Dim maquinaCriptografada As String
   '------------------------------------------------
   ' Verifica se houve troca de usuário ou de máquina
   '------------------------------------------------
   blnUsuario = Nz(DLookup("Usuario", "tblRegistro")) = Environ("UserName")
   blnMaquina = Nz(DLookup("Maquina", "tblRegistro")) = Environ("ComputerName")
   
   ' Crie um objeto para calcular o hash SHA-256
   Set objSHA = CreateObject("System.Security.Cryptography.SHA256Managed")
   
   Randomize
   '---------------------------------
   ' Gera nova chave de comprimento 8
   '---------------------------------
   varChave = Int(Rnd * 99999999)
   If Len(varChave) < 8 Then varChave = varChave & String(8 - Len(varChave), "0")
   
   '---------------------------------------------------------------------
   ' Grava chave, nome do usuário e nome da máquina na tabela tblRegistro
   '---------------------------------------------------------------------
   If DCount("*", "tblRegistro") = 0 Then
       ' Insere novo registro
       CurrentDb.Execute "INSERT INTO tblRegistro (chave,usuario,maquina) VALUES ('" & varChave & "','" _
       & Environ("UserName") & "','" & Environ("ComputerName") & "');"
   ElseIf IsNull(DLookup("chave", "tblRegistro")) Or blnUsuario = False Or blnMaquina = False Then
       ' Atualiza registro existente
       CurrentDb.Execute "UPDATE tblRegistro SET chave = '" & varChave & "',usuario ='" _
       & Environ("UserName") & "',maquina ='" & Environ("ComputerName") & "';"
   End If
   
   ' Converte a chave original em bytes
   objBytes = StrConv(varChave, vbFromUnicode)
   
   ' Calcula o hash SHA-256
   Set objSHA = CreateObject("System.Security.Cryptography.SHA256Managed")
   objEncodedBytes = objSHA.ComputeHash_2(objBytes)
   
   ' Converte os bytes em uma string hexadecimal
   Dim resultado As String
   resultado = ""
   
   For i = LBound(objEncodedBytes) To UBound(objEncodedBytes)
       resultado = resultado & Right("0" & Hex(objEncodedBytes(i)), 2)
   Next i
   
   ' Retorna a chave criptografada
   fncGerarChave = resultado
End Function


Agora quando tento gerar aos campos "chave, usuario, maquina" criptografados, não vai.

Alguma dica?

Obrigado

Olá Mylton Nogueira,

A criptografia está a funcionar, veja:


Se compreendi bem a sua dúvida é porque não está a gravar na tabela tblRegistro, veja melhor o código, pois a variável que está a passar não está a fazer a chamada à função:


Altere para chaveCripotgrafada e teste, funcionando ´aplicar o mesmo metódo para campos.

Abraço

Obrigado.

Modifiquei como mostrou. mas não foi.

Código:

Public Function fncGerarChave() As String
   Dim blnUsuario As Boolean
   Dim blnMaquina As Boolean
   Dim varChave As Variant
   Dim objSHA As Object
   Dim objBytes() As Byte
   Dim objEncodedBytes() As Byte
   Dim i As Integer
   
   Dim chaveCriptografada As String
chaveCriptografada = CriptografarSHA256("varChave")
   Dim usuarioCriptografado As String
   Dim maquinaCriptografada As String
   '------------------------------------------------
   ' Verifica se houve troca de usuário ou de máquina
   '------------------------------------------------
   blnUsuario = Nz(DLookup("Usuario", "tblRegistro")) = Environ("UserName")
   blnMaquina = Nz(DLookup("Maquina", "tblRegistro")) = Environ("ComputerName")
   
   ' Crie um objeto para calcular o hash SHA-256
   Set objSHA = CreateObject("System.Security.Cryptography.SHA256Managed")
   
   Randomize
   '---------------------------------
   ' Gera nova chave de comprimento 8
   '---------------------------------
   varChave = Int(Rnd * 99999999)
   If Len(varChave) < 8 Then varChave = varChave & String(8 - Len(varChave), "0")
   
   '---------------------------------------------------------------------
   ' Grava chave, nome do usuário e nome da máquina na tabela tblRegistro
   '---------------------------------------------------------------------
   If DCount("*", "tblRegistro") = 0 Then
' Insere novo registro
       CurrentDb.Execute "INSERT INTO tblRegistro (chave,usuario,maquina) VALUES ('" & chaveCriptografada & "','" _
       & Environ("UserName") & "','" & Environ("ComputerName") & "');"
   ElseIf IsNull(DLookup("chave", "tblRegistro")) Or blnUsuario = False Or blnMaquina = False Then
' Atualiza registro existente
       CurrentDb.Execute "UPDATE tblRegistro SET chave = '" & chaveCriptografada & "',usuario ='" _
       & Environ("UserName") & "',maquina ='" & Environ("ComputerName") & "';"
   End If

' Converte a chave original em bytes
   objBytes = StrConv(chaveCriptografada, vbFromUnicode)
   
' Calcula o hash SHA-256
   Set objSHA = CreateObject("System.Security.Cryptography.SHA256Managed")
   objEncodedBytes = objSHA.ComputeHash_2(objBytes)
   
' Converte os bytes em uma string hexadecimal
   Dim resultado As String
   resultado = ""
   
   For i = LBound(objEncodedBytes) To UBound(objEncodedBytes)
       resultado = resultado & Right("0" & Hex(objEncodedBytes(i)), 2)
   Next i
   
' Retorna a chave criptografada
   fncGerarChave = resultado
End Function

Se desejar posso anexar.

Olá Mylton Nogueira,

Apenas exemplifiquei para alterar o campo "chave" na tabela "tblRegistro ".
Lendo o código com mais atenção, verifico que você está a criptografar antes de ser atribuído o valor à variável "varChave"
Retire a instrução desta linha e coloque onde indico e teste


É preciso ter atenção e compreender a sequência do código

Abraço

Obrigado
Mas ta confuso aqui p mim.

Vou refazer e informo depois

Obrigado

Olá Mylton Nogueira,

Isso, vá com calma , mas firme no estudo.
Se mover a instrução assinalada a vermelho para a posição que indico na seta e executar já vai notar a diferença.
Ou seja, vai ver que colocou o campo "varChave" já criptografado na tabela apos a execução.

Qualquer coisa estamos cá para ajudar.
Abraço