✔ Programação GLOBAL®: Criptografar ou Descriptografar | Uma sequência de texto em uma sequência de caracteres com base em uma chave de criptografia especificada pelo usuário.

Criptografa ou Descriptografar uma sequência de texto em uma sequência de caracteres com base em uma chave de criptografia especificada pelo usuário.

A função faz uso de comparações Xor bit a bit na string a ser criptografada e uma chave de string fornecida pelo usuário. Isto pode ser útil se você deseja enviar informações confidenciais para alguém, ou deseja armazenar informações confidenciais em uma pasta de trabalho, e deseja usar mais proteção do que a interface padrão do Excel permite (por exemplo, proteção de planilha).

Option Explicit

Sub test()

'this sub is only present to demonstrate use of the function!

'it is not required to use the function.

Dim r As Range, retVal, sKey As String

sKey = Application.InputBox("Enter your key", "Key entry", "My Key", , , , , 2)

retVal = MsgBox("This is the key you entered:" & vbNewLine & Chr$(34) & sKey & Chr$(34) & vbNewLine & _

"Please confirm OK or Cancel to exit", vbOKCancel, "Confirm Key")

If retVal = vbCancel Then Exit Sub

For Each r In Sheets("Sheet1").UsedRange

If r.Interior.ColorIndex = 6 Then

r.Value = XorC(r.Value, sKey)

End If

Next r

End Sub

Function XorC(ByVal sData As String, ByVal sKey As String) As String

Dim l As Long, i As Long, byIn() As Byte, byOut() As Byte, byKey() As Byte

Dim bEncOrDec As Boolean

'confirm valid string and key input:

If Len(sData) = 0 Or Len(sKey) = 0 Then XorC = "Invalid argument(s) used": Exit Function

'check whether running encryption or decryption (flagged by presence of "xxx" at start of sData):

If Left$(sData, 3) = "xxx" Then

bEncOrDec = False 'decryption

sData = Mid$(sData, 4)

Else

bEncOrDec = True 'encryption

End If

'assign strings to byte arrays (unicode)

byIn = sData

byOut = sData

byKey = sKey

l = LBound(byKey)

For i = LBound(byIn) To UBound(byIn) - 1 Step 2

byOut(i) = ((byIn(i) + Not bEncOrDec) Xor byKey(l)) - bEncOrDec 'avoid Chr$(0) by using bEncOrDec flag

l = l + 2

If l > UBound(byKey) Then l = LBound(byKey) 'ensure stay within bounds of Key

Next i

XorC = byOut

If bEncOrDec Then XorC = "xxx" & XorC 'add "xxx" onto encrypted text

End Function

COMO USAR: =XorC(A1,"Minha Chave")

Outros ainda podem acessar a pasta de trabalho usando esse método, mas se não souberem a chave usada para criptografar os dados, será muito difícil decifrar qual é a sequência criptografada. A função adiciona um aos valores de bytes individuais da string criptografada gerada para evitar o retorno do caractere Ascii 0 (o Excel não exibirá esse caractere e, portanto, fará com que a criptografia falhe). Chaves mais longas fornecem melhor proteção de criptografia (assim como strings mais longas para criptografar).

EncryptDecryptFunction.zip 10.91KB

Clique aqui e nos contate via What's App para avaliarmos seus projetos

Envie seus comentários e sugestões e compartilhe este artigo!

brazilsalesforceeffectiveness@gmail.com

Série de Livros nut Project