Obs.: em SOFT você pode colocar o nome do sistema ,
intTam é o tamanho máximo do campo a ser criptografado, se tiver menos caracter, a função preenche a direita até o limite (intTam)
'trata encriptação dos dados nas tabelas de segurança
Public Function EncriptaPW(vgSt As String, intTam As Integer) As String
Dim x As String
x$ = Trim$(Cript$(RPad$(vgSt$, intTam, "+"), "SOFT"))
While Right$(x$, 1) = "+"
x$ = left$(x$, Len(x$) - 1)
Wend
EncriptaPW$ = x$
End Function
'criptografa/descriptografa
Public Function Cript(St As String, Pw As String) As String
Dim x As String, i As Integer, n As Integer, _
p As Integer, j As Integer, n0 As Integer 'dimensiona
p = 0
For i = 1 To Len(St$) 'para cada caracter
p = p + 1 'incrementa ponteiro
If p > Len(Pw$) Then p = 1 'testa e reseta, se for o caso
j = Asc(Mid$(Pw$, p, 1)) Or 128 'pega char da senha evitando acima de 128
n = Asc(Mid$(St$, i)) 'pega char da string a encriptar
DeNovo:
n = n Xor j 'encripta...
If n < 31 Then 'se char de controle
n = (128 + n) 'somar 128 e
GoTo DeNovo 'ecripta novamente
ElseIf n > 127 And n < 159 Then 'se nesta faixa pode ser char de controle
n = n - 128 'tira 128 e
GoTo DeNovo 'encripta novamente
End If
x$ = x$ + Chr$(n) 'concatena string encriptada
Next 'próximo caracter a encriptar
Cript$ = x$ 'retorna a nova string
End Function
'RPad - Enche caracteres à direita de uma string
Public Function RPad(vgSt As Variant, vgTm As Integer, vgCh As String) As String
Dim x As String 'dimensiona
If VarType(vgSt) = vbString Then 'se veio uma string
x$ = vgSt 'pega ela...
Else 'senão,
x$ = CStr(vgSt) 'transforma em string
End If
RPad$ = left$(LTrim$(x$) + String$(vgTm, vgCh$), vgTm) 'completa com brancos à direita
End Function
