Pessoal, tenho uma rotina de licença onde está funcionando perfeitamente.

Tenho que mandar para o cliente a base toda vez que expira a liceça, mas tenho que mandar já criptografada.

Então fiz o seguinte:

Criei um projetinho para criptografar a data de expiração, coloquei a data criptografada na base, acontece que quando vou rodar o projeto ele criptografa novamente, eu gostaria de mandar a base criptografada, quando rodar o projeto ele decriptografar e grava criptografando, eis o código.

 

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

 

Obrigada

Glaucia

exemplo de funções para criptografar/descriptografar ...

 

Private Sub Command1_Click()
  MsgBox Encripta("André", 20)
End Sub

'Trata encriptação dos dados nas tabelas de segurança
Public Function Encripta(vgSt As String, vgTam As Integer) As String
  Dim x As String
  x$ = Trim$(Cript$(RPad$(vgSt$, vgTam, "+"), "ADVANCED"))
  While Right$(x$, 1) = "+"
    x$ = Left$(x$, Len(x$) - 1)
  Wend
  Encripta$ = 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

 

Martini,

Está acontecento a mesma coisa.

Usei seu exemplo para colocar a informação na base com outro programa.

Quando vou utilizar ele descripta e grava criptando uma outra informação, quando vou acessar novamente ele cripta novamente, observei um detalhe, na primeira informação que coloquei ficou em minuscula, quando meu programa gravou novamente gravou em maiuscula, será que é isso ?

no meu sistema as caixas de textos são todas em maiúsculas, o usuário não consegue digitar textos em minúsculo ... tenta gravar em maiúscula, talvez resolva ...